diff options
| -rw-r--r-- | fltk-images.ads | 16 | ||||
| -rw-r--r-- | fltk-popups.adb | 17 | ||||
| -rw-r--r-- | fltk-popups.ads | 2 | ||||
| -rw-r--r-- | fltk-text_buffers.adb | 32 | ||||
| -rw-r--r-- | fltk-widgets-groups-text_displays.adb | 7 | ||||
| -rw-r--r-- | fltk-widgets-groups-text_displays.ads | 8 | ||||
| -rw-r--r-- | fltk-widgets-groups-windows-single-menu.adb | 6 | ||||
| -rw-r--r-- | fltk-widgets-groups.adb | 5 | ||||
| -rw-r--r-- | fltk-widgets-menus.adb | 5 | ||||
| -rw-r--r-- | fltk-widgets.adb | 17 | ||||
| -rw-r--r-- | fltk-widgets.ads | 32 | ||||
| -rw-r--r-- | fltk.adb | 3 |
12 files changed, 82 insertions, 68 deletions
diff --git a/fltk-images.ads b/fltk-images.ads index 88d7658..f005443 100644 --- a/fltk-images.ads +++ b/fltk-images.ads @@ -11,9 +11,19 @@ package FLTK.Images is return Image; - function Get_W (This : in Image) return Natural; - function Get_H (This : in Image) return Natural; - function Get_D (This : in Image) return Natural; + function Get_W + (This : in Image) + return Natural; + + + function Get_H + (This : in Image) + return Natural; + + + function Get_D + (This : in Image) + return Natural; private diff --git a/fltk-popups.adb b/fltk-popups.adb index 40a8d3e..d6ac8e9 100644 --- a/fltk-popups.adb +++ b/fltk-popups.adb @@ -46,14 +46,13 @@ package body FLTK.Popups is function Three_Way_Choice (Message, Button1, Button2, Button3 : in String) - return Choice is - + return Choice + is Result : Interfaces.C.int := popup_fl_choice (Interfaces.C.To_C (Message), Interfaces.C.To_C (Button1), Interfaces.C.To_C (Button2), Interfaces.C.To_C (Button3)); - begin return Choice'Val (Result); end Three_Way_Choice; @@ -63,15 +62,14 @@ package body FLTK.Popups is function File_Chooser (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) - return String is - + Relative : in Boolean := False) + return String + is Result : Interfaces.C.Strings.chars_ptr := popup_fl_file_chooser (Interfaces.C.To_C (Message), Interfaces.C.To_C (Filter_Pattern), Interfaces.C.To_C (Default), Boolean'Pos (Relative)); - begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; @@ -85,12 +83,11 @@ package body FLTK.Popups is function Text_Input (Message, Default : in String) - return String is - + return String + is Result : Interfaces.C.Strings.chars_ptr := popup_fl_input (Interfaces.C.To_C (Message), Interfaces.C.To_C (Default)); - begin if Result = Interfaces.C.Strings.Null_Ptr then return ""; diff --git a/fltk-popups.ads b/fltk-popups.ads index bee5d99..4b75c9b 100644 --- a/fltk-popups.ads +++ b/fltk-popups.ads @@ -15,7 +15,7 @@ package FLTK.Popups is function File_Chooser (Message, Filter_Pattern, Default : in String; - Relative : in Boolean := False) + Relative : in Boolean := False) return String; diff --git a/fltk-text_buffers.adb b/fltk-text_buffers.adb index b3b8344..736e32e 100644 --- a/fltk-text_buffers.adb +++ b/fltk-text_buffers.adb @@ -11,9 +11,6 @@ use type Interfaces.C.Strings.chars_ptr; use type Ada.Containers.Count_Type; -with Ada.Text_IO; - - package body FLTK.Text_Buffers is @@ -105,16 +102,16 @@ package body FLTK.Text_Buffers is procedure Modify_Callback_Hook (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; - Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address); + Text : in Interfaces.C.Strings.chars_ptr; + UD : in System.Address); pragma Convention (C, Modify_Callback_Hook); procedure Modify_Callback_Hook (Pos : in Interfaces.C.int; Inserted, Deleted, Restyled : in Interfaces.C.int; Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address) is - + UD : in System.Address) + is package UStr renames Ada.Strings.Unbounded; Action : Modification; @@ -124,7 +121,6 @@ package body FLTK.Text_Buffers is Ada_Text_Buffer : access Text_Buffer := Text_Buffer_Convert.To_Pointer (UD); - begin if Inserted > 0 then Length := Natural (Inserted); @@ -158,14 +154,13 @@ package body FLTK.Text_Buffers is procedure Predelete_Callback_Hook (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address) is - + UD : in System.Address) + is Place : Position := Position (Pos); Length : Natural := Natural (Deleted); Ada_Text_Buffer : access Text_Buffer := Text_Buffer_Convert.To_Pointer (UD); - begin for CB of Ada_Text_Buffer.Predelete_CBs loop CB.Call (Place, Length); @@ -269,12 +264,11 @@ package body FLTK.Text_Buffers is procedure Load_File (This : in Text_Buffer; - Name : in String) is - + Name : in String) + is Err_No : Interfaces.C.int := fl_text_buffer_loadfile (This.Void_Ptr, Interfaces.C.To_C (Name)); - begin if Err_No /= 0 then raise Storage_Error; @@ -295,12 +289,11 @@ package body FLTK.Text_Buffers is procedure Save_File (This : in Text_Buffer; - Name : in String) is - + Name : in String) + is Err_No : Interfaces.C.int := fl_text_buffer_savefile (This.Void_Ptr, Interfaces.C.To_C (Name)); - begin if Err_No /= 0 then raise Storage_Error; @@ -316,11 +309,10 @@ package body FLTK.Text_Buffers is Item : in String; Found_At : out Natural; Match_Case : in Boolean) - return Boolean is - + return Boolean + is Found_Raw : Interfaces.C.int; Result : Interfaces.C.int; - begin Result := fl_text_buffer_search_forward (This.Void_Ptr, diff --git a/fltk-widgets-groups-text_displays.adb b/fltk-widgets-groups-text_displays.adb index 473ceea..e2d62d8 100644 --- a/fltk-widgets-groups-text_displays.adb +++ b/fltk-widgets-groups-text_displays.adb @@ -2,6 +2,7 @@ with Interfaces.C; with System; +with FLTK.Text_Buffers; use type System.Address; @@ -112,9 +113,9 @@ package body FLTK.Widgets.Groups.Text_Displays is function Get_Buffer (This : in Text_Display) - return Text_Buffer_Cursor is + return FLTK.Text_Buffers.Text_Buffer_Cursor is begin - return Ref : Text_Buffer_Cursor (This.Buffer); + return Ref : FLTK.Text_Buffers.Text_Buffer_Cursor (This.Buffer); end Get_Buffer; @@ -122,7 +123,7 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Set_Buffer (This : in out Text_Display; - Buff : in out Text_Buffer) is + Buff : in out FLTK.Text_Buffers.Text_Buffer) is begin This.Buffer := Buff'Unchecked_Access; fl_text_display_set_buffer (This.Void_Ptr, Wrapper (Buff).Void_Ptr); diff --git a/fltk-widgets-groups-text_displays.ads b/fltk-widgets-groups-text_displays.ads index 84c6551..6c2a9fe 100644 --- a/fltk-widgets-groups-text_displays.ads +++ b/fltk-widgets-groups-text_displays.ads @@ -1,6 +1,6 @@ -with FLTK.Text_Buffers; use FLTK.Text_Buffers; +with FLTK.Text_Buffers; with FLTK.Enums; use FLTK.Enums; @@ -18,12 +18,12 @@ package FLTK.Widgets.Groups.Text_Displays is function Get_Buffer (This : in Text_Display) - return Text_Buffer_Cursor; + return FLTK.Text_Buffers.Text_Buffer_Cursor; procedure Set_Buffer (This : in out Text_Display; - Buff : in out Text_Buffer); + Buff : in out FLTK.Text_Buffers.Text_Buffer); function Get_Text_Color @@ -75,7 +75,7 @@ private type Text_Display is new Group with record - Buffer : access Text_Buffer; + Buffer : access FLTK.Text_Buffers.Text_Buffer; end record; diff --git a/fltk-widgets-groups-windows-single-menu.adb b/fltk-widgets-groups-windows-single-menu.adb index 2936504..8345308 100644 --- a/fltk-widgets-groups-windows-single-menu.adb +++ b/fltk-widgets-groups-windows-single-menu.adb @@ -137,11 +137,7 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is (This : in Menu_Window) return Boolean is begin - if fl_menu_window_overlay (This.Void_Ptr) = 0 then - return False; - else - return True; - end if; + return fl_menu_window_overlay (This.Void_Ptr) /= 0; end Get_Overlay; diff --git a/fltk-widgets-groups.adb b/fltk-widgets-groups.adb index 2197d28..067407d 100644 --- a/fltk-widgets-groups.adb +++ b/fltk-widgets-groups.adb @@ -109,14 +109,13 @@ package body FLTK.Widgets.Groups is function Child (This : in Group; Place : in Index) - return access Widget'Class is - + return access Widget'Class + is Widget_Ptr : System.Address := fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); Actual_Widget : access Widget'Class := Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); - begin return Actual_Widget; end Child; diff --git a/fltk-widgets-menus.adb b/fltk-widgets-menus.adb index be5b7c3..7669820 100644 --- a/fltk-widgets-menus.adb +++ b/fltk-widgets-menus.adb @@ -118,11 +118,10 @@ package body FLTK.Widgets.Menus is Text : in String; Action : access Widget_Callback'Class := null; Shortcut : in Shortcut_Key := No_Key; - Flags : in Menu_Flag := Flag_Normal) is - + Flags : in Menu_Flag := Flag_Normal) + is Place : Interfaces.C.int; Callback, User_Data : System.Address; - begin if Action = null then Callback := System.Null_Address; diff --git a/fltk-widgets.adb b/fltk-widgets.adb index c6ab5c0..256b8e6 100644 --- a/fltk-widgets.adb +++ b/fltk-widgets.adb @@ -4,7 +4,7 @@ with Interfaces.C; with Interfaces.C.Strings; with System; with System.Address_To_Access_Conversions; -with FLTK.Widgets.Groups; use FLTK.Widgets.Groups; +with FLTK.Widgets.Groups; with FLTK.Images; use type System.Address; @@ -12,7 +12,8 @@ use type System.Address; package body FLTK.Widgets is - package Group_Convert is new System.Address_To_Access_Conversions (Group'Class); + package Group_Convert is new + System.Address_To_Access_Conversions (FLTK.Widgets.Groups.Group'Class); @@ -115,11 +116,10 @@ package body FLTK.Widgets is function Parent (This : in Widget) - return access FLTK.Widgets.Groups.Group'Class is - + return access FLTK.Widgets.Groups.Group'Class + is Parent_Ptr : System.Address; - Actual_Parent : access Group'Class; - + Actual_Parent : access FLTK.Widgets.Groups.Group'Class; begin Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); if Parent_Ptr /= System.Null_Address then @@ -237,11 +237,10 @@ package body FLTK.Widgets is pragma Convention (C, Callback_Hook); procedure Callback_Hook - (W, U : in System.Address) is - + (W, U : in System.Address) + is Ada_Widget : access Widget'Class := Widget_Convert.To_Pointer (U); - begin Ada_Widget.Callback.Call (Ada_Widget.all); end Callback_Hook; diff --git a/fltk-widgets.ads b/fltk-widgets.ads index e692a65..7af5e2b 100644 --- a/fltk-widgets.ads +++ b/fltk-widgets.ads @@ -90,14 +90,34 @@ package FLTK.Widgets is Func : not null access Widget_Callback'Class); - function Get_X (This : in Widget) return Integer; - function Get_Y (This : in Widget) return Integer; - function Get_W (This : in Widget) return Integer; - function Get_H (This : in Widget) return Integer; + function Get_X + (This : in Widget) + return Integer; + + + function Get_Y + (This : in Widget) + return Integer; + + + function Get_W + (This : in Widget) + return Integer; - procedure Resize (This : in out Widget; W, H : in Integer); - procedure Reposition (This : in out Widget; X, Y : in Integer); + function Get_H + (This : in Widget) + return Integer; + + + procedure Resize + (This : in out Widget; + W, H : in Integer); + + + procedure Reposition + (This : in out Widget; + X, Y : in Integer); function Get_Image @@ -14,7 +14,8 @@ package body FLTK is - function Run return Integer is + function Run + return Integer is begin return Integer (fl_run); end Run; |