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 --- doc/fl.html | 1935 +++++++++++++++++++++++++++++++++++++++++++++++++++ progress.txt | 8 +- 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 +++- 13 files changed, 4248 insertions(+), 46 deletions(-) create mode 100644 doc/fl.html 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 diff --git a/doc/fl.html b/doc/fl.html new file mode 100644 index 0000000..b5c9905 --- /dev/null +++ b/doc/fl.html @@ -0,0 +1,1935 @@ + + + + + + + Fl Binding Map + + + + + + +

Fl Binding Map

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Package names
FlFLTK
 FLTK.Event
 FLTK.Screen
 FLTK.Static
Enumerations 
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Types
Fl_OptionOption
Fl_ColorColor
Fl_AlignAlignment
 Keypress
 Mouse_Button
 Modifier
Fl_ShortcutKey_Combo
Fl_BoxtypeBox_Kind
Fl_FontFont_Kind
Fl_FontsizeFont_Size
 Font_Size_Array
Fl_LabeltypeLabel_Kind
 Event_Kind
 Event_Outcome
 Menu_Flag
 Version_Number
Fl_Event_HandlerEvent_Handler
Fl_Event_DispatchEvent_Dispatch
Fl_Awake_HandlerAwake_Handler
Fl_Timeout_HandlerTimeout_Handler
Fl_Idle_HandlerIdle_Handler
 Buffer_Kind
Fl_Clipboard_Notify_HandlerClipboard_Notify_Handler
FL_SOCKETFile_Descriptor
 File_Mode
Fl_FD_HandlerFile_Handler
Fl_Box_Draw_FBox_Draw_Function
Fl_Abort_Handler 
Fl_Args_Handler 
Fl_Atclose_Handler 
Fl_Label_Draw_F 
Fl_Label_Measure_F 
Fl_Old_Idle_Handler 
Fl_System_Handler 
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Functions and Procedures
+static int abi_check(const int val=FL_ABI_VERSION);
+
+function ABI_Check
+       (ABI_Ver : in Version_Number)
+    return Boolean;
+
+static int abi_version();
+
+function ABI_Version
+    return Version_Number;
+
+static int add_awake_handler_(Fl_Awake_Handler, void *);
+
+procedure Add_Awake_Handler
+       (Func : in Awake_Handler);
+
+static void add_check(Fl_Timeout_Handler, void *=0);
+
+procedure Add_Check
+       (Func : in Timeout_Handler);
+
+static void add_clipboard_notify(Fl_Clipboard_Notify_Handler h, void *data=0);
+
+procedure Add_Clipboard_Notify
+       (Func : in Clipboard_Notify_Handler);
+
+static void add_fd(int fd, int when, Fl_FD_Handler cb, void *=0);
+
+procedure Add_File_Descriptor
+       (FD   : in File_Descriptor;
+        Mode : in File_Mode;
+        Func : in File_Handler);
+
+static void add_fd(int fd, Fl_FD_Handler cb, void *=0);
+
+procedure Add_File_Descriptor
+       (FD   : in File_Descriptor;
+        Func : in File_Handler);
+
+static void add_handler(Fl_Event_Handler h);
+
+procedure Add_Handler
+       (Func : in Event_Handler);
+
+static void add_idle(Fl_Idle_Handler cb, void *data=0);
+
+procedure Add_Idle
+       (Func : in Idle_Handler);
+
+static void add_system_handler(Fl_System_Handler h, void *data);
+
 
+static void add_timeout(double t, Fl_Timeout_Handler, void *=0);
+
+procedure Add_Timeout
+       (Seconds : in Long_Float;
+        Func    : in Timeout_Handler);
+
+static int api_version();
+
+function API_Version
+    return Version_Number;
+
+static int arg(int argc, char **argv, int &i);
+
 
+static int args(int argc, char **argv, int &i, Fl_Args_Handler cb=0);
+
 
+static void args(int argc, char **argv);
+
 
+static void awake(void *message=0);
+
+procedure Awake;
+
+static int awake(Fl_Awake_Handler cb, void *message=0);
+
 
+static void background(uchar, uchar, uchar);
+
+procedure Set_Background
+       (R, G, B : in Color_Component);
+
+static void background2(uchar, uchar, uchar);
+
+procedure Set_Alt_Background
+       (R, G, B : in Color_Component);
+
+static Fl_Widget * belowmouse();
+
+function Get_Below_Mouse
+    return access FLTK.Widgets.Widget'Class;
+
+static void belowmouse(Fl_Widget *);
+
+procedure Set_Below_Mouse
+       (To : in FLTK.Widgets.Widget'Class);
+
+static Fl_Color box_color(Fl_Color);
+
 
+static int box_dh(Fl_Boxtype);
+
+function Get_Box_Height_Offset
+       (Kind : in Box_Kind)
+    return Integer;
+
+static int box_dw(Fl_Boxtype);
+
+function Get_Box_Width_Offset
+       (Kind : in Box_Kind)
+    return Integer;
+
+static int box_dx(Fl_Boxtype);
+
+function Get_Box_X_Offset
+       (Kind : in Box_Kind)
+    return Integer;
+
+static int box_dy(Fl_Boxtype);
+
+function Get_Box_Y_Offset
+       (Kind : in Box_Kind)
+    return Integer;
+
+static void cairo_autolink_context(bool alink);
+
 
+static bool cairo_autolink_context();
+
 
+static cairo_t * cairo_cc();
+
 
+static void cairo_cc(cairo_t *c, bool own=false);
+
 
+static cairo_t * cairo_make_current(Fl_Window *w);
+
 
+static int check();
+
+function Check
+    return Boolean;
+
+static void clear_widget_pointer(Fl_Widget const *w);
+
 
+static int clipboard_contains(const char *type);
+
 
+static int compose(int &del);
+
+function Compose
+       (Del : out Natural)
+    return Boolean;
+
+static void compose_reset();
+
+procedure Compose_Reset;
+
+static void copy
+   (const char *stuff, int len, int destination=0,
+    const char *type=Fl::clipboard_plain_text);
+
+procedure Copy
+       (Text : in String;
+        Dest : in Buffer_Kind);
+
+static void damage(int d);
+
+procedure Set_Damaged
+       (To : in Boolean);
+
+static int damage();
+
+function Is_Damaged
+    return Boolean;
+
+static void default_atclose(Fl_Window *, void *);
+
+procedure Default_Window_Close
+       (Item : in out FLTK.Widgets.Widget'Class);
+
+static void delete_widget(Fl_Widget *w);
+
 
+static void disable_im();
+
+procedure Disable_System_Input;
+
+static void display(const char *);
+
 
+static int dnd();
+
+procedure Drag_Drop_Start;
+
+static void dnd_text_ops(int v);
+
+procedure Set_Drag_Drop_Text_Support
+       (To : in Boolean);
+
+static int dnd_text_ops();
+
+function Get_Drag_Drop_Text_Support
+    return Boolean;
+
+static void do_widget_deletion();
+
+procedure Do_Widget_Deletion;
+
+static int draw_box_active();
+
+function Draw_Box_Active
+    return Boolean;
+
+static void enable_im();
+
+procedure Enable_System_Input;
+
+static int event();
+
+function Last
+    return Event_Kind;
+
+static int event_alt();
+
+function Key_Alt
+    return Boolean;
+
+static int event_button();
+
+function Last_Button
+    return Mouse_Button;
+
+static int event_button1();
+
+function Mouse_Left
+    return Boolean;
+
+static int event_button2();
+
+function Mouse_Middle
+    return Boolean;
+
+static int event_button3();
+
+function Mouse_Right
+    return Boolean;
+
+static int event_buttons();
+
 
+static int event_clicks();
+
+function Is_Multi_Click
+    return Boolean;
+
+static void event_clicks(int i);
+
+procedure Set_Clicks
+       (To : in Natural);
+
+static void * event_clipboard();
+
 
+static const char * event_clipboard_type();
+
 
+static int event_command();
+
+function Key_Command
+    return Boolean;
+
+static int event_ctrl();
+
+function Key_Ctrl
+    return Boolean;
+
+static void event_dispatch(Fl_Event_Dispatch d);
+
+procedure Set_Dispatch
+       (Func : in Event_Dispatch);
+
+static Fl_Event_Dispatch event_dispatch();
+
+function Get_Dispatch
+    return Event_Dispatch;
+
+static int event_dx();
+
+function Mouse_DX
+    return Integer;
+
+static int event_dy();
+
+function Mouse_DY
+    return Integer;
+
+static int event_inside(int, int, int, int);
+
+function Is_Inside
+       (X, Y, W, H : in Integer)
+    return Boolean;
+
+static int event_inside(const Fl_Widget *);
+
 
+static int event_is_click();
+
+function Is_Click
+    return Boolean;
+
+static void event_is_click(int i);
+
See static void event_clicks(int i);
+static int event_key();
+
+function Last_Key
+    return Keypress;
+
+static int event_key(int key);
+
+function Pressed_During
+       (Key : in Keypress)
+    return Boolean;
+
+static int event_length();
+
+function Text_Length
+    return Natural;
+
+static int event_original_key();
+
+function Original_Last_Key
+    return Keypress;
+
+static int event_shift();
+
+function Key_Shift
+    return Boolean;
+
+static int event_state();
+
+function Last_Modifier
+    return Modifier;
+
+static int event_state(int mask);
+
+function Last_Modifier
+       (Had : in Modifier)
+    return Boolean;
+
+static const char * event_text();
+
+function Text
+    return String;
+
+static int event_x();
+
+function Mouse_X
+    return Integer;
+
+static int event_x_root();
+
+function Mouse_X_Root
+    return Integer;
+
+static int event_y();
+
+function Mouse_Y
+    return Integer;
+
+static int event_y_root();
+
+function Mouse_Y_Root
+    return Integer;
+
+static Fl_Window * first_window();
+
+function Get_First_Window
+    return access FLTK.Widgets.Groups.Windows.Window'Class;
+
+static void first_window(Fl_Window *);
+
+procedure Set_First_Window
+       (To : in FLTK.Widgets.Groups.Windows.Window'Class);
+
+static void flush();
+
+procedure Flush;
+
+static Fl_Widget * focus();
+
+function Get_Focus
+    return access FLTK.Widgets.Widget'Class;
+
+static void focus(Fl_Widget *);
+
+procedure Set_Focus
+       (To : in FLTK.Widgets.Widget'Class);
+
+static void foreground(uchar, uchar, uchar);
+
+procedure Set_Foreground
+       (R, G, B : in Color_Component);
+
+static void free_color(Fl_Color i, int overlay=0);
+
+procedure Free_Color
+       (Value   : in Color;
+        Overlay : in Boolean := False);
+
+static int get_awake_handler_(Fl_Awake_Handler &, void *&);
+
+function Get_Awake_Handler
+    return Awake_Handler;
+
+static Fl_Box_Draw_F * get_boxtype(Fl_Boxtype);
+
TBA
+static unsigned get_color(Fl_Color i);
+
 
+static void get_color(Fl_Color i, uchar &red, uchar &green, uchar &blue);
+
+procedure Get_Color
+       (From    : in     Color;
+        R, G, B :    out Color_Component);
+
+static const char * get_font(Fl_Font);
+
+function Font_Image
+       (Kind : in Font_Kind)
+    return String;
+
+static const char * get_font_name(Fl_Font, int *attributes=0);
+
+function Font_Family_Image
+       (Kind : in Font_Kind)
+    return String;
+
+static int get_font_sizes(Fl_Font, int *&sizep);
+
+function Font_Sizes
+       (Kind : in Font_Kind)
+    return Font_Size_Array;
+
+static int get_key(int key);
+
+function Key_Now
+       (Key : in Keypress)
+    return Boolean;
+
+static void get_mouse(int &, int &);
+
+procedure Get_Mouse
+       (X, Y : out Integer);
+
+static void get_system_colors();
+
+procedure System_Colors;
+
+static int gl_visual(int, int *alist=0);
+
 
+static Fl_Window * grab();
+
+function Get_Grab
+    return access FLTK.Widgets.Groups.Windows.Window'Class;
+
+static void grab(Fl_Window *);
+static void grab(Fl_Window &win);
+
+procedure Set_Grab
+       (To : in FLTK.Widgets.Groups.Windows.Window'Class);
+
+static int h();
+
+function Get_H
+    return Integer;
+
+static int handle(int, Fl_Window *);
+static int handle_(int, Fl_Window *);
+
 
+static int has_check(Fl_Timeout_Handler, void *=0);
+
+function Has_Check
+       (Func : in Timeout_Handler)
+    return Boolean;
+
+static int has_idle(Fl_Idle_Handler cb, void *data=0);
+
+function Has_Idle
+       (Func : in Idle_Handler)
+    return Boolean;
+
+static int has_timeout(Fl_Timeout_Handler, void *=0);
+
+function Has_Timeout
+       (Func : in Timeout_Handler)
+    return Boolean;
+
+static int is_scheme(const char *name);
+
+function Is_Scheme
+       (Scheme : in String)
+    return Boolean;
+
+static int lock();
+
+procedure Lock;
+
+static Fl_Window * modal();
+
+function Get_Top_Modal
+    return access FLTK.Widgets.Groups.Windows.Window'Class;
+
+static Fl_Window * next_window(const Fl_Window *);
+
+function Get_Next_Window
+       (From : in FLTK.Widgets.Groups.Windows.Window'Class)
+    return access FLTK.Widgets.Groups.Windows.Window'Class;
+
+static bool option(Fl_Option opt);
+
+function Get_Option
+       (Opt : in Option)
+    return Boolean;
+
+static void option(Fl_Option opt, bool val);
+
+procedure Set_Option
+       (Opt : in Option;
+        To  : in Boolean);
+
+static void own_colormap();
+
+procedure Own_Colormap;
+
+static void paste
+   (Fl_Widget &receiver, int source,
+    const char *type=Fl::clipboard_plain_text);
+
+procedure Paste
+       (Receiver : in FLTK.Widgets.Widget'Class;
+        Source   : in Buffer_Kind);
+
+static void paste(Fl_Widget &receiver);
+
 
+static Fl_Widget * pushed();
+
+function Get_Pushed
+    return access FLTK.Widgets.Widget'Class;
+
+static void pushed(Fl_Widget *);
+
+procedure Set_Pushed
+       (To : in FLTK.Widgets.Widget'Class);
+
+static Fl_Widget * readqueue();
+
+function Read_Queue
+    return access FLTK.Widgets.Widget'Class;
+
+static int ready();
+
+function Ready
+    return Boolean;
+
+static void redraw();
+
+procedure Redraw;
+
+static void release();
+
+procedure Release_Grab;
+
+static void release_widget_pointer(Fl_Widget *&w);
+
 
+static int reload_scheme();
+
+procedure Reload_Scheme;
+
+static void remove_check(Fl_Timeout_Handler, void *=0);
+
+procedure Remove_Check
+       (Func : in Timeout_Handler);
+
+static void remove_clipboard_notify(Fl_Clipboard_Notify_Handler h);
+
+procedure Remove_Clipboard_Notify
+       (Func : in Clipboard_Notify_Handler);
+
+static void remove_fd(int, int when);
+
+procedure Remove_File_Descriptor
+       (FD   : in File_Descriptor;
+        Mode : in File_Mode);
+
+static void remove_fd(int);
+
+procedure Remove_File_Descriptor
+       (FD : in File_Descriptor);
+
+static void remove_handler(Fl_Event_Handler h);
+
+procedure Remove_Handler
+       (Func : in Event_Handler);
+
+static void remove_idle(Fl_Idle_Handler cb, void *data=0);
+
+procedure Remove_Idle
+       (Func : in Idle_Handler);
+
+static void remove_system_handler(Fl_System_Handler h);
+
 
+static void remove_timeout(Fl_Timeout_Handler, void *=0);
+
+procedure Remove_Timeout
+       (Func : in Timeout_Handler);
+
+static repeat_timeout(double t, Fl_Timeout_Handler, void *=0);
+
+procedure Repeat_Timeout
+       (Seconds : in Long_Float;
+        Func    : in Timeout_Handler);
+
+static int run();
+
+function Run
+    return Integer;
+
+static int scheme(const char *name);
+
+procedure Set_Scheme
+       (To : in String);
+
+static const char * scheme();
+
+function Get_Scheme
+    return String;
+
+static int screen_count();
+
+function Count
+    return Integer;
+
+static void screen_dpi(float &h, float &v, int n=0);
+
+procedure DPI
+       (Horizontal, Vertical :    out Float;
+        Screen_Number        : in     Integer := 1);
+
+static int screen_num(int x, int y);
+
+function Containing
+       (X, Y : in Integer)
+    return Integer;
+
+static int screen_num(int x, int y, int w, int h);
+
+function Containing
+       (X, Y, W, H : in Integer)
+    return Integer;
+
+static void screen_work_area(int &X, int &Y, int &W, int &H, int mx, int my);
+
+procedure Work_Area
+       (X, Y, W, H   :    out Integer;
+        Pos_X, Pos_Y : in     Integer);
+
+static void screen_work_area(int &X, int &Y, int &W, int &H, int n);
+
+procedure Work_Area
+       (X, Y, W, H :    out Integer;
+        Screen_Num : in     Integer);
+
+static void screen_work_area(int &X, int &Y, int &W, int &H);
+
+procedure Work_Area
+       (X, Y, W, H : out Integer);
+
+static void screen_xywh(int &X, int &Y, int &W, int &H);
+
+procedure Bounding_Rect
+       (X, Y, W, H : out Integer);
+
+static void screen_xywh(int &X, int &Y, int &W, int &H, int mx, int my);
+
+procedure Bounding_Rect
+       (X, Y, W, H   :    out Integer;
+        Pos_X, Pos_Y : in     Integer);
+
+static void screen_xywh(int &X, int &Y, int &W, int &H, int n);
+
+procedure Bounding_Rect
+       (X, Y, W, H :    out Integer;
+        Screen_Num : in     Integer);
+
+static void screen_xywh(int &X, int &Y, int &W, int &H, int mx, int my, int mw, int mh);
+
+procedure Bounding_Rect
+       (X, Y, W, H     :    out Integer;
+        PX, PY, PW, PH : in     Integer);
+
+static int scrollbar_size();
+
+function Get_Default_Scrollbar_Size
+    return Natural;
+
+static void scrollbar_size(int W);
+
+procedure Set_Default_Scrollbar_Size
+       (To : in Natural);
+
+static void selection(Fl_Widget &owner, const char *, int len);
+
+procedure Selection
+       (Owner : in FLTK.Widgets.Widget'Class;
+        Text  : in String);
+
+static Fl_Widget * selection_owner();
+
 
+static void selection_owner(Fl_Widget *);
+
 
+static void set_abort(Fl_Abort_Handler f);
+
 
+static void set_atclose(Fl_Atclose_Handler f);
+
 
+static void set_box_color(Fl_Color);
+
 
+static void set_boxtype(Fl_Boxtype, Fl_Box_Draw_F *, uchar, uchar, uchar, uchar);
+
TBA
+static void set_boxtype(Fl_Boxtype, Fl_Boxtype from);
+
+procedure Set_Box_Kind
+       (To, From : in Box_Kind);
+
+static void set_color(Fl_Color, uchar, uchar, uchar, uchar);
+
+procedure Set_Color
+       (To      : in Color;
+        R, G, B : in Color_Component);
+
+static void set_color(Fl_Color i, unsigned c);
+
 
+static void set_font(Fl_Font, const char *);
+
 
+static void set_font(Fl_Font, Fl_Font);
+
+procedure Set_Font_Kind
+       (To, From : in Font_Kind);
+
+static Fl_Font set_fonts(const char *=0);
+
+procedure Setup_Fonts
+       (How_Many_Set_Up : out Natural);
+
+static void set_idle(Fl_Old_Idle_Handler cb);
+
 
+static void set_labeltype(Fl_Labeltype, Fl_Label_Draw_F *, FL_Label_Measure_F *);
+
 
+static void set_labeltype(Fl_Labeltype, Fl_Labeltype from);
+
 
+static int test_shortcut(Fl_Shortcut);
+
 
+static void * thread_message();
+
 
+static void unlock();
+
+procedure Unlock;
+
+static void use_high_res_GL(int val);
+
 
+static int use_high_res_GL();
+
 
+static double version();
+
+function Version
+    return Version_Number;
+
+static void visible_focus(int v);
+
+procedure Set_Visible_Focus
+       (To : in Boolean);
+
+static int visible_focus();
+
+function Has_Visible_Focus
+    return Boolean;
+
+static int visual(int);
+
 
+static int w();
+
+function Get_W
+    return Integer;
+
+static int wait();
+
+function Wait
+    return Integer;
+
+static double wait(double time);
+
+function Wait
+       (Seconds : in Long_Float)
+    return Integer;
+
+static void watch_widget_pointer(Fl_Widget *&w);
+
 
+static int x();
+
+function Get_X
+    return Integer;
+
+static int y();
+
+function Get_Y
+    return Integer;
+
+ + + + + diff --git a/progress.txt b/progress.txt index c391560..bcfa1ec 100644 --- a/progress.txt +++ b/progress.txt @@ -12,12 +12,14 @@ Overall estimate: ???% Polished: +FLTK FLTK.Devices FLTK.Devices.Surfaces.Copy FLTK.Devices.Surfaces.Image FLTK.Devices.Surfaces.Paged FLTK.Devices.Surfaces.Paged.Printers FLTK.Dialogs +FLTK.Event FLTK.Images FLTK.Images.Bitmaps FLTK.Images.Bitmaps.XBM @@ -28,6 +30,8 @@ FLTK.Images.RGB.PNG FLTK.Images.RGB.PNM FLTK.Images.Shared FLTK.Menu_Items +FLTK.Screen +FLTK.Static FLTK.Text_Buffers FLTK.Tooltips FLTK.Widgets.Boxes @@ -92,8 +96,6 @@ FLTK.Widgets.Valuators.Sliders.Horizontal Done: -FLTK.Event -FLTK.Screen FLTK.Widgets.Groups.Text_Displays.Text_Editors @@ -101,7 +103,6 @@ FLTK.Widgets.Groups.Text_Displays.Text_Editors Partially Done: -FLTK FLTK.Devices.Graphics FLTK.Devices.Surfaces FLTK.Environment @@ -160,6 +161,7 @@ Bugs to fix: Fl_Help_View ABI_VERSION checks Fl_Tooltip ABI_VERSION checks Fl_Wizard draw() method private/protected +GNAT bug with type_invariant combined with derived type and a begin section in a package, eg dialogs.adb 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