diff options
Diffstat (limited to 'spec')
96 files changed, 2448 insertions, 779 deletions
diff --git a/spec/fltk-asks.ads b/spec/fltk-asks.ads index fc6e150..23e2076 100644 --- a/spec/fltk-asks.ads +++ b/spec/fltk-asks.ads @@ -30,7 +30,7 @@ package FLTK.Asks is type RGB_Float is new Long_Float range 0.0 .. 1.0; - type RGB_Int is mod 256; + subtype RGB_Int is Color_Component; type File_Chooser_Callback is access procedure (Item : in String); @@ -38,6 +38,8 @@ package FLTK.Asks is + -- Static Attributes -- + function Get_Cancel_String return String; @@ -71,6 +73,8 @@ package FLTK.Asks is + -- Simple Messages -- + procedure Alert (Message : String); @@ -117,6 +121,8 @@ package FLTK.Asks is + -- Choosers -- + function Color_Chooser (Title : in String; R, G, B : in out RGB_Float; @@ -131,6 +137,10 @@ package FLTK.Asks is FLTK.Widgets.Groups.Color_Choosers.RGB) return Confirm_Result; + function Show_Colormap + (Old_Hue : in Color) + return Color; + function Dir_Chooser (Message, Default : in String; Relative : in Boolean := False) @@ -150,6 +160,8 @@ package FLTK.Asks is + -- Settings -- + function Get_Message_Hotspot return Boolean; @@ -160,6 +172,10 @@ package FLTK.Asks is (Font : in Font_Kind; Size : in Font_Size); + -- Technically the returned Box should have a parent, but you can't access + -- it for annoying technical reasons relating to how the Choice functions + -- work in C++. You shouldn't be trying to poke at those internals anyway. + -- Just stick to calling subprograms to change stuff about this Box. function Get_Message_Icon return FLTK.Widgets.Boxes.Box_Reference; @@ -195,6 +211,7 @@ private pragma Inline (Password); pragma Inline (Color_Chooser); + pragma Inline (Show_Colormap); pragma Inline (Dir_Chooser); pragma Inline (File_Chooser); pragma Inline (Set_File_Chooser_Callback); @@ -218,3 +235,4 @@ private end FLTK.Asks; + diff --git a/spec/fltk-devices-graphics.ads b/spec/fltk-devices-graphics.ads index f9d1a7c..2a1761f 100644 --- a/spec/fltk-devices-graphics.ads +++ b/spec/fltk-devices-graphics.ads @@ -20,6 +20,8 @@ package FLTK.Devices.Graphics is + -- Color -- + function Get_Color (This : in Graphics_Driver) return Color; @@ -27,6 +29,8 @@ package FLTK.Devices.Graphics is + -- Text -- + function Get_Text_Descent (This : in Graphics_Driver) return Integer; @@ -61,6 +65,8 @@ package FLTK.Devices.Graphics is + -- Images -- + procedure Draw_Scaled_Image (This : in Graphics_Driver; Img : in FLTK.Images.Image'Class; @@ -73,11 +79,8 @@ private type Graphics_Driver is new Device with null record; - - pragma Inline (Get_Color); - pragma Inline (Get_Text_Descent); pragma Inline (Get_Line_Height); pragma Inline (Get_Width); @@ -85,9 +88,9 @@ private pragma Inline (Get_Font_Size); pragma Inline (Set_Font); - pragma Inline (Draw_Scaled_Image); end FLTK.Devices.Graphics; + diff --git a/spec/fltk-devices-surface-copy.ads b/spec/fltk-devices-surface-copy.ads index 41d331b..1bc2d93 100644 --- a/spec/fltk-devices-surface-copy.ads +++ b/spec/fltk-devices-surface-copy.ads @@ -38,6 +38,8 @@ package FLTK.Devices.Surface.Copy is + -- Dimensions -- + function Get_W (This : in Copy_Surface) return Integer; @@ -49,6 +51,8 @@ package FLTK.Devices.Surface.Copy is + -- Drawing -- + procedure Draw_Widget (This : in out Copy_Surface; Item : in FLTK.Widgets.Widget'Class; @@ -62,6 +66,8 @@ package FLTK.Devices.Surface.Copy is + -- Surfaces -- + procedure Set_Current (This : in out Copy_Surface); diff --git a/spec/fltk-devices-surface-display.ads b/spec/fltk-devices-surface-display.ads index b581be7..3faaa22 100644 --- a/spec/fltk-devices-surface-display.ads +++ b/spec/fltk-devices-surface-display.ads @@ -32,6 +32,8 @@ package FLTK.Devices.Surface.Display is + -- Displays -- + function Get_Platform_Display return Display_Device_Reference; diff --git a/spec/fltk-devices-surface-image.ads b/spec/fltk-devices-surface-image.ads index 961a9b2..7711771 100644 --- a/spec/fltk-devices-surface-image.ads +++ b/spec/fltk-devices-surface-image.ads @@ -34,6 +34,8 @@ package FLTK.Devices.Surface.Image is + -- Resolution -- + function Is_Highres (This : in Image_Surface) return Boolean; @@ -41,6 +43,8 @@ package FLTK.Devices.Surface.Image is + -- Drawing -- + procedure Draw_Widget (This : in out Image_Surface; Item : in FLTK.Widgets.Widget'Class; @@ -54,6 +58,8 @@ package FLTK.Devices.Surface.Image is + -- Images -- + function Get_Image (This : in Image_Surface) return FLTK.Images.RGB.RGB_Image; @@ -65,6 +71,8 @@ package FLTK.Devices.Surface.Image is + -- Surfaces -- + procedure Set_Current (This : in out Image_Surface); diff --git a/spec/fltk-devices-surface-paged-postscript.ads b/spec/fltk-devices-surface-paged-postscript.ads index a7ea51c..22e2eca 100644 --- a/spec/fltk-devices-surface-paged-postscript.ads +++ b/spec/fltk-devices-surface-paged-postscript.ads @@ -66,6 +66,8 @@ package FLTK.Devices.Surface.Paged.Postscript is + -- Static Attributes -- + function Get_File_Chooser_Title return String; @@ -75,6 +77,8 @@ package FLTK.Devices.Surface.Paged.Postscript is + -- Driver -- + -- Not currently implemented, -- will return a Postscript_Graphics_Driver when done. function Get_Postscript_Driver @@ -84,6 +88,8 @@ package FLTK.Devices.Surface.Paged.Postscript is + -- Job Control -- + -- Docs say don't use this version. procedure Start_Job (This : in out Postscript_File_Device; @@ -121,6 +127,8 @@ package FLTK.Devices.Surface.Paged.Postscript is + -- Spacing and Orientation -- + procedure Get_Margins (This : in Postscript_File_Device; Left, Top, Right, Bottom : out Integer); diff --git a/spec/fltk-devices-surface-paged-printers.ads b/spec/fltk-devices-surface-paged-printers.ads index c0bc34e..b9c0169 100644 --- a/spec/fltk-devices-surface-paged-printers.ads +++ b/spec/fltk-devices-surface-paged-printers.ads @@ -42,6 +42,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Static Attributes -- + function Get_Dialog_Title return String; @@ -159,6 +161,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Driver -- + -- Not currently implemented function Get_Original_Driver (This : in out Printer) @@ -167,6 +171,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Job Control -- + procedure Start_Job (This : in out Printer; Count : in Natural := 0); @@ -188,6 +194,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Spacing and Orientation -- + procedure Get_Margins (This : in Printer; Left, Top, Right, Bottom : out Integer); @@ -226,6 +234,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Printing -- + procedure Print_Widget (This : in out Printer; Item : in FLTK.Widgets.Widget'Class; @@ -240,6 +250,8 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Printer -- + procedure Set_Current (This : in out Printer); diff --git a/spec/fltk-devices-surface-paged.ads b/spec/fltk-devices-surface-paged.ads index b445c62..cb820e6 100644 --- a/spec/fltk-devices-surface-paged.ads +++ b/spec/fltk-devices-surface-paged.ads @@ -75,6 +75,8 @@ package FLTK.Devices.Surface.Paged is + -- Job Control -- + procedure Start_Job (This : in out Paged_Device; Count : in Natural := 0); @@ -96,6 +98,8 @@ package FLTK.Devices.Surface.Paged is + -- Spacing and Orientation -- + procedure Get_Margins (This : in Paged_Device; Left, Top, Right, Bottom : out Integer); @@ -134,6 +138,8 @@ package FLTK.Devices.Surface.Paged is + -- Printing -- + procedure Print_Widget (This : in out Paged_Device; Item : in FLTK.Widgets.Widget'Class; diff --git a/spec/fltk-devices-surface.ads b/spec/fltk-devices-surface.ads index f70d1e8..7aa9e87 100644 --- a/spec/fltk-devices-surface.ads +++ b/spec/fltk-devices-surface.ads @@ -31,6 +31,8 @@ package FLTK.Devices.Surface is + -- Surfaces -- + function Get_Current return Surface_Device_Reference; @@ -43,6 +45,8 @@ package FLTK.Devices.Surface is + -- Drivers -- + function Has_Driver (This : in Surface_Device) return Boolean; diff --git a/spec/fltk-devices.ads b/spec/fltk-devices.ads index d9ce5b1..6e9873f 100644 --- a/spec/fltk-devices.ads +++ b/spec/fltk-devices.ads @@ -21,3 +21,4 @@ private end FLTK.Devices; + diff --git a/spec/fltk-draw.ads b/spec/fltk-draw.ads index cedd4da..a2c66f3 100644 --- a/spec/fltk-draw.ads +++ b/spec/fltk-draw.ads @@ -6,17 +6,14 @@ with - FLTK.Images, + Ada.Strings.Unbounded, + FLTK.Images.Pixmaps, FLTK.Widgets.Groups.Windows; package FLTK.Draw is - -------------------------- - -- Types and Constants -- - -------------------------- - type Line_Kind is (Solid_Line, Dash_Line, @@ -66,9 +63,7 @@ package FLTK.Draw is - ------------------------ -- No Documentation -- - ------------------------ procedure Reset_Spot; @@ -89,9 +84,7 @@ package FLTK.Draw is - --------------- -- Utility -- - --------------- function Can_Do_Alpha_Blending return Boolean; @@ -103,9 +96,7 @@ package FLTK.Draw is - -------------------------- -- Charset Conversion -- - -------------------------- function Latin1_To_Local (From : in String) @@ -126,9 +117,7 @@ package FLTK.Draw is - ---------------- -- Clipping -- - ---------------- function Clip_Box (X, Y, W, H : in Integer; @@ -151,9 +140,7 @@ package FLTK.Draw is - --------------- -- Overlay -- - --------------- procedure Overlay_Clear; @@ -163,9 +150,7 @@ package FLTK.Draw is - ---------------- -- Settings -- - ---------------- function Get_Color return Color; @@ -215,9 +200,7 @@ package FLTK.Draw is - ------------------------- -- Matrix Operations -- - ------------------------- procedure Mult_Matrix (A, B, C, D, X, Y : in Long_Float); @@ -263,17 +246,18 @@ package FLTK.Draw is - --------------------- -- Image Drawing -- - --------------------- procedure Draw_Image (X, Y, W, H : in Integer; Data : in Color_Component_Array; Depth : in Positive := 3; - Line_Data : in Natural := 0; + Line_Size : in Natural := 0; Flip_Horizontal : in Boolean := False; - Flip_Vertical : in Boolean := False); + Flip_Vertical : in Boolean := False) + with Pre => (if Line_Size = 0 + then Data'Length >= Size_Type (W) * Size_Type (H) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (H)); procedure Draw_Image (X, Y, W, H : in Integer; @@ -284,30 +268,44 @@ package FLTK.Draw is (X, Y, W, H : in Integer; Data : in Color_Component_Array; Depth : in Positive := 1; - Line_Data : in Natural := 0; + Line_Size : in Natural := 0; Flip_Horizontal : Boolean := False; - Flip_Vertical : Boolean := False); + Flip_Vertical : Boolean := False) + with Pre => (if Line_Size = 0 + then Data'Length >= Size_Type (W) * Size_Type (H) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (H)); procedure Draw_Image_Mono (X, Y, W, H : in Integer; Callback : in Image_Draw_Function; Depth : in Positive := 1); + procedure Draw_Pixmap + (Values : in FLTK.Images.Pixmaps.Header; + Colors : in FLTK.Images.Pixmaps.Color_Definition_Array; + Pixels : in FLTK.Images.Pixmaps.Pixmap_Data; + X, Y : in Integer; + Tone : in Color := Grey0_Color) + with Pre => + Colors'Length = Values.Colors and + Pixels'Length (1) = Values.Height and + (for all Definition of Colors => + Ada.Strings.Unbounded.Length (Definition.Name) = Values.Per_Pixel) and + Pixels'Length (2) = Values.Width * Values.Per_Pixel; + function Read_Image (X, Y, W, H : in Integer; Alpha : in Integer := 0) return Color_Component_Array with Post => - (if Alpha = 0 - then Read_Image'Result'Length = W * H * 3 - else Read_Image'Result'Length = W * H * 4); + (if Alpha = 0 + then Read_Image'Result'Length = Size_Type (W) * Size_Type (H) * 3 + else Read_Image'Result'Length = Size_Type (W) * Size_Type (H) * 4); - ----------------------- -- Special Drawing -- - ----------------------- procedure Add_Symbol (Text : in String; @@ -381,6 +379,19 @@ package FLTK.Draw is (Text : in String; DX, DY, W, H : out Integer); + -- Last is the index of the last character processed in Text which + -- would normally be one before the index of the char pointed at by + -- the return value in the C++ version. Instead, the return value + -- here is the processed text buffer. + function Expand_Text + (Text : in String; + Max_Width : in Long_Float; + Width : out Long_Float; + Last : out Natural; + Wrap : in Boolean; + Symbols : in Boolean := False) + return String; + function Width (Text : in String) return Long_Float; @@ -400,9 +411,7 @@ package FLTK.Draw is - ---------------------- -- Manual Drawing -- - ---------------------- procedure Begin_Complex_Polygon; procedure Begin_Line; @@ -524,32 +533,53 @@ private pragma Convention (C, Symbol_Draw_Function); + pragma Import (C, Reset_Spot, "fl_draw_reset_spot"); + + pragma Import (C, Pop_Clip, "fl_draw_pop_clip"); + pragma Import (C, Push_No_Clip, "fl_draw_push_no_clip"); + pragma Import (C, Restore_Clip, "fl_draw_restore_clip"); + + pragma Import (C, Overlay_Clear, "fl_draw_overlay_clear"); + + pragma Import (C, Pop_Matrix, "fl_draw_pop_matrix"); + pragma Import (C, Push_Matrix, "fl_draw_push_matrix"); + + pragma Import (C, Begin_Complex_Polygon, "fl_draw_begin_complex_polygon"); + pragma Import (C, Begin_Line, "fl_draw_begin_line"); + pragma Import (C, Begin_Loop, "fl_draw_begin_loop"); + pragma Import (C, Begin_Points, "fl_draw_begin_points"); + pragma Import (C, Begin_Polygon, "fl_draw_begin_polygon"); + + pragma Import (C, Gap, "fl_draw_gap"); + + pragma Import (C, End_Complex_Polygon, "fl_draw_end_complex_polygon"); + pragma Import (C, End_Line, "fl_draw_end_line"); + pragma Import (C, End_Loop, "fl_draw_end_loop"); + pragma Import (C, End_Points, "fl_draw_end_points"); + pragma Import (C, End_Polygon, "fl_draw_end_polygon"); + + pragma Inline (Reset_Spot); pragma Inline (Set_Spot); pragma Inline (Set_Status); - pragma Inline (Can_Do_Alpha_Blending); pragma Inline (Shortcut_Label); - pragma Inline (Latin1_To_Local); pragma Inline (Local_To_Latin1); pragma Inline (Mac_Roman_To_Local); pragma Inline (Local_To_Mac_Roman); - pragma Inline (Clip_Intersects); pragma Inline (Pop_Clip); pragma Inline (Push_Clip); pragma Inline (Push_No_Clip); pragma Inline (Restore_Clip); - pragma Inline (Overlay_Clear); pragma Inline (Overlay_Rect); - pragma Inline (Get_Color); pragma Inline (Set_Color); pragma Inline (Get_Font); @@ -559,7 +589,6 @@ private pragma Inline (Font_Descent); pragma Inline (Font_Height); - pragma Inline (Mult_Matrix); pragma Inline (Pop_Matrix); pragma Inline (Push_Matrix); @@ -573,7 +602,6 @@ private pragma Inline (Translate); pragma Inline (Vertex); - pragma Inline (Add_Symbol); pragma Inline (Draw_Text); pragma Inline (Draw_Text_Right_Left); @@ -584,14 +612,12 @@ private pragma Inline (Text_Extents); pragma Inline (Width); - pragma Inline (Begin_Complex_Polygon); pragma Inline (Begin_Line); pragma Inline (Begin_Loop); pragma Inline (Begin_Points); pragma Inline (Begin_Polygon); - pragma Inline (Arc); pragma Inline (Chord); pragma Inline (Circle); @@ -608,7 +634,6 @@ private pragma Inline (Ecks_Why_Line); pragma Inline (Why_Ecks_Line); - pragma Inline (End_Complex_Polygon); pragma Inline (End_Line); pragma Inline (End_Loop); diff --git a/spec/fltk-environment.ads b/spec/fltk-environment.ads index 4bb807b..9ab7f7c 100644 --- a/spec/fltk-environment.ads +++ b/spec/fltk-environment.ads @@ -36,12 +36,6 @@ package FLTK.Environment is - function New_UUID - return String; - - - - package Forge is function From_Filesystem @@ -76,6 +70,16 @@ package FLTK.Environment is + -- Static -- + + function New_UUID + return String; + + + + + -- Disk Activity -- + procedure Flush (This : in Database); @@ -86,6 +90,8 @@ package FLTK.Environment is + -- Deletion -- + procedure Delete_Entry (This : in out Pref_Group; Key : in String) @@ -112,6 +118,8 @@ package FLTK.Environment is + -- Key Values -- + function Number_Of_Entries (This : in Pref_Group) return Natural; @@ -135,6 +143,8 @@ package FLTK.Environment is + -- Groups -- + function Number_Of_Groups (This : in Pref_Group) return Natural; @@ -153,6 +163,8 @@ package FLTK.Environment is + -- Names -- + function At_Name (This : in Pref_Group) return String; @@ -164,6 +176,8 @@ package FLTK.Environment is + -- Retrieval -- + function Get (This : in Pref_Group; Key : in String) @@ -238,6 +252,8 @@ package FLTK.Environment is + -- Storage -- + procedure Set (This : in out Pref_Group; Key : in String; @@ -301,7 +317,6 @@ private pragma Convention (C, Binary_Data); - pragma Pack (Binary_Data); for Binary_Data'Component_Size use Interfaces.C.CHAR_BIT; diff --git a/spec/fltk-event.ads b/spec/fltk-events.ads index 3b0dec9..5dbc573 100644 --- a/spec/fltk-event.ads +++ b/spec/fltk-events.ads @@ -6,49 +6,79 @@ with - FLTK.Widgets.Groups.Windows; + FLTK.Widgets.Groups.Windows, + System; private with - Ada.Containers.Vectors, + Ada.Finalization, System.Address_To_Access_Conversions; -package FLTK.Event is +package FLTK.Events is type Event_Handler is access function (Event : in Event_Kind) return Event_Outcome; - -- type Event_Dispatch is access function - -- (Event : in Event_Kind; - -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) - -- return Event_Outcome; + type Event_Dispatch is access function + (Event : in Event_Kind; + Win : access FLTK.Widgets.Groups.Windows.Window'Class) + return Event_Outcome; + + type System_Event is new System.Address; + + type System_Handler is access function + (Event : in System_Event) + return Event_Outcome; + + -- Handlers -- + procedure Add_Handler - (Func : in Event_Handler); + (Func : in not null Event_Handler); procedure Remove_Handler - (Func : in Event_Handler); + (Func : in not null Event_Handler); + + procedure Add_System_Handler + (Func : in not null System_Handler); - -- function Get_Dispatch - -- return Event_Dispatch; + procedure Remove_System_Handler + (Func : in not null System_Handler); - -- procedure Set_Dispatch - -- (Func : in Event_Dispatch); - -- function Default_Dispatch - -- (Event : in Event_Kind; - -- Win : access FLTK.Widgets.Groups.Windows.Window'Class) - -- return Event_Outcome; + -- Dispatch -- + + function Get_Dispatch + return Event_Dispatch; + + -- Any Event_Dispatch function set must call Handle + -- if you want the Event to actually be acknowledged. + procedure Set_Dispatch + (Func : in Event_Dispatch); + + function Handle_Dispatch + (Event : in Event_Kind; + Origin : in out FLTK.Widgets.Groups.Windows.Window'Class) + return Event_Outcome; + + function Handle + (Event : in Event_Kind; + Origin : in out FLTK.Widgets.Groups.Windows.Window'Class) + return Event_Outcome; + + + -- Receiving -- + function Get_Grab return access FLTK.Widgets.Groups.Windows.Window'Class; @@ -75,9 +105,28 @@ package FLTK.Event is procedure Set_Focus (To : in FLTK.Widgets.Widget'Class); + function Has_Visible_Focus + return Boolean; + + procedure Set_Visible_Focus + (To : in Boolean); + + + + + -- Clipboard -- + + function Clipboard_Text + return String; + + function Clipboard_Kind + return String; + + -- Multikey -- + function Compose (Del : out Natural) return Boolean; @@ -90,15 +139,23 @@ package FLTK.Event is function Text_Length return Natural; + function Test_Shortcut + (Shortcut : in Key_Combo) + return Boolean; + + + -- Modifiers -- function Last return Event_Kind; + -- Focuses on keyboard modifiers only, not mouse buttons function Last_Modifier return Modifier; + -- Focuses on keyboard modifiers only, not mouse buttons function Last_Modifier (Had : in Modifier) return Boolean; @@ -106,6 +163,8 @@ package FLTK.Event is + -- Mouse -- + function Mouse_X return Integer; @@ -130,9 +189,18 @@ package FLTK.Event is function Is_Click return Boolean; + procedure Clear_Click; + function Is_Multi_Click return Boolean; + -- Returns the actual number of clicks. + -- So no clicks is 0, a single click is 1, a double click is 2, etc. + function Get_Clicks + return Natural; + + -- Will set the actual number of clicks. + -- This means setting it to 0 will make Is_Click return False. procedure Set_Clicks (To : in Natural); @@ -148,6 +216,19 @@ package FLTK.Event is function Mouse_Right return Boolean; + function Mouse_Back + return Boolean; + + function Mouse_Forward + return Boolean; + + procedure Mouse_Buttons + (Left, Middle, Right, Back, Forward : out Boolean); + + function Is_Inside + (Child : in FLTK.Widgets.Widget'Class) + return Boolean; + function Is_Inside (X, Y, W, H : in Integer) return Boolean; @@ -155,6 +236,8 @@ package FLTK.Event is + -- Keyboard -- + function Last_Key return Keypress; @@ -191,12 +274,7 @@ private (FLTK.Widgets.Groups.Windows.Window'Class); - package Handler_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, Element_Type => Event_Handler); - - - Handlers : Handler_Vectors.Vector := Handler_Vectors.Empty_Vector; - -- Current_Dispatch : Event_Dispatch := null; + Current_Dispatch : Event_Dispatch := null; function fl_widget_get_user_data @@ -206,14 +284,18 @@ private pragma Inline (fl_widget_get_user_data); + pragma Import (C, Compose_Reset, "fl_event_compose_reset"); pragma Inline (Add_Handler); pragma Inline (Remove_Handler); - -- pragma Inline (Get_Dispatch); - -- pragma Inline (Set_Dispatch); - -- pragma Inline (Default_Dispatch); + pragma Inline (Add_System_Handler); + pragma Inline (Remove_System_Handler); + pragma Inline (Get_Dispatch); + pragma Inline (Set_Dispatch); + pragma Inline (Handle_Dispatch); + pragma Inline (Handle); pragma Inline (Get_Grab); pragma Inline (Set_Grab); @@ -224,18 +306,21 @@ private pragma Inline (Set_Below_Mouse); pragma Inline (Get_Focus); pragma Inline (Set_Focus); + pragma Inline (Has_Visible_Focus); + pragma Inline (Set_Visible_Focus); + pragma Inline (Clipboard_Text); + pragma Inline (Clipboard_Kind); pragma Inline (Compose); pragma Inline (Compose_Reset); pragma Inline (Text); pragma Inline (Text_Length); - + pragma Inline (Test_Shortcut); pragma Inline (Last); pragma Inline (Last_Modifier); - pragma Inline (Mouse_X); pragma Inline (Mouse_X_Root); pragma Inline (Mouse_Y); @@ -244,15 +329,17 @@ private pragma Inline (Mouse_DY); pragma Inline (Get_Mouse); pragma Inline (Is_Click); + pragma Inline (Clear_Click); pragma Inline (Is_Multi_Click); + pragma Inline (Get_Clicks); pragma Inline (Set_Clicks); - pragma Inline (Last_Button); pragma Inline (Mouse_Left); pragma Inline (Mouse_Middle); pragma Inline (Mouse_Right); + pragma Inline (Mouse_Back); + pragma Inline (Mouse_Forward); pragma Inline (Is_Inside); - pragma Inline (Last_Key); pragma Inline (Original_Last_Key); pragma Inline (Pressed_During); @@ -263,5 +350,15 @@ private pragma Inline (Key_Shift); -end FLTK.Event; + -- Needed to deregister the handlers + type FLTK_Events_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out FLTK_Events_Final_Controller); + + Cleanup : FLTK_Events_Final_Controller; + + +end FLTK.Events; + diff --git a/spec/fltk-file_choosers.ads b/spec/fltk-file_choosers.ads index 927ae04..3445d4f 100644 --- a/spec/fltk-file_choosers.ads +++ b/spec/fltk-file_choosers.ads @@ -47,12 +47,16 @@ package FLTK.File_Choosers is + -- Sorting -- + Sort_Method : not null FLTK.Filenames.Compare_Function := FLTK.Filenames.Numeric_Sort'Access; + -- Buttons -- + function New_Button (This : in out File_Chooser) return FLTK.Widgets.Buttons.Button_Reference; @@ -68,6 +72,8 @@ package FLTK.File_Choosers is + -- Static Labels -- + function Get_Add_Favorites_Label return String; @@ -155,6 +161,8 @@ package FLTK.File_Choosers is + -- Callback and Extra -- + procedure Add_Extra (This : in out File_Chooser; Item : in out Widgets.Widget'Class); @@ -174,6 +182,8 @@ package FLTK.File_Choosers is + -- Settings -- + function Get_Background_Color (This : in File_Chooser) return Color; @@ -249,6 +259,8 @@ package FLTK.File_Choosers is + -- File Selection -- + function Number_Selected (This : in File_Chooser) return Natural; @@ -296,6 +308,8 @@ package FLTK.File_Choosers is + -- Visibility -- + procedure Show (This : in out File_Chooser); diff --git a/spec/fltk-filenames.ads b/spec/fltk-filenames.ads index 2872b8c..5d9b5ff 100644 --- a/spec/fltk-filenames.ads +++ b/spec/fltk-filenames.ads @@ -54,6 +54,8 @@ package FLTK.Filenames is + -- Uniform Resource Identifiers -- + function Decode_URI (URI : in Path_String) return Path_String; @@ -64,6 +66,8 @@ package FLTK.Filenames is + -- Pathnames -- + function Absolute (Name : in Path_String) return Path_String; @@ -94,6 +98,8 @@ package FLTK.Filenames is + -- Filenames -- + function Base_Name (Name : in Path_String) return Path_String; @@ -110,6 +116,8 @@ package FLTK.Filenames is + -- Directories -- + function Is_Directory (Name : in Path_String) return Boolean; @@ -122,6 +130,8 @@ package FLTK.Filenames is + -- Patterns -- + function Match (Input, Pattern : in String) return Boolean; diff --git a/spec/fltk-help_dialogs.ads b/spec/fltk-help_dialogs.ads index 655e357..fa0b94b 100644 --- a/spec/fltk-help_dialogs.ads +++ b/spec/fltk-help_dialogs.ads @@ -24,15 +24,13 @@ package FLTK.Help_Dialogs is (X, Y, W, H : in Integer) return Help_Dialog; - private - - pragma Inline (Create); - end Forge; + -- Visibility -- + procedure Show (This : in out Help_Dialog); @@ -49,6 +47,8 @@ package FLTK.Help_Dialogs is + -- Topline -- + procedure Set_Topline_Number (This : in out Help_Dialog; Line : in Positive); @@ -60,7 +60,9 @@ package FLTK.Help_Dialogs is - -- Name here can be either a ftp/http/https/ipp/mailto/news URL or a filename + -- Content -- + + -- Name here can be either a ftp/http/https/ipp/mailto/news URL or a filename. -- See Load procedure in FLTK.Widgets.Groups.Help_Views procedure Load (This : in out Help_Dialog; @@ -77,6 +79,8 @@ package FLTK.Help_Dialogs is + -- Settings -- + function Get_Text_Size (This : in Help_Dialog) return Font_Size; @@ -88,6 +92,8 @@ package FLTK.Help_Dialogs is + -- Dimensions -- + function Get_X (This : in Help_Dialog) return Integer; diff --git a/spec/fltk-images-bitmaps-xbm.ads b/spec/fltk-images-bitmaps-xbm.ads index 0887666..5805332 100644 --- a/spec/fltk-images-bitmaps-xbm.ads +++ b/spec/fltk-images-bitmaps-xbm.ads @@ -7,10 +7,6 @@ package FLTK.Images.Bitmaps.XBM is - ------------- - -- Types -- - ------------- - type XBM_Image is new Bitmap with private; type XBM_Image_Reference (Data : not null access XBM_Image'Class) is limited null record @@ -19,10 +15,6 @@ package FLTK.Images.Bitmaps.XBM is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -43,3 +35,4 @@ private end FLTK.Images.Bitmaps.XBM; + diff --git a/spec/fltk-images-bitmaps.ads b/spec/fltk-images-bitmaps.ads index d8730a2..9577273 100644 --- a/spec/fltk-images-bitmaps.ads +++ b/spec/fltk-images-bitmaps.ads @@ -7,10 +7,6 @@ package FLTK.Images.Bitmaps is - ------------- - -- Types -- - ------------- - type Bitmap is new Image with private; type Bitmap_Reference (Data : not null access Bitmap'Class) is limited null record @@ -19,22 +15,34 @@ package FLTK.Images.Bitmaps is - -------------------- - -- Construction -- - -------------------- + -- Calculates the bytes needed to hold a given number of bits. + + function Bytes_Needed + (Bits : in Natural) + return Natural; + + + package Forge is - -- Please note that I'm pretty sure (?) input data here should be some - -- declared item that lives at least as long as the resulting Bitmap + -- Please note that input data should be some declared item + -- that lives at least as long as the resulting Bitmap. function Create (Data : in Color_Component_Array; Width, Height : in Natural) - return Bitmap; + return Bitmap + with Pre => + Data'Length >= Size_Type (Bytes_Needed (Width)) * Size_Type (Height); end Forge; + + + + -- Copying -- + function Copy (This : in Bitmap; Width, Height : in Natural) @@ -47,9 +55,7 @@ package FLTK.Images.Bitmaps is - ---------------- -- Activity -- - ---------------- procedure Uncache (This : in out Bitmap); @@ -57,18 +63,56 @@ package FLTK.Images.Bitmaps is - --------------- + -- Pixel Data -- + + function Data_Size + (This : in Bitmap) + return Size_Type; + + function Get_Datum + (This : in Bitmap; + Place : in Positive_Size) + return Color_Component + with Pre => Place <= This.Data_Size; + + procedure Set_Datum + (This : in out Bitmap; + Place : in Positive_Size; + Value : in Color_Component) + with Pre => Place <= This.Data_Size; + + function Slice + (This : in Bitmap; + Low : in Positive_Size; + High : in Size_Type) + return Color_Component_Array + with Pre => High <= This.Data_Size, + Post => Slice'Result'Length = Size_Type'Max (0, High - Low + 1); + + procedure Overwrite + (This : in out Bitmap; + Place : in Positive_Size; + Values : in Color_Component_Array) + with Pre => Place + Values'Length - 1 <= This.Data_Size; + + function All_Data + (This : in Bitmap) + return Color_Component_Array + with Post => All_Data'Result'Length = This.Data_Size; + + + + -- Drawing -- - --------------- procedure Draw (This : in Bitmap; X, Y : in Integer); procedure Draw - (This : in Bitmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); + (This : in Bitmap; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer := 0); private @@ -80,10 +124,22 @@ private (This : in out Bitmap); + pragma Inline (Bytes_Needed); + pragma Inline (Copy); + pragma Inline (Uncache); + + pragma Inline (Data_Size); + pragma Inline (Get_Datum); + pragma Inline (Set_Datum); + pragma Inline (Slice); + pragma Inline (Overwrite); + pragma Inline (All_Data); + pragma Inline (Draw); end FLTK.Images.Bitmaps; + diff --git a/spec/fltk-images-pixmaps-gif.ads b/spec/fltk-images-pixmaps-gif.ads index 7084a13..5720138 100644 --- a/spec/fltk-images-pixmaps-gif.ads +++ b/spec/fltk-images-pixmaps-gif.ads @@ -7,10 +7,6 @@ package FLTK.Images.Pixmaps.GIF is - ------------- - -- Types -- - ------------- - type GIF_Image is new Pixmap with private; type GIF_Image_Reference (Data : not null access GIF_Image'Class) is @@ -19,10 +15,6 @@ package FLTK.Images.Pixmaps.GIF is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -43,3 +35,4 @@ private end FLTK.Images.Pixmaps.GIF; + diff --git a/spec/fltk-images-pixmaps-xpm.ads b/spec/fltk-images-pixmaps-xpm.ads index d5bae5a..c703264 100644 --- a/spec/fltk-images-pixmaps-xpm.ads +++ b/spec/fltk-images-pixmaps-xpm.ads @@ -7,10 +7,6 @@ package FLTK.Images.Pixmaps.XPM is - ------------- - -- Types -- - ------------- - type XPM_Image is new Pixmap with private; type XPM_Image_Reference (Data : not null access XPM_Image'Class) is @@ -19,10 +15,6 @@ package FLTK.Images.Pixmaps.XPM is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -43,3 +35,4 @@ private end FLTK.Images.Pixmaps.XPM; + diff --git a/spec/fltk-images-pixmaps.ads b/spec/fltk-images-pixmaps.ads index 14e3f94..64d8330 100644 --- a/spec/fltk-images-pixmaps.ads +++ b/spec/fltk-images-pixmaps.ads @@ -4,12 +4,17 @@ -- Released into the public domain -package FLTK.Images.Pixmaps is +with + + Ada.Strings.Unbounded; + +private with + Interfaces.C.Strings; + + +package FLTK.Images.Pixmaps is - ------------- - -- Types -- - ------------- type Pixmap is new Image with private; @@ -17,11 +22,48 @@ package FLTK.Images.Pixmaps is with Implicit_Dereference => Data; + type Header is record + Width, Height, Colors, Per_Pixel : Positive; + end record; + + type Color_Kind is (Colorful, Monochrome, Greyscale, Symbolic); + + type Color_Definition is record + Name : Ada.Strings.Unbounded.Unbounded_String; + Kind : Color_Kind; + Value : Ada.Strings.Unbounded.Unbounded_String; + end record; + + type Color_Definition_Array is array (Positive range <>) of Color_Definition; + + type Pixmap_Data is array (Positive range <>, Positive range <>) of Character; + - -------------------- - -- Construction -- - -------------------- + + package Forge is + + -- Unlike Bitmaps or RGB_Images, you do NOT have to keep this data around. + -- A copy will be allocated and deallocated internally. + + function Create + (Values : in Header; + Colors : in Color_Definition_Array; + Pixels : in Pixmap_Data) + return Pixmap + with Pre => + Colors'Length = Values.Colors and + Pixels'Length (1) = Values.Height and + (for all Definition of Colors => + Ada.Strings.Unbounded.Length (Definition.Name) = Values.Per_Pixel) and + Pixels'Length (2) = Values.Width * Values.Per_Pixel; + + end Forge; + + + + + -- Copying -- function Copy (This : in Pixmap; @@ -35,9 +77,7 @@ package FLTK.Images.Pixmaps is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out Pixmap; @@ -50,9 +90,7 @@ package FLTK.Images.Pixmaps is - ---------------- -- Activity -- - ---------------- procedure Uncache (This : in out Pixmap); @@ -60,24 +98,24 @@ package FLTK.Images.Pixmaps is - --------------- -- Drawing -- - --------------- procedure Draw (This : in Pixmap; X, Y : in Integer); procedure Draw - (This : in Pixmap; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); + (This : in Pixmap; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer := 0); private - type Pixmap is new Image with null record; + type Pixmap is new Image with record + Loose_Ptr : access Interfaces.C.Strings.chars_ptr_array; + end record; overriding procedure Finalize (This : in out Pixmap); @@ -86,13 +124,12 @@ private pragma Inline (Color_Average); pragma Inline (Desaturate); - pragma Inline (Uncache); - pragma Inline (Copy); pragma Inline (Draw); end FLTK.Images.Pixmaps; + diff --git a/spec/fltk-images-rgb-bmp.ads b/spec/fltk-images-rgb-bmp.ads index 4eb9e1b..f2bf103 100644 --- a/spec/fltk-images-rgb-bmp.ads +++ b/spec/fltk-images-rgb-bmp.ads @@ -7,10 +7,6 @@ package FLTK.Images.RGB.BMP is - ------------- - -- Types -- - ------------- - type BMP_Image is new RGB_Image with private; type BMP_Image_Reference (Data : not null access BMP_Image'Class) is limited null record @@ -19,10 +15,6 @@ package FLTK.Images.RGB.BMP is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -43,3 +35,4 @@ private end FLTK.Images.RGB.BMP; + diff --git a/spec/fltk-images-rgb-jpeg.ads b/spec/fltk-images-rgb-jpeg.ads index 0349b01..8bb21ba 100644 --- a/spec/fltk-images-rgb-jpeg.ads +++ b/spec/fltk-images-rgb-jpeg.ads @@ -7,10 +7,6 @@ package FLTK.Images.RGB.JPEG is - ------------- - -- Types -- - ------------- - type JPEG_Image is new RGB_Image with private; type JPEG_Image_Reference (Data : not null access JPEG_Image'Class) is @@ -19,10 +15,6 @@ package FLTK.Images.RGB.JPEG is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -48,3 +40,4 @@ private end FLTK.Images.RGB.JPEG; + diff --git a/spec/fltk-images-rgb-png.ads b/spec/fltk-images-rgb-png.ads index 23890b3..dcfbd4f 100644 --- a/spec/fltk-images-rgb-png.ads +++ b/spec/fltk-images-rgb-png.ads @@ -7,10 +7,6 @@ package FLTK.Images.RGB.PNG is - ------------- - -- Types -- - ------------- - type PNG_Image is new RGB_Image with private; type PNG_Image_Reference (Data : not null access PNG_Image'Class) is limited null record @@ -19,10 +15,6 @@ package FLTK.Images.RGB.PNG is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -48,3 +40,4 @@ private end FLTK.Images.RGB.PNG; + diff --git a/spec/fltk-images-rgb-pnm.ads b/spec/fltk-images-rgb-pnm.ads index d72706b..847b149 100644 --- a/spec/fltk-images-rgb-pnm.ads +++ b/spec/fltk-images-rgb-pnm.ads @@ -7,10 +7,6 @@ package FLTK.Images.RGB.PNM is - ------------- - -- Types -- - ------------- - type PNM_Image is new RGB_Image with private; type PNM_Image_Reference (Data : not null access PNM_Image'Class) is limited null record @@ -19,10 +15,6 @@ package FLTK.Images.RGB.PNM is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -43,3 +35,4 @@ private end FLTK.Images.RGB.PNM; + diff --git a/spec/fltk-images-rgb.ads b/spec/fltk-images-rgb.ads index 5768b3c..d893cec 100644 --- a/spec/fltk-images-rgb.ads +++ b/spec/fltk-images-rgb.ads @@ -12,30 +12,42 @@ with package FLTK.Images.RGB is - ------------- - -- Types -- - ------------- - type RGB_Image is new Image with private; type RGB_Image_Reference (Data : not null access RGB_Image'Class) is limited null record with Implicit_Dereference => Data; + type RGB_Image_Array is array (Positive range <>) of RGB_Image; + + + + + -- Static Settings -- + + function Get_Max_Size + return Size_Type; + + procedure Set_Max_Size + (Value : in Size_Type); - -------------------- - -- Construction -- - -------------------- package Forge is + -- Please note that input data should be some declared item + -- that lives at least as long as the resulting RGB_Image. + function Create (Data : in Color_Component_Array; Width, Height : in Natural; Depth : in Natural := 3; - Line_Data : in Natural := 0) - return RGB_Image; + Line_Size : in Natural := 0) + return RGB_Image + with Pre => (if Line_Size = 0 + then Data'Length >= Size_Type (Width) * Size_Type (Height) * Size_Type (Depth) + else Data'Length >= Size_Type (Line_Size) * Size_Type (Height)) + and Data'Length <= Get_Max_Size; function Create (Data : in FLTK.Images.Pixmaps.Pixmap'Class; @@ -44,11 +56,10 @@ package FLTK.Images.RGB is end Forge; - function Get_Max_Size - return Natural; - procedure Set_Max_Size - (Value : in Natural); + + + -- Copying -- function Copy (This : in RGB_Image; @@ -62,9 +73,7 @@ package FLTK.Images.RGB is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out RGB_Image; @@ -77,9 +86,7 @@ package FLTK.Images.RGB is - ---------------- -- Activity -- - ---------------- procedure Uncache (This : in out RGB_Image); @@ -87,18 +94,56 @@ package FLTK.Images.RGB is - --------------- + -- Pixel Data -- + + function Data_Size + (This : in RGB_Image) + return Size_Type; + + function Get_Datum + (This : in RGB_Image; + Place : in Positive_Size) + return Color_Component + with Pre => Place <= This.Data_Size; + + procedure Set_Datum + (This : in out RGB_Image; + Place : in Positive_Size; + Value : in Color_Component) + with Pre => Place <= This.Data_Size; + + function Slice + (This : in RGB_Image; + Low : in Positive_Size; + High : in Size_Type) + return Color_Component_Array + with Pre => High <= This.Data_Size, + Post => Slice'Result'Length = Size_Type'Max (0, High - Low + 1); + + procedure Overwrite + (This : in out RGB_Image; + Place : in Positive_Size; + Values : in Color_Component_Array) + with Pre => Place + Values'Length - 1 <= This.Data_Size; + + function All_Data + (This : in RGB_Image) + return Color_Component_Array + with Post => All_Data'Result'Length = This.Data_Size; + + + + -- Drawing -- - --------------- procedure Draw (This : in RGB_Image; X, Y : in Integer); procedure Draw - (This : in RGB_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); + (This : in RGB_Image; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer := 0); private @@ -112,18 +157,24 @@ private pragma Inline (Get_Max_Size); pragma Inline (Set_Max_Size); - pragma Inline (Copy); + pragma Inline (Copy); pragma Inline (Color_Average); pragma Inline (Desaturate); - pragma Inline (Uncache); + pragma Inline (Data_Size); + pragma Inline (Get_Datum); + pragma Inline (Set_Datum); + pragma Inline (Slice); + pragma Inline (Overwrite); + pragma Inline (All_Data); pragma Inline (Draw); end FLTK.Images.RGB; + diff --git a/spec/fltk-images-shared.ads b/spec/fltk-images-shared.ads index dce9254..c1bbdbd 100644 --- a/spec/fltk-images-shared.ads +++ b/spec/fltk-images-shared.ads @@ -12,10 +12,6 @@ with package FLTK.Images.Shared is - ------------- - -- Types -- - ------------- - type Shared_Image is new Image with private; type Shared_Image_Reference (Data : not null access Shared_Image'Class) is @@ -24,10 +20,6 @@ package FLTK.Images.Shared is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -46,6 +38,11 @@ package FLTK.Images.Shared is end Forge; + + + + -- Copying -- + function Copy (This : in Shared_Image; Width, Height : in Natural) @@ -58,9 +55,7 @@ package FLTK.Images.Shared is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out Shared_Image; @@ -73,9 +68,7 @@ package FLTK.Images.Shared is - ---------------- -- Activity -- - ---------------- function Number_Of_Images return Natural; @@ -101,9 +94,7 @@ package FLTK.Images.Shared is - --------------- -- Drawing -- - --------------- procedure Set_Scaling_Algorithm (To : in Scaling_Kind); @@ -135,11 +126,9 @@ private pragma Inline (Copy); - pragma Inline (Color_Average); pragma Inline (Desaturate); - pragma Inline (Number_Of_Images); pragma Inline (Name); pragma Inline (Original); @@ -147,7 +136,6 @@ private pragma Inline (Reload); pragma Inline (Uncache); - pragma Inline (Set_Scaling_Algorithm); pragma Inline (Scale); pragma Inline (Draw); @@ -155,3 +143,4 @@ private end FLTK.Images.Shared; + diff --git a/spec/fltk-images-tiled.ads b/spec/fltk-images-tiled.ads index a7e775e..a7470fc 100644 --- a/spec/fltk-images-tiled.ads +++ b/spec/fltk-images-tiled.ads @@ -7,10 +7,6 @@ package FLTK.Images.Tiled is - ------------- - -- Types -- - ------------- - type Tiled_Image is new Image with private; type Tiled_Image_Reference (Data : not null access Tiled_Image'Class) is @@ -19,10 +15,6 @@ package FLTK.Images.Tiled is - -------------------- - -- Construction -- - -------------------- - package Forge is function Create @@ -32,6 +24,11 @@ package FLTK.Images.Tiled is end Forge; + + + + -- Copying -- + function Copy (This : in Tiled_Image; Width, Height : in Natural) @@ -44,9 +41,7 @@ package FLTK.Images.Tiled is - --------------------- -- Miscellaneous -- - --------------------- procedure Inactive (This : in out Tiled_Image); @@ -58,9 +53,7 @@ package FLTK.Images.Tiled is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out Tiled_Image; @@ -73,18 +66,16 @@ package FLTK.Images.Tiled is - --------------- -- Drawing -- - --------------- procedure Draw (This : in Tiled_Image; X, Y : in Integer); procedure Draw - (This : in Tiled_Image; - X, Y, W, H : in Integer; - CX, CY : in Integer); + (This : in Tiled_Image; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer); private @@ -100,17 +91,15 @@ private pragma Inline (Copy); - pragma Inline (Inactive); pragma Inline (Tile); - pragma Inline (Color_Average); pragma Inline (Desaturate); - pragma Inline (Draw); end FLTK.Images.Tiled; + diff --git a/spec/fltk-images.ads b/spec/fltk-images.ads index 9a02f23..6afb788 100644 --- a/spec/fltk-images.ads +++ b/spec/fltk-images.ads @@ -7,10 +7,6 @@ package FLTK.Images is - ------------- - -- Types -- - ------------- - type Image is new Wrapper with private; type Image_Reference (Data : not null access Image'Class) is limited null record @@ -18,25 +14,27 @@ package FLTK.Images is type Scaling_Kind is (Nearest, Bilinear); - type Blend is new Float range 0.0 .. 1.0; No_Image_Error, File_Access_Error, Format_Error : exception; - -------------------- - -- Construction -- - -------------------- - package Forge is + -- This creates an empty image with no data, so not that useful. + function Create (Width, Height, Depth : in Natural) return Image; end Forge; + + + + -- Copying -- + function Get_Copy_Algorithm return Scaling_Kind; @@ -55,9 +53,7 @@ package FLTK.Images is - -------------- -- Colors -- - -------------- procedure Color_Average (This : in out Image; @@ -70,9 +66,7 @@ package FLTK.Images is - ---------------- -- Activity -- - ---------------- procedure Inactive (This : in out Image); @@ -87,9 +81,7 @@ package FLTK.Images is - ------------------ -- Dimensions -- - ------------------ function Get_W (This : in Image) @@ -103,86 +95,23 @@ package FLTK.Images is (This : in Image) return Natural; - function Get_Line_Data - (This : in Image) - return Natural; - - function Get_Data_Count + function Get_Line_Size (This : in Image) return Natural; - function Get_Data_Size - (This : in Image) - return Natural; - - - - - ------------------ - -- Pixel Data -- - ------------------ - - function Get_Datum - (This : in Image; - Data : in Positive; - Position : in Positive) - return Color_Component - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This); - - procedure Set_Datum - (This : in out Image; - Data : in Positive; - Position : in Positive; - Value : in Color_Component) - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This); - - function Get_Data - (This : in Image; - Data : in Positive; - Position : in Positive; - Count : in Natural) - return Color_Component_Array - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This) and - Count <= Get_Data_Size (This) - Position + 1; - - function All_Data - (This : in Image; - Data : in Positive) - return Color_Component_Array - with Pre => - Data <= Get_Data_Count (This); - - procedure Update_Data - (This : in out Image; - Data : in Positive; - Position : in Positive; - Values : in Color_Component_Array) - with Pre => - Data <= Get_Data_Count (This) and - Position <= Get_Data_Size (This) and - Values'Length <= Get_Data_Size (This) - Position + 1; - - --------------- -- Drawing -- - --------------- procedure Draw (This : in Image; X, Y : in Integer); procedure Draw - (This : in Image; - X, Y, W, H : in Integer; - CX, CY : in Integer := 0); + (This : in Image; + X, Y, W, H : in Integer; + Clip_X, Clip_Y : in Integer := 0); procedure Draw_Empty (This : in Image; @@ -198,40 +127,43 @@ private (This : in out Image); + procedure Raise_Fail_Errors + (This : in Image'Class); + + + function fl_image_data + (I : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_image_data, "fl_image_data"); + pragma Inline (fl_image_data); + + function fl_image_count + (I : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_image_count, "fl_image_count"); + pragma Inline (fl_image_count); pragma Inline (Get_Copy_Algorithm); pragma Inline (Set_Copy_Algorithm); pragma Inline (Copy); - pragma Inline (Color_Average); pragma Inline (Desaturate); - pragma Inline (Inactive); pragma Inline (Is_Empty); pragma Inline (Uncache); - pragma Inline (Get_W); pragma Inline (Get_H); pragma Inline (Get_D); - pragma Inline (Get_Line_Data); - pragma Inline (Get_Data_Count); - + pragma Inline (Get_Line_Size); pragma Inline (Draw); pragma Inline (Draw_Empty); - - - function fl_image_fail - (I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_image_fail, "fl_image_fail"); - - end FLTK.Images; + diff --git a/spec/fltk-labels.ads b/spec/fltk-labels.ads index 5e13a2e..e9da5f1 100644 --- a/spec/fltk-labels.ads +++ b/spec/fltk-labels.ads @@ -42,6 +42,8 @@ package FLTK.Labels is + -- Attributes -- + function Get_Value (This : in Label) return String; @@ -109,6 +111,8 @@ package FLTK.Labels is + -- Drawing -- + procedure Draw (This : in out Label; X, Y, W, H : in Integer; diff --git a/spec/fltk-menu_items.ads b/spec/fltk-menu_items.ads index ac80984..ced27ec 100644 --- a/spec/fltk-menu_items.ads +++ b/spec/fltk-menu_items.ads @@ -40,6 +40,8 @@ package FLTK.Menu_Items is + -- Callback -- + function Get_Callback (This : in Menu_Item) return FLTK.Widgets.Widget_Callback; @@ -55,6 +57,8 @@ package FLTK.Menu_Items is + -- Settings -- + function Has_Checkbox (This : in Menu_Item) return Boolean; @@ -87,6 +91,8 @@ package FLTK.Menu_Items is + -- Label -- + function Get_Label (This : in Menu_Item) return String; @@ -135,6 +141,8 @@ package FLTK.Menu_Items is + -- Shortcut and Flags -- + function Get_Shortcut (This : in Menu_Item) return Key_Combo; @@ -154,6 +162,8 @@ package FLTK.Menu_Items is + -- Image -- + function Get_Image (This : in Menu_Item) return access FLTK.Images.Image'Class; @@ -165,6 +175,8 @@ package FLTK.Menu_Items is + -- Activity and Visibility -- + procedure Activate (This : in out Menu_Item); diff --git a/spec/fltk-screen.ads b/spec/fltk-screen.ads index be28134..38db9aa 100644 --- a/spec/fltk-screen.ads +++ b/spec/fltk-screen.ads @@ -7,6 +7,28 @@ package FLTK.Screen is + type Visual_Mode is (RGB, RGB_24bit, Double_Buffer, Double_RGB, Double_RGB_24bit); + + + + + -- Environment -- + + procedure Set_Display_String + (Value : in String); + + procedure Set_Visual_Mode + (Value : in Visual_Mode); + + function Set_Visual_Mode + (Value : in Visual_Mode) + return Boolean; + + + + + -- Basic Dimensions -- + function Get_X return Integer; @@ -22,6 +44,8 @@ package FLTK.Screen is + -- Pixel Density -- + function Count return Integer; @@ -33,6 +57,8 @@ package FLTK.Screen is + -- Position Lookup -- + function Containing (X, Y : in Integer) return Integer; @@ -44,6 +70,8 @@ package FLTK.Screen is + -- Bounding Boxes -- + procedure Work_Area (X, Y, W, H : out Integer; Pos_X, Pos_Y : in Integer); @@ -55,9 +83,6 @@ package FLTK.Screen is procedure Work_Area (X, Y, W, H : out Integer); - - - procedure Bounding_Rect (X, Y, W, H : out Integer; Pos_X, Pos_Y : in Integer); @@ -74,23 +99,49 @@ package FLTK.Screen is PX, PY, PW, PH : in Integer); + + + -- Drawing -- + + function Is_Damaged + return Boolean; + + procedure Set_Damaged + (To : in Boolean); + + procedure Flush; + + procedure Redraw; + + private + pragma Import (C, Flush, "fl_screen_flush"); + pragma Import (C, Redraw, "fl_screen_redraw"); + + + pragma Inline (Set_Display_String); + pragma Inline (Set_Visual_Mode); + pragma Inline (Get_X); 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); + pragma Inline (Is_Damaged); + pragma Inline (Set_Damaged); + pragma Inline (Flush); + pragma Inline (Redraw); + end FLTK.Screen; + diff --git a/spec/fltk-static.ads b/spec/fltk-static.ads index 98f44ba..4f71244 100644 --- a/spec/fltk-static.ads +++ b/spec/fltk-static.ads @@ -6,23 +6,31 @@ with + FLTK.Labels, FLTK.Widgets.Groups.Windows; private with - Interfaces.C; + Ada.Finalization, + Ada.Unchecked_Conversion, + FLTK.Args_Marshal, + Interfaces.C.Strings; package FLTK.Static is - type Awake_Handler is access procedure; + -- Input is the argument index usable with Ada.Command_Line. + -- Output is how many arguments parsed starting from that index. + type Args_Handler is access function + (Index : in Positive) + return Natural; - type Timeout_Handler is access procedure; + type Awake_Handler is access procedure; type Idle_Handler is access procedure; - + type Timeout_Handler is access procedure; type Buffer_Kind is (Selection, Clipboard); @@ -31,35 +39,82 @@ package FLTK.Static is (Kind : in Buffer_Kind); + type File_Descriptor is new Integer; + type File_Mode is record + Read : Boolean := False; + Write : Boolean := False; + Except : Boolean := False; + end record; - type File_Descriptor is new Integer; + function "+" (Left, Right : in File_Mode) return File_Mode; + function "-" (Left, Right : in File_Mode) return File_Mode; - type File_Mode is (Read, Write, Except); + Read_Mode : constant File_Mode; + Write_Mode : constant File_Mode; + Except_Mode : constant File_Mode; type File_Handler is access procedure (FD : in File_Descriptor); - + subtype Byte_Integer is Integer range 0 .. 255; type Box_Draw_Function is access procedure (X, Y, W, H : in Integer; - My_Color : in Color); + Tone : in Color); + type Label_Draw_Function is access procedure + (Item : in FLTK.Labels.Label'Class; + X, Y, W, H : in Integer; + Position : in Alignment); + + type Label_Measure_Function is access procedure + (Item : in FLTK.Labels.Label'Class; + W, H : out Integer); type Option is - (Arrow_Focus, - Visible_Focus, - DND_Text, - Show_Tooltips, - FNFC_Uses_GTK, - Last); + (Arrow_Focus, + Visible_Focus, + DND_Text, + Show_Tooltips, + FNFC_Uses_GTK); + + + -- According to docs this should be customisable, + -- but in C++ it is a constant pointer to constant. + Help_Message : constant String; + + + Argument_Error : exception; + + + + + -- Command Line Arguments -- + + function Parse_Arg + (Index : in Positive) + return Natural; + + procedure Parse_Args; + + -- Not task safe, but you won't need to call this more than once anyway. + procedure Parse_Args + (Count : out Natural; + Func : in Args_Handler := null); + + + -- Thread Notify -- + -- Unsure if it is worth actually using this or if mixing tasks, pthreads, + -- and whatever other platforms use causes errors in some unexpected way. + -- Might be better to rely on FLTK.Check, Ada tasking, and Ada protected types. + -- You'll need appropriately declared protected objects to pass messages anyway. procedure Add_Awake_Handler (Func : in Awake_Handler); @@ -67,57 +122,74 @@ package FLTK.Static is function Get_Awake_Handler return Awake_Handler; + procedure Awake + (Func : in Awake_Handler); + + procedure Awake; + + procedure Lock; + + procedure Unlock; + + + -- Pre-Eventloop Callbacks -- procedure Add_Check - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); function Has_Check - (Func : in Timeout_Handler) + (Func : in not null Timeout_Handler) return Boolean; procedure Remove_Check - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); + -- Timer Callbacks -- + procedure Add_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); function Has_Timeout - (Func : in Timeout_Handler) + (Func : in not null Timeout_Handler) return Boolean; procedure Remove_Timeout - (Func : in Timeout_Handler); + (Func : in not null Timeout_Handler); procedure Repeat_Timeout - (Seconds : in Long_Float; - Func : in Timeout_Handler); + (Seconds : in Long_Float; + Func : in not null Timeout_Handler); + + -- Clipboard Callbacks -- procedure Add_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); + (Func : in not null Clipboard_Notify_Handler); procedure Remove_Clipboard_Notify - (Func : in Clipboard_Notify_Handler); + (Func : in not null Clipboard_Notify_Handler); + + -- File Descriptor Waiting Callbacks -- procedure Add_File_Descriptor - (FD : in File_Descriptor; - Func : in File_Handler); + (FD : in File_Descriptor; + Func : in not null File_Handler); procedure Add_File_Descriptor - (FD : in File_Descriptor; - Mode : in File_Mode; - Func : in File_Handler); + (FD : in File_Descriptor; + Mode : in File_Mode; + Func : in not null File_Handler); procedure Remove_File_Descriptor (FD : in File_Descriptor); @@ -129,31 +201,49 @@ package FLTK.Static is + -- Idle Callbacks -- + procedure Add_Idle - (Func : in Idle_Handler); + (Func : in not null Idle_Handler); function Has_Idle - (Func : in Idle_Handler) + (Func : in not null Idle_Handler) return Boolean; procedure Remove_Idle - (Func : in Idle_Handler); + (Func : in not null Idle_Handler); + -- Custom Colors -- + + function Get_Color + (From : in Color) + return Color; + procedure Get_Color (From : in Color; R, G, B : out Color_Component); procedure Set_Color - (To : in Color; + (Target, Source : in Color); + + procedure Set_Color + (Target : in Color; R, G, B : in Color_Component); procedure Free_Color (Value : in Color; Overlay : in Boolean := False); + function Get_Box_Color + (Tone : in Color) + return Color; + + procedure Set_Box_Color + (Tone : in Color); + procedure Own_Colormap; procedure Set_Foreground @@ -170,6 +260,8 @@ package FLTK.Static is + -- Custom Fonts -- + function Font_Image (Kind : in Font_Kind) return String; @@ -179,7 +271,11 @@ package FLTK.Static is return String; procedure Set_Font_Kind - (To, From : in Font_Kind); + (Target, Source : in Font_Kind); + + procedure Set_Font_Kind + (Target : in Font_Kind; + Source : in String); function Font_Sizes (Kind : in Font_Kind) @@ -191,6 +287,8 @@ package FLTK.Static is + -- Box_Kind Attributes -- + function Get_Box_Height_Offset (Kind : in Box_Kind) return Integer; @@ -213,18 +311,33 @@ package FLTK.Static is function Draw_Box_Active return Boolean; - -- function Get_Box_Draw_Function - -- (Kind : in Box_Kind) - -- return Box_Draw_Function; + 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 Byte_Integer := 0; + Offset_W, Offset_H : in Byte_Integer := 0); - -- 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); + -- Label_Kind Attributes -- + + procedure Set_Label_Kind + (Target, Source : in Label_Kind); + + procedure Set_Label_Draw_Function + (Kind : in Label_Kind; + Draw_Func : in Label_Draw_Function; + Measure_Func : in Label_Measure_Function); + + + + + -- Clipboard / Selection -- procedure Copy (Text : in String; @@ -238,8 +351,14 @@ package FLTK.Static is (Owner : in FLTK.Widgets.Widget'Class; Text : in String); + function Clipboard_Contains + (Kind : in String) + return Boolean; + + + -- Dragon Drop -- procedure Drag_Drop_Start; @@ -252,18 +371,16 @@ package FLTK.Static is + -- Input Methods -- + procedure Enable_System_Input; procedure Disable_System_Input; - function Has_Visible_Focus - return Boolean; - - procedure Set_Visible_Focus - (To : in Boolean); + -- Windows -- procedure Default_Window_Close (Item : in out FLTK.Widgets.Widget'Class); @@ -284,13 +401,15 @@ package FLTK.Static is + -- Queue -- + function Read_Queue return access FLTK.Widgets.Widget'Class; - procedure Do_Widget_Deletion; + -- Schemes -- function Get_Scheme return String; @@ -307,6 +426,8 @@ package FLTK.Static is + -- Library Options -- + function Get_Option (Opt : in Option) return Boolean; @@ -318,6 +439,8 @@ package FLTK.Static is + -- Scrollbars -- + function Get_Default_Scrollbar_Size return Natural; @@ -328,101 +451,114 @@ package FLTK.Static is private - File_Mode_Codes : array (File_Mode) of Interfaces.C.int := - (Read => 1, Write => 4, Except => 8); + The_Argv : Interfaces.C.Strings.chars_ptr_array := FLTK.Args_Marshal.Create_Argv; + for File_Mode use record + Read at 0 range 0 .. 0; + -- bit position 1 is unused + Write at 0 range 2 .. 2; + Except at 0 range 3 .. 3; + end record; + for File_Mode'Size use Interfaces.C.int'Size; - pragma Import (C, Own_Colormap, "fl_static_own_colormap"); - pragma Import (C, System_Colors, "fl_static_get_system_colors"); + Read_Mode : constant File_Mode := (Read => True, others => False); + Write_Mode : constant File_Mode := (Write => True, others => False); + Except_Mode : constant File_Mode := (Except => True, others => False); + function FMode_To_Cint is new + Ada.Unchecked_Conversion (File_Mode, Interfaces.C.int); - pragma Import (C, Drag_Drop_Start, "fl_static_dnd"); + help_usage_string_ptr : Interfaces.C.Strings.chars_ptr; + pragma Import (C, help_usage_string_ptr, "fl_help_usage_string_ptr"); - pragma Import (C, Enable_System_Input, "fl_static_enable_im"); - pragma Import (C, Disable_System_Input, "fl_static_disable_im"); + Help_Message : constant String := Interfaces.C.Strings.Value (help_usage_string_ptr); - pragma Import (C, Do_Widget_Deletion, "fl_static_do_widget_deletion"); + Font_Overrides : array (Font_Kind) of Interfaces.C.Strings.chars_ptr; - pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); + pragma Import (C, Lock, "fl_static_lock"); + pragma Import (C, Unlock, "fl_static_unlock"); + + pragma Import (C, Own_Colormap, "fl_static_own_colormap"); + pragma Import (C, System_Colors, "fl_static_get_system_colors"); + pragma Import (C, Enable_System_Input, "fl_static_enable_im"); + pragma Import (C, Disable_System_Input, "fl_static_disable_im"); + + pragma Import (C, Reload_Scheme, "fl_static_reload_scheme"); + pragma Inline (Parse_Arg); pragma Inline (Add_Awake_Handler); pragma Inline (Get_Awake_Handler); - + pragma Inline (Awake); + pragma Inline (Lock); + pragma Inline (Unlock); 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 (Get_Box_Color); + pragma Inline (Set_Box_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 (Get_Box_Draw_Function); + pragma Inline (Set_Box_Draw_Function); + pragma Inline (Set_Label_Kind); + pragma Inline (Set_Label_Draw_Function); pragma Inline (Copy); pragma Inline (Paste); pragma Inline (Selection); - + pragma Inline (Clipboard_Contains); 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); @@ -430,24 +566,29 @@ private 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); + -- Needed to dealloc the argv array and deregister the clipboard notify handler + type FLTK_Static_Final_Controller is new Ada.Finalization.Limited_Controlled with null record; + + overriding procedure Finalize + (This : in out FLTK_Static_Final_Controller); + + Cleanup : FLTK_Static_Final_Controller; + + end FLTK.Static; + diff --git a/spec/fltk-text_buffers.ads b/spec/fltk-text_buffers.ads index 53b2692..9430c57 100644 --- a/spec/fltk-text_buffers.ads +++ b/spec/fltk-text_buffers.ads @@ -48,6 +48,8 @@ package FLTK.Text_Buffers is + -- Callbacks -- + procedure Add_Modify_Callback (This : in out Text_Buffer; Func : in Modify_Callback); @@ -79,6 +81,8 @@ package FLTK.Text_Buffers is + -- Files -- + procedure Load_File (This : in out Text_Buffer; Name : in String; @@ -109,6 +113,8 @@ package FLTK.Text_Buffers is + -- Modification -- + procedure Insert_Text (This : in out Text_Buffer; Place : in Position; @@ -163,6 +169,8 @@ package FLTK.Text_Buffers is + -- Measurement -- + function Count_Displayed_Characters (This : in Text_Buffer; Start, Finish : in Position) @@ -188,6 +196,8 @@ package FLTK.Text_Buffers is + -- Selection -- + function Get_Selection (This : in Text_Buffer; Start, Finish : out Position) @@ -245,6 +255,8 @@ package FLTK.Text_Buffers is + -- Highlighting -- + procedure Get_Highlight (This : in Text_Buffer; Start, Finish : out Position); @@ -263,6 +275,8 @@ package FLTK.Text_Buffers is + -- Search -- + function Findchar_Forward (This : in Text_Buffer; Start_At : in Position; @@ -296,6 +310,8 @@ package FLTK.Text_Buffers is + -- Navigation -- + function Word_Start (This : in Text_Buffer; Place : in Position) @@ -344,6 +360,8 @@ package FLTK.Text_Buffers is + -- Miscellaneous -- + procedure Can_Undo (This : in out Text_Buffer; Flag : in Boolean); @@ -371,8 +389,6 @@ private Element_Type => Predelete_Callback); - - type Text_Buffer is new Wrapper with record CB_Active : Boolean := True; @@ -385,8 +401,6 @@ private (This : in out Text_Buffer); - - procedure Modify_Callback_Hook (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; Text : in Interfaces.C.Strings.chars_ptr; @@ -399,13 +413,9 @@ private pragma Convention (C, Predelete_Callback_Hook); - - package Text_Buffer_Convert is new System.Address_To_Access_Conversions (Text_Buffer); - - pragma Inline (Add_Modify_Callback); pragma Inline (Add_Predelete_Callback); pragma Inline (Remove_Modify_Callback); @@ -415,14 +425,12 @@ private pragma Inline (Enable_Callbacks); pragma Inline (Disable_Callbacks); - pragma Inline (Load_File); pragma Inline (Append_File); pragma Inline (Insert_File); pragma Inline (Output_File); pragma Inline (Save_File); - pragma Inline (Insert_Text); pragma Inline (Append_Text); pragma Inline (Replace_Text); @@ -435,14 +443,12 @@ private pragma Inline (Next_Char); pragma Inline (Prev_Char); - pragma Inline (Count_Displayed_Characters); pragma Inline (Count_Lines); pragma Inline (Length); pragma Inline (Get_Tab_Width); pragma Inline (Set_Tab_Width); - pragma Inline (Get_Selection); pragma Inline (Get_Secondary_Selection); pragma Inline (Set_Selection); @@ -458,19 +464,16 @@ private pragma Inline (Unselect); pragma Inline (Secondary_Unselect); - pragma Inline (Get_Highlight); pragma Inline (Set_Highlight); pragma Inline (Get_Highlighted_Text); pragma Inline (Unhighlight); - pragma Inline (Findchar_Forward); pragma Inline (Findchar_Backward); pragma Inline (Search_Forward); pragma Inline (Search_Backward); - pragma Inline (Word_Start); pragma Inline (Word_End); pragma Inline (Line_Start); @@ -480,7 +483,6 @@ private pragma Inline (Rewind_Lines); pragma Inline (Skip_Displayed_Characters); - pragma Inline (Can_Undo); pragma Inline (Copy); pragma Inline (UTF8_Align); @@ -488,3 +490,4 @@ private end FLTK.Text_Buffers; + diff --git a/spec/fltk-tooltips.ads b/spec/fltk-tooltips.ads index 4162358..46a50d5 100644 --- a/spec/fltk-tooltips.ads +++ b/spec/fltk-tooltips.ads @@ -12,6 +12,8 @@ with package FLTK.Tooltips is + -- Activity -- + function Get_Target return access FLTK.Widgets.Widget'Class; @@ -34,6 +36,8 @@ package FLTK.Tooltips is + -- Delay -- + function Get_Delay return Float; @@ -49,6 +53,8 @@ package FLTK.Tooltips is + -- Color, Margins, Wrap -- + function Get_Background_Color return Color; @@ -76,6 +82,8 @@ package FLTK.Tooltips is + -- Text Settings -- + function Get_Text_Color return Color; diff --git a/spec/fltk-widgets-boxes.ads b/spec/fltk-widgets-boxes.ads index 7e24d5f..d9674e5 100644 --- a/spec/fltk-widgets-boxes.ads +++ b/spec/fltk-widgets-boxes.ads @@ -51,6 +51,8 @@ package FLTK.Widgets.Boxes is + -- Drawing, Events -- + procedure Draw (This : in out Box); diff --git a/spec/fltk-widgets-buttons-enter.ads b/spec/fltk-widgets-buttons-enter.ads index ed5ab83..896df8d 100644 --- a/spec/fltk-widgets-buttons-enter.ads +++ b/spec/fltk-widgets-buttons-enter.ads @@ -41,6 +41,8 @@ package FLTK.Widgets.Buttons.Enter is + -- Drawing, Events -- + procedure Draw (This : in out Enter_Button); diff --git a/spec/fltk-widgets-buttons-light.ads b/spec/fltk-widgets-buttons-light.ads index b1a1cfa..c4761a8 100644 --- a/spec/fltk-widgets-buttons-light.ads +++ b/spec/fltk-widgets-buttons-light.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Buttons.Light is + -- Drawing, Events -- + procedure Draw (This : in out Light_Button); diff --git a/spec/fltk-widgets-buttons-repeat.ads b/spec/fltk-widgets-buttons-repeat.ads index 37380db..451553a 100644 --- a/spec/fltk-widgets-buttons-repeat.ads +++ b/spec/fltk-widgets-buttons-repeat.ads @@ -38,12 +38,16 @@ package FLTK.Widgets.Buttons.Repeat is + -- Activity -- + procedure Deactivate (This : in out Repeat_Button); + -- Events -- + function Handle (This : in out Repeat_Button; Event : in Event_Kind) diff --git a/spec/fltk-widgets-buttons.ads b/spec/fltk-widgets-buttons.ads index c5fb917..bff7c81 100644 --- a/spec/fltk-widgets-buttons.ads +++ b/spec/fltk-widgets-buttons.ads @@ -40,6 +40,8 @@ package FLTK.Widgets.Buttons is + -- State -- + function Is_On (This : in Button) return Boolean; @@ -58,6 +60,8 @@ package FLTK.Widgets.Buttons is + -- Settings -- + function Get_Down_Box (This : in Button) return Box_Kind; @@ -77,6 +81,8 @@ package FLTK.Widgets.Buttons is + -- Drawing, Events -- + procedure Draw (This : in out Button); @@ -88,6 +94,8 @@ package FLTK.Widgets.Buttons is + -- Miscellaneous -- + procedure Simulate_Key_Action (This : in out Button); diff --git a/spec/fltk-widgets-charts.ads b/spec/fltk-widgets-charts.ads index eb8d75b..7df4df1 100644 --- a/spec/fltk-widgets-charts.ads +++ b/spec/fltk-widgets-charts.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Charts is + -- Data -- + procedure Add (This : in out Chart; Data_Value : in Long_Float; @@ -64,6 +66,8 @@ package FLTK.Widgets.Charts is + -- Settings -- + function Will_Autosize (This : in Chart) return Boolean; @@ -95,6 +99,8 @@ package FLTK.Widgets.Charts is + -- Text Settings -- + function Get_Text_Color (This : in Chart) return Color; @@ -122,6 +128,8 @@ package FLTK.Widgets.Charts is + -- Dimensions -- + procedure Resize (This : in out Chart; W, H : in Integer); @@ -129,6 +137,8 @@ package FLTK.Widgets.Charts is + -- Drawing -- + procedure Draw (This : in out Chart); diff --git a/spec/fltk-widgets-clocks-updated.ads b/spec/fltk-widgets-clocks-updated.ads index c0700b2..b3389df 100644 --- a/spec/fltk-widgets-clocks-updated.ads +++ b/spec/fltk-widgets-clocks-updated.ads @@ -51,6 +51,8 @@ package FLTK.Widgets.Clocks.Updated is + -- Events -- + function Handle (This : in out Updated_Clock; Event : in Event_Kind) diff --git a/spec/fltk-widgets-clocks.ads b/spec/fltk-widgets-clocks.ads index d5b3728..c729262 100644 --- a/spec/fltk-widgets-clocks.ads +++ b/spec/fltk-widgets-clocks.ads @@ -44,6 +44,8 @@ package FLTK.Widgets.Clocks is + -- Individual Values -- + function Get_Hour (This : in Clock) return Hour; @@ -59,6 +61,8 @@ package FLTK.Widgets.Clocks is + -- Full Value -- + function Get_Time (This : in Clock) return Time_Value; @@ -76,6 +80,8 @@ package FLTK.Widgets.Clocks is + -- Drawing -- + procedure Draw (This : in out Clock); diff --git a/spec/fltk-widgets-groups-browsers-check.ads b/spec/fltk-widgets-groups-browsers-check.ads index bd70503..46c9108 100644 --- a/spec/fltk-widgets-groups-browsers-check.ads +++ b/spec/fltk-widgets-groups-browsers-check.ads @@ -47,7 +47,7 @@ package FLTK.Widgets.Groups.Browsers.Check is - -- Adding and removing + -- Items -- procedure Add (This : in out Check_Browser; @@ -68,7 +68,7 @@ package FLTK.Widgets.Groups.Browsers.Check is - -- Checking and unchecking + -- Checkmarking -- procedure Check_All (This : in out Check_Browser); @@ -93,7 +93,7 @@ package FLTK.Widgets.Groups.Browsers.Check is - -- Text and selection + -- Text Selection -- -- Don't confuse this with the missing Item_Cursor version function Item_Text @@ -108,6 +108,8 @@ package FLTK.Widgets.Groups.Browsers.Check is + -- Item Implementation -- + -- As mentioned at the start, due to issues with FLTK 1.3 if you override -- these subprograms the behaviour in FLTK will not change. Should be able -- to bind them properly once 1.4 comes around. diff --git a/spec/fltk-widgets-groups-browsers-textline-choice.ads b/spec/fltk-widgets-groups-browsers-textline-choice.ads index b3c404c..dcf3d60 100644 --- a/spec/fltk-widgets-groups-browsers-textline-choice.ads +++ b/spec/fltk-widgets-groups-browsers-textline-choice.ads @@ -4,6 +4,9 @@ -- Released into the public domain +-- Select_Browsers except select is a reserved word + + package FLTK.Widgets.Groups.Browsers.Textline.Choice is @@ -13,6 +16,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.Choice is limited null record with Implicit_Dereference => Data; + + package Forge is function Create diff --git a/spec/fltk-widgets-groups-browsers-textline-file.ads b/spec/fltk-widgets-groups-browsers-textline-file.ads index e679957..d19bd50 100644 --- a/spec/fltk-widgets-groups-browsers-textline-file.ads +++ b/spec/fltk-widgets-groups-browsers-textline-file.ads @@ -55,6 +55,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.File is + -- Directory -- + function Load (This : in out File_Browser; Dir : in String; @@ -71,6 +73,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.File is + -- Settings -- + function Get_File_Kind (This : in File_Browser) return File_Kind; @@ -106,6 +110,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.File is + -- List Implementation -- + function Full_List_Height (This : in File_Browser) return Integer; @@ -117,6 +123,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.File is + -- Item Implementation -- + function Item_Width (This : in File_Browser; Item : in Item_Cursor) diff --git a/spec/fltk-widgets-groups-browsers-textline-hold.ads b/spec/fltk-widgets-groups-browsers-textline-hold.ads index 7de4445..3839dd1 100644 --- a/spec/fltk-widgets-groups-browsers-textline-hold.ads +++ b/spec/fltk-widgets-groups-browsers-textline-hold.ads @@ -13,6 +13,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.Hold is limited null record with Implicit_Dereference => Data; + + package Forge is function Create diff --git a/spec/fltk-widgets-groups-browsers-textline-multi.ads b/spec/fltk-widgets-groups-browsers-textline-multi.ads index f4a7df2..150b5b6 100644 --- a/spec/fltk-widgets-groups-browsers-textline-multi.ads +++ b/spec/fltk-widgets-groups-browsers-textline-multi.ads @@ -13,6 +13,8 @@ package FLTK.Widgets.Groups.Browsers.Textline.Multi is limited null record with Implicit_Dereference => Data; + + package Forge is function Create diff --git a/spec/fltk-widgets-groups-browsers-textline.ads b/spec/fltk-widgets-groups-browsers-textline.ads index 3ef7322..3a66e12 100644 --- a/spec/fltk-widgets-groups-browsers-textline.ads +++ b/spec/fltk-widgets-groups-browsers-textline.ads @@ -51,7 +51,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Directly manipulating lines + -- Lines -- procedure Add (This : in out Textline_Browser; @@ -86,7 +86,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Loading text and text size + -- Text Loading -- procedure Load (This : in out Textline_Browser; @@ -113,7 +113,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Columns and formatting + -- Columns, Formatting -- function Get_Column_Character (This : in Textline_Browser) @@ -143,7 +143,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Line positioning + -- Line Positions -- function Get_Top_Line (This : in Textline_Browser) @@ -169,7 +169,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Line selection + -- Selection -- function Set_Select (This : in out Textline_Browser; @@ -194,7 +194,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Visibility, showing, hiding + -- Visibility -- function Is_Visible (This : in Textline_Browser; @@ -227,7 +227,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Resizing + -- Dimensions -- procedure Resize (This : in out Textline_Browser; @@ -236,7 +236,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Icons for specific lines + -- Icons -- function Has_Icon (This : in Textline_Browser; @@ -260,7 +260,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- List dimensions + -- List Implementation -- function Full_List_Height (This : in Textline_Browser) @@ -273,7 +273,7 @@ package FLTK.Widgets.Groups.Browsers.Textline is - -- Item implementation + -- Item Implementation -- function Item_Width (This : in Textline_Browser; @@ -335,6 +335,8 @@ package FLTK.Widgets.Groups.Browsers.Textline is + -- Line Numbers -- + function Line_Number (This : in Textline_Browser; Item : in Item_Cursor) diff --git a/spec/fltk-widgets-groups-browsers.ads b/spec/fltk-widgets-groups-browsers.ads index d7b0498..c735fa2 100644 --- a/spec/fltk-widgets-groups-browsers.ads +++ b/spec/fltk-widgets-groups-browsers.ads @@ -56,7 +56,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Access to the Browser's self contained scrollbars + -- Attributes -- function H_Bar (This : in out Browser) @@ -69,7 +69,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Item related settings + -- Items -- function Set_Select (This : in out Browser; @@ -135,7 +135,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Scrollbar related settings + -- Scrollbar Settings -- function Get_Scrollbar_Mode (This : in Browser) @@ -178,7 +178,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Text related settings + -- Text Settings -- function Get_Text_Color (This : in Browser) @@ -207,7 +207,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Graphical dimensions and redrawing + -- Dimensions, Redrawing -- procedure Resize (This : in out Browser; @@ -231,6 +231,8 @@ package FLTK.Widgets.Groups.Browsers is + -- Optional Overrides -- + -- You may override these subprograms to change the behaviour of the widget -- even though these are called from within FLTK. @@ -254,6 +256,8 @@ package FLTK.Widgets.Groups.Browsers is + -- Mandatory Overrides -- + -- You MUST override these subprograms if deriving a type from Browser or your -- program will crash, since they are called from within FLTK and do not have -- any implementations given. By default here they will raise an exception. @@ -318,7 +322,7 @@ package FLTK.Widgets.Groups.Browsers is - -- Cache invalidation + -- Cache Invalidation -- procedure New_List (This : in out Browser); @@ -340,20 +344,6 @@ package FLTK.Widgets.Groups.Browsers is A, B : in Item_Cursor); - - - -- You may override these subprograms to change the behaviour of the widget - -- even though these are called from within FLTK. - - procedure Draw - (This : in out Browser); - - function Handle - (This : in out Browser; - Event : in Event_Kind) - return Event_Outcome; - - private @@ -456,9 +446,6 @@ private pragma Inline (Replacing); pragma Inline (Swapping); - pragma Inline (Draw); - pragma Inline (Handle); - end FLTK.Widgets.Groups.Browsers; diff --git a/spec/fltk-widgets-groups-color_choosers.ads b/spec/fltk-widgets-groups-color_choosers.ads index 4307acd..d3b049f 100644 --- a/spec/fltk-widgets-groups-color_choosers.ads +++ b/spec/fltk-widgets-groups-color_choosers.ads @@ -35,6 +35,8 @@ package FLTK.Widgets.Groups.Color_Choosers is + -- RGB Color -- + function Get_Red (This : in Color_Chooser) return Long_Float; @@ -59,6 +61,8 @@ package FLTK.Widgets.Groups.Color_Choosers is + -- HSV Color -- + function Get_Hue (This : in Color_Chooser) return Long_Float; @@ -83,6 +87,8 @@ package FLTK.Widgets.Groups.Color_Choosers is + -- RGB / HSV Conversion -- + procedure HSV_To_RGB (H, S, V : in Long_Float; R, G, B : out Long_Float); @@ -94,6 +100,8 @@ package FLTK.Widgets.Groups.Color_Choosers is + -- Settings -- + function Get_Mode (This : in Color_Chooser) return Color_Mode; diff --git a/spec/fltk-widgets-groups-help_views.ads b/spec/fltk-widgets-groups-help_views.ads index 8cab6a7..d1dc75b 100644 --- a/spec/fltk-widgets-groups-help_views.ads +++ b/spec/fltk-widgets-groups-help_views.ads @@ -53,6 +53,8 @@ package FLTK.Widgets.Groups.Help_Views is + -- Selection -- + procedure Clear_Selection (This : in out Help_View); @@ -62,6 +64,8 @@ package FLTK.Widgets.Groups.Help_Views is + -- Position -- + function Find (This : in Help_View; Item : in String; @@ -91,6 +95,8 @@ package FLTK.Widgets.Groups.Help_Views is + -- Content -- + function Current_Directory (This : in Help_View) return String; @@ -123,6 +129,8 @@ package FLTK.Widgets.Groups.Help_Views is + -- Settings -- + function Get_Scrollbar_Size (This : in Help_View) return Natural; @@ -170,6 +178,8 @@ package FLTK.Widgets.Groups.Help_Views is + -- Drawing, Events -- + procedure Draw (This : in out Help_View); diff --git a/spec/fltk-widgets-groups-input_choices.ads b/spec/fltk-widgets-groups-input_choices.ads index fb092de..5843c44 100644 --- a/spec/fltk-widgets-groups-input_choices.ads +++ b/spec/fltk-widgets-groups-input_choices.ads @@ -40,6 +40,8 @@ package FLTK.Widgets.Groups.Input_Choices is + -- Attributes -- + function Text_Field (This : in out Input_Choice) return FLTK.Widgets.Inputs.Text.Text_Input_Reference; @@ -51,6 +53,8 @@ package FLTK.Widgets.Groups.Input_Choices is + -- Menu Items -- + function Has_Item (This : in Input_Choice; Place : in FLTK.Widgets.Menus.Index) @@ -71,6 +75,8 @@ package FLTK.Widgets.Groups.Input_Choices is + -- Settings -- + function Has_Changed (This : in Input_Choice) return Boolean; @@ -129,6 +135,8 @@ package FLTK.Widgets.Groups.Input_Choices is + -- Dimensions -- + procedure Resize (This : in out Input_Choice; X, Y, W, H : in Integer); diff --git a/spec/fltk-widgets-groups-packed.ads b/spec/fltk-widgets-groups-packed.ads index 60a6c2a..3d55749 100644 --- a/spec/fltk-widgets-groups-packed.ads +++ b/spec/fltk-widgets-groups-packed.ads @@ -35,6 +35,8 @@ package FLTK.Widgets.Groups.Packed is + -- Settings -- + function Get_Spacing (This : in Packed_Group) return Integer; @@ -54,6 +56,8 @@ package FLTK.Widgets.Groups.Packed is + -- Drawing -- + procedure Draw (This : in out Packed_Group); diff --git a/spec/fltk-widgets-groups-scrolls.ads b/spec/fltk-widgets-groups-scrolls.ads index f4cbad0..116fe42 100644 --- a/spec/fltk-widgets-groups-scrolls.ads +++ b/spec/fltk-widgets-groups-scrolls.ads @@ -27,6 +27,25 @@ package FLTK.Widgets.Groups.Scrolls is Both_Always); + type Region is record + X, Y, W, H : Integer; + end record; + + type Scrollbar_Data is record + X, Y, W, H : Integer; + Size, Total : Natural; + First, Position : Integer; + end record; + + type Scroll_Info is record + Child_Box : Region; + Inner_Inc, Inner_Ex : Region; + H_Needed, V_Needed : Boolean; + H_Data, V_Data : Scrollbar_Data; + Scroll_Size : Natural; + end record; + + package Forge is @@ -47,6 +66,8 @@ package FLTK.Widgets.Groups.Scrolls is + -- Attributes -- + function H_Bar (This : in out Scroll) return Valuators.Sliders.Scrollbars.Scrollbar_Reference; @@ -58,12 +79,16 @@ package FLTK.Widgets.Groups.Scrolls is + -- Contents -- + procedure Clear (This : in out Scroll); + -- Scrolling -- + procedure Scroll_To (This : in out Scroll; X, Y : in Integer); @@ -81,6 +106,8 @@ package FLTK.Widgets.Groups.Scrolls is + -- Scrollbar Settings -- + function Get_Scrollbar_Size (This : in Scroll) return Integer; @@ -100,6 +127,25 @@ package FLTK.Widgets.Groups.Scrolls is + -- Dimensions -- + + procedure Resize + (This : in out Scroll; + X, Y, W, H : in Integer); + + procedure Recalculate_Scrollbars + (This : in Scroll; + Data : out Scroll_Info); + + + + + -- Drawing, Events -- + + procedure Bounding_Box + (This : in Scroll; + X, Y, W, H : out Integer); + procedure Draw (This : in out Scroll); @@ -142,6 +188,9 @@ private pragma Inline (Get_Kind); pragma Inline (Set_Kind); + pragma Inline (Resize); + + pragma Inline (Bounding_Box); pragma Inline (Draw); pragma Inline (Handle); diff --git a/spec/fltk-widgets-groups-spinners.ads b/spec/fltk-widgets-groups-spinners.ads index 3124dc2..681c4d7 100644 --- a/spec/fltk-widgets-groups-spinners.ads +++ b/spec/fltk-widgets-groups-spinners.ads @@ -40,6 +40,8 @@ package FLTK.Widgets.Groups.Spinners is + -- Settings -- + function Get_Background_Color (This : in Spinner) return Color; @@ -83,6 +85,8 @@ package FLTK.Widgets.Groups.Spinners is + -- Values -- + function Get_Minimum (This : in Spinner) return Long_Float; @@ -126,6 +130,8 @@ package FLTK.Widgets.Groups.Spinners is + -- Formatting -- + function Get_Format (This : in Spinner) return String; @@ -145,6 +151,8 @@ package FLTK.Widgets.Groups.Spinners is + -- Dimensions -- + procedure Resize (This : in out Spinner; X, Y, W, H : in Integer); @@ -152,6 +160,8 @@ package FLTK.Widgets.Groups.Spinners is + -- Events -- + function Handle (This : in out Spinner; Event : in Event_Kind) diff --git a/spec/fltk-widgets-groups-tabbed.ads b/spec/fltk-widgets-groups-tabbed.ads index c056d29..a7b8d26 100644 --- a/spec/fltk-widgets-groups-tabbed.ads +++ b/spec/fltk-widgets-groups-tabbed.ads @@ -33,6 +33,8 @@ package FLTK.Widgets.Groups.Tabbed is + -- Child Area -- + procedure Get_Client_Area (This : in Tabbed_Group; Tab_Height : in Natural; @@ -41,6 +43,8 @@ package FLTK.Widgets.Groups.Tabbed is + -- Operation -- + function Get_Push (This : in Tabbed_Group) return access Widget'Class; @@ -65,6 +69,8 @@ package FLTK.Widgets.Groups.Tabbed is + -- Drawing, Events -- + procedure Draw (This : in out Tabbed_Group); diff --git a/spec/fltk-widgets-groups-tables-row.ads b/spec/fltk-widgets-groups-tables-row.ads index e51068a..84d7191 100644 --- a/spec/fltk-widgets-groups-tables-row.ads +++ b/spec/fltk-widgets-groups-tables-row.ads @@ -37,12 +37,16 @@ package FLTK.Widgets.Groups.Tables.Row is + -- Contents Modification -- + procedure Clear (This : in out Row_Table); + -- Rows -- + function Get_Rows (This : in Row_Table) return Natural; @@ -54,6 +58,8 @@ package FLTK.Widgets.Groups.Tables.Row is + -- Selection -- + function Is_Row_Selected (This : in Row_Table; Row : in Positive) @@ -85,6 +91,8 @@ package FLTK.Widgets.Groups.Tables.Row is + -- Drawing, Events -- + procedure Cell_Dimensions (This : in Row_Table; Context : in Table_Context; diff --git a/spec/fltk-widgets-groups-tables.ads b/spec/fltk-widgets-groups-tables.ads index 5b52623..faabc6d 100644 --- a/spec/fltk-widgets-groups-tables.ads +++ b/spec/fltk-widgets-groups-tables.ads @@ -55,6 +55,8 @@ package FLTK.Widgets.Groups.Tables is + -- Attributes -- + function H_Bar (This : in out Table) return Valuators.Sliders.Scrollbars.Scrollbar_Reference; @@ -70,6 +72,8 @@ package FLTK.Widgets.Groups.Tables is + -- Contents Modification -- + procedure Add (This : in out Table; Item : in out Widget'Class); @@ -94,6 +98,8 @@ package FLTK.Widgets.Groups.Tables is + -- Contents Query -- + function Has_Child (This : in Table; Place : in Index) @@ -130,6 +136,8 @@ package FLTK.Widgets.Groups.Tables is + -- Current -- + procedure Begin_Current (This : in out Table); @@ -139,6 +147,8 @@ package FLTK.Widgets.Groups.Tables is + -- Callbacks -- + procedure Set_Callback (This : in out Table; Func : in Widget_Callback); @@ -172,6 +182,8 @@ package FLTK.Widgets.Groups.Tables is + -- Columns -- + function Column_Headers_Enabled (This : in Table) return Boolean; @@ -250,6 +262,8 @@ package FLTK.Widgets.Groups.Tables is + -- Rows -- + function Row_Headers_Enabled (This : in Table) return Boolean; @@ -336,6 +350,8 @@ package FLTK.Widgets.Groups.Tables is + -- Selection -- + procedure Set_Cursor_Kind (This : in out Table; Kind : in Mouse_Cursor_Kind); @@ -403,6 +419,8 @@ package FLTK.Widgets.Groups.Tables is + -- Dimensions -- + function Get_Scrollbar_Size (This : in Table) return Integer; @@ -434,6 +452,8 @@ package FLTK.Widgets.Groups.Tables is + -- Drawing, Events -- + procedure Draw (This : in out Table); diff --git a/spec/fltk-widgets-groups-text_displays-text_editors.ads b/spec/fltk-widgets-groups-text_displays-text_editors.ads index e6355c7..641395b 100644 --- a/spec/fltk-widgets-groups-text_displays-text_editors.ads +++ b/spec/fltk-widgets-groups-text_displays-text_editors.ads @@ -64,6 +64,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Default Key Function -- + procedure KF_Default (This : in out Text_Editor'Class; Key : in Key_Combo); @@ -71,6 +73,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Operation Key Functions -- + procedure KF_Undo (This : in out Text_Editor'Class); @@ -92,6 +96,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Special Key Functions -- + procedure KF_Backspace (This : in out Text_Editor'Class); @@ -110,6 +116,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Movement Key Functions -- + procedure KF_Home (This : in out Text_Editor'Class); @@ -137,6 +145,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Shift Key Functions -- + procedure KF_Shift_Home (This : in out Text_Editor'Class); @@ -164,6 +174,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Control Key Functions -- + procedure KF_Ctrl_Home (This : in out Text_Editor'Class); @@ -191,6 +203,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Control Shift Key Functions -- + procedure KF_Ctrl_Shift_Home (This : in out Text_Editor'Class); @@ -218,6 +232,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Meta Key Functions -- + procedure KF_Meta_Home (This : in out Text_Editor'Class); @@ -245,6 +261,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Meta Shift Key Functions -- + procedure KF_Meta_Shift_Home (This : in out Text_Editor'Class); @@ -272,6 +290,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Default / Global Key Bindings -- + Default_Key_Bindings : constant Key_Binding_Array := ((Mod_None + Escape_Key, KF_Ignore'Access), (Mod_None + Enter_Key, KF_Enter'Access), @@ -349,6 +369,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Key Binding Modification -- + procedure Add_Key_Binding (This : in out Text_Editor; Key : in Key_Combo; @@ -397,6 +419,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Settings -- + function Get_Insert_Mode (This : in Text_Editor) return Insert_Mode; @@ -405,9 +429,6 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is (This : in out Text_Editor; To : in Insert_Mode); - - - function Get_Tab_Mode (This : in Text_Editor) return Tab_Navigation; @@ -419,6 +440,8 @@ package FLTK.Widgets.Groups.Text_Displays.Text_Editors is + -- Events -- + function Handle (This : in out Text_Editor; Event : in Event_Kind) @@ -541,7 +564,6 @@ private pragma Inline (Get_Insert_Mode); pragma Inline (Set_Insert_Mode); - pragma Inline (Get_Tab_Mode); pragma Inline (Set_Tab_Mode); diff --git a/spec/fltk-widgets-groups-text_displays.ads b/spec/fltk-widgets-groups-text_displays.ads index c56708a..c057ce0 100644 --- a/spec/fltk-widgets-groups-text_displays.ads +++ b/spec/fltk-widgets-groups-text_displays.ads @@ -26,8 +26,7 @@ package FLTK.Widgets.Groups.Text_Displays is type Cursor_Style is (Normal, Caret, Dim, Block, Heavy, Simple); - - Bounds_Error : exception; + type Position_Kind is (Cursor_Position, Character_Position); @@ -52,29 +51,62 @@ package FLTK.Widgets.Groups.Text_Displays is package Styles is - type Style_Entry is private; + type Style_Entry is record + Hue : Color; + Font : Font_Kind; + Size : Font_Size; + end record; + type Style_Index is new Character range 'A' .. '~'; + type Style_Array is array (Style_Index range <>) of Style_Entry; type Unfinished_Style_Callback is access procedure (Char : in Character; Display : in out Text_Display); - function Item - (Tint : in Color; - Font : in Font_Kind; - Size : in Font_Size) - return Style_Entry; + type Style_Mask is record + Fill : Boolean := False; + Secondary : Boolean := False; + Primary : Boolean := False; + Highlight : Boolean := False; + Background : Boolean := False; + Text_Only : Boolean := False; + end record; + + Empty_Mask : constant Style_Mask; + + type Style_Info is record + Mask : Style_Mask; + Index : Style_Index; + end record; private - type Style_Entry is record - Attr : Interfaces.C.unsigned; - Col : Interfaces.C.unsigned; - Font : Interfaces.C.int; - Size : Interfaces.C.int; + for Style_Entry use record + Hue at 1 * Interfaces.C.unsigned'Size / System.Storage_Unit + range 0 .. Interfaces.C.unsigned'Size - 1; + Font at 2 * Interfaces.C.unsigned'Size / System.Storage_Unit + range 0 .. Interfaces.C.int'Size - 1; + Size at 3 * Interfaces.C.unsigned'Size / System.Storage_Unit + range 0 .. Interfaces.C.int'Size - 1; end record; + for Style_Entry'Size use Interfaces.C.unsigned'Size * 3 + Interfaces.C.int'Size; + + for Style_Mask use record + Fill at 0 range 0 .. 0; + Secondary at 0 range 1 .. 1; + Primary at 0 range 2 .. 2; + Highlight at 0 range 3 .. 3; + Background at 0 range 4 .. 4; + Text_Only at 0 range 5 .. 5; + end record; + + for Style_Mask'Size use Interfaces.C.unsigned_char'Size; + + Empty_Mask : constant Style_Mask := (others => False); + pragma Convention (C, Style_Entry); pragma Convention (C, Style_Array); @@ -83,6 +115,8 @@ package FLTK.Widgets.Groups.Text_Displays is + -- Buffers -- + function Get_Buffer (This : in Text_Display) return FLTK.Text_Buffers.Text_Buffer_Reference; @@ -91,9 +125,23 @@ package FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display; Buff : in out FLTK.Text_Buffers.Text_Buffer); + procedure Buffer_Modified_Callback + (This : in out Text_Display; + Action : in FLTK.Text_Buffers.Modification; + Place : in FLTK.Text_Buffers.Position; + Length : in Natural; + Deleted_Text : in String); + + procedure Buffer_Predelete_Callback + (This : in out Text_Display; + Place : in FLTK.Text_Buffers.Position; + Length : in Natural); + + -- Highlighting -- + procedure Highlight_Data (This : in out Text_Display; Buff : in out FLTK.Text_Buffers.Text_Buffer; @@ -103,12 +151,21 @@ package FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display; Buff : in out FLTK.Text_Buffers.Text_Buffer; Table : in Styles.Style_Array; - Unfinished : in Styles.Style_Index; + Unfinished : in Character; Callback : in Styles.Unfinished_Style_Callback); + function Position_Style + (This : in Text_Display; + Line_Start : in Natural; + Line_Length : in Natural; + Line_Index : in Natural) + return Styles.Style_Info; + + -- Measurement Conversion -- + function Col_To_X (This : in Text_Display; Col_Num : in Integer) @@ -130,8 +187,60 @@ package FLTK.Widgets.Groups.Text_Displays is X, Y : out Integer; Vert_Out : out Boolean); + procedure Find_Line_End + (This : in Text_Display; + Start : in Natural; + Start_Pos_Is_Line_Start : in Boolean; + Line_End : out Natural; + Next_Line_Start : out Natural); + + function Find_Character + (This : in Text_Display; + Text : in String; + Style : in Styles.Style_Index; + X : in Integer) + return Natural; + + function Position_To_Line + (This : in Text_Display; + Position : in Natural) + return Natural; + + function Position_To_Line + (This : in Text_Display; + Position : in Natural; + Displayed : out Boolean) + return Natural; + + procedure Position_To_Line_Column + (This : in Text_Display; + Position : in Natural; + Line : out Natural; + Column : out Natural); + + procedure Position_To_Line_Column + (This : in Text_Display; + Position : in Natural; + Line : out Natural; + Column : out Natural; + Displayed : out Boolean); + + function XY_To_Position + (This : in Text_Display; + X, Y : in Integer; + Kind : in Position_Kind := Character_Position) + return Natural; + + procedure XY_To_Row_Column + (This : in Text_Display; + X, Y : in Integer; + Row, Column : out Natural; + Kind : in Position_Kind := Character_Position); + + + -- Cursors -- function Get_Cursor_Color (This : in Text_Display) @@ -154,6 +263,8 @@ package FLTK.Widgets.Groups.Text_Displays is + -- Text Settings -- + function Get_Text_Color (This : in Text_Display) return Color; @@ -181,6 +292,8 @@ package FLTK.Widgets.Groups.Text_Displays is + -- Text Insert -- + procedure Insert_Text (This : in out Text_Display; Item : in String); @@ -203,6 +316,8 @@ package FLTK.Widgets.Groups.Text_Displays is + -- Words -- + function Word_Start (This : in out Text_Display; Pos : in Natural) @@ -219,14 +334,48 @@ package FLTK.Widgets.Groups.Text_Displays is procedure Previous_Word (This : in out Text_Display); + + + + -- Wrapping -- + procedure Set_Wrap_Mode (This : in out Text_Display; Mode : in Wrap_Mode; Margin : in Natural := 0); + function Wrapped_Row + (This : in Text_Display; + Row : in Natural) + return Natural; + + function Wrapped_Column + (This : in Text_Display; + Row, Column : in Natural) + return Natural; + + function Wrap_Uses_Character + (This : in Text_Display; + Line_End : in Natural) + return Boolean; + + procedure Count_Wrapped_Lines + (This : in Text_Display; + Buffer : in FLTK.Text_Buffers.Text_Buffer; + Start : in Natural; + Max_Position, Max_Lines : in Natural; + Start_Pos_Is_Line_Start : in Boolean; + Style_Offset : in Natural; + Finish, Line_Count : out Natural; + End_Count_Line_Start : out Natural; + Last_Line_End : out Natural; + Count_Last_Missing_Newline : in Boolean := True); + + -- Lines -- + -- Takes into account word wrap function Line_Start (This : in Text_Display; @@ -259,8 +408,63 @@ package FLTK.Widgets.Groups.Text_Displays is Start, Lines : in Natural) return Natural; + procedure Calculate_Last_Character + (This : in out Text_Display); + + procedure Calculate_Line_Starts + (This : in out Text_Display; + Start, Finish : in Natural); + + procedure Offset_Line_Starts + (This : in out Text_Display; + New_Top : in Natural); + + + + + -- Absolute Lines -- + + procedure Redo_Absolute_Top_Line + (This : in out Text_Display; + Old_First : in Natural); + + function Get_Absolute_Top_Line + (This : in Text_Display) + return Natural; + + procedure Maintain_Absolute_Top_Line + (This : in out Text_Display; + State : in Boolean := True); + + function Maintaining_Absolute_Top_Line + (This : in Text_Display) + return Boolean; + + procedure Reset_Absolute_Top_Line + (This : in out Text_Display); + + + + + -- Visible Lines -- + function Has_Empty_Visible_Lines + (This : in Text_Display) + return Boolean; + function Get_Longest_Visible_Line + (This : in Text_Display) + return Natural; + + function Visible_Line_Length + (This : in Text_Display; + Line : in Natural) + return Natural; + + + + + -- Line Numbers -- function Get_Linenumber_Alignment (This : in Text_Display) @@ -310,27 +514,85 @@ package FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display; Width : in Natural); + function Get_Linenumber_Format + (This : in Text_Display) + return String; + + procedure Set_Linenumber_Format + (This : in out Text_Display; + Value : in String); + + + + + -- Text Measurement -- + + function Measure_Character + (This : in Text_Display; + Text : in String; + X : in Integer; + Index : in Positive) + return Long_Float; + + function Measure_Visible_Line + (This : in Text_Display; + Line : in Natural) + return Natural; + + function Measure_String + (This : in Text_Display; + Text : in String; + Style : in Styles.Style_Index) + return Long_Float; + + + -- Movement -- procedure Move_Down (This : in out Text_Display); + function Move_Down + (This : in out Text_Display) + return Boolean; + procedure Move_Left (This : in out Text_Display); + function Move_Left + (This : in out Text_Display) + return Boolean; + procedure Move_Right (This : in out Text_Display); + function Move_Right + (This : in out Text_Display) + return Boolean; + procedure Move_Up (This : in out Text_Display); + function Move_Up + (This : in out Text_Display) + return Boolean; + + + -- Scrolling -- procedure Scroll_To - (This : in out Text_Display; - Line : in Natural); + (This : in out Text_Display; + Line : in Natural; + Column : in Natural := 0); + + function Scroll_To + (This : in out Text_Display; + Line : in Natural; + Pixel : in Natural := 0) + return Boolean; function Get_Scrollbar_Alignment (This : in Text_Display) @@ -348,8 +610,46 @@ package FLTK.Widgets.Groups.Text_Displays is (This : in out Text_Display; Width : in Natural); + procedure Update_Horizontal_Scrollbar + (This : in out Text_Display); + + procedure Update_Vertical_Scrollbar + (This : in out Text_Display); + + + + + -- Shortcuts -- + + function Get_Shortcut + (This : in Text_Display) + return Key_Combo; + + procedure Set_Shortcut + (This : in out Text_Display; + Value : in Key_Combo); + + + + + -- Dimensions -- + + procedure Resize + (This : in out Text_Display; + X, Y, W, H : in Integer); + + + + -- Drawing, Events -- + procedure Clear_Rect + (This : in out Text_Display; + Style : in Styles.Style_Info; + X, Y, W, H : in Integer); + + procedure Display_Insert + (This : in out Text_Display); procedure Redisplay_Range (This : in out Text_Display; @@ -358,6 +658,36 @@ package FLTK.Widgets.Groups.Text_Displays is procedure Draw (This : in out Text_Display); + procedure Draw_Cursor + (This : in out Text_Display; + X, Y : in Integer); + + procedure Draw_Line_Numbers + (This : in out Text_Display; + Clear : in Boolean := False); + + procedure Draw_Range + (This : in out Text_Display; + Start, Finish : in Natural); + + procedure Draw_String + (This : in out Text_Display; + Style : in Styles.Style_Info; + X, Y : in Integer; + Right : in Integer; + Text : in String; + Num_Chars : in Natural); + + procedure Draw_Text + (This : in out Text_Display; + X, Y, W, H : in Integer); + + procedure Draw_Visible_Line + (This : in out Text_Display; + Line : in Natural; + Left_Clip, Right_Clip : in Integer; + Left_Char, Right_Char : in Natural); + function Handle (This : in out Text_Display; Event : in Event_Kind) @@ -409,6 +739,7 @@ private pragma Inline (Get_Buffer); pragma Inline (Set_Buffer); + pragma Inline (Buffer_Predelete_Callback); pragma Inline (Highlight_Data); @@ -416,6 +747,12 @@ private pragma Inline (X_To_Col); pragma Inline (In_Selection); pragma Inline (Position_To_XY); + pragma Inline (Find_Line_End); + pragma Inline (Find_Character); + pragma Inline (Position_To_Line); + pragma Inline (Position_To_Line_Column); + pragma Inline (XY_To_Position); + pragma Inline (XY_To_Row_Column); pragma Inline (Get_Cursor_Color); pragma Inline (Set_Cursor_Color); @@ -440,13 +777,31 @@ private pragma Inline (Word_End); pragma Inline (Next_Word); pragma Inline (Previous_Word); + pragma Inline (Set_Wrap_Mode); + pragma Inline (Wrapped_Row); + pragma Inline (Wrapped_Column); + pragma Inline (Wrap_Uses_Character); + pragma Inline (Count_Wrapped_Lines); pragma Inline (Line_Start); pragma Inline (Line_End); pragma Inline (Count_Lines); pragma Inline (Skip_Lines); pragma Inline (Rewind_Lines); + pragma Inline (Calculate_Last_Character); + pragma Inline (Calculate_Line_Starts); + pragma Inline (Offset_Line_Starts); + + pragma Inline (Redo_Absolute_Top_Line); + pragma Inline (Get_Absolute_Top_Line); + pragma Inline (Maintain_Absolute_Top_Line); + pragma Inline (Maintaining_Absolute_Top_Line); + pragma Inline (Reset_Absolute_Top_Line); + + pragma Inline (Has_Empty_Visible_Lines); + pragma Inline (Get_Longest_Visible_Line); + pragma Inline (Visible_Line_Length); pragma Inline (Get_Linenumber_Alignment); pragma Inline (Set_Linenumber_Alignment); @@ -460,6 +815,12 @@ private pragma Inline (Set_Linenumber_Size); pragma Inline (Get_Linenumber_Width); pragma Inline (Set_Linenumber_Width); + pragma Inline (Get_Linenumber_Format); + pragma Inline (Set_Linenumber_Format); + + pragma Inline (Measure_Character); + pragma Inline (Measure_Visible_Line); + pragma Inline (Measure_String); pragma Inline (Move_Down); pragma Inline (Move_Left); @@ -471,9 +832,24 @@ private pragma Inline (Set_Scrollbar_Alignment); pragma Inline (Get_Scrollbar_Width); pragma Inline (Set_Scrollbar_Width); + pragma Inline (Update_Horizontal_Scrollbar); + pragma Inline (Update_Vertical_Scrollbar); + + pragma Inline (Get_Shortcut); + pragma Inline (Set_Shortcut); + + pragma Inline (Resize); + pragma Inline (Clear_Rect); + pragma Inline (Display_Insert); pragma Inline (Redisplay_Range); pragma Inline (Draw); + pragma Inline (Draw_Cursor); + pragma Inline (Draw_Line_Numbers); + pragma Inline (Draw_Range); + pragma Inline (Draw_String); + pragma Inline (Draw_Text); + pragma Inline (Draw_Visible_Line); pragma Inline (Handle); diff --git a/spec/fltk-widgets-groups-tiled.ads b/spec/fltk-widgets-groups-tiled.ads index 9edaf6b..43c7d51 100644 --- a/spec/fltk-widgets-groups-tiled.ads +++ b/spec/fltk-widgets-groups-tiled.ads @@ -33,6 +33,8 @@ package FLTK.Widgets.Groups.Tiled is + -- Dimensions -- + procedure Position (This : in out Tiled_Group; Old_X, Old_Y : in Integer; @@ -45,6 +47,8 @@ package FLTK.Widgets.Groups.Tiled is + -- Events -- + function Handle (This : in out Tiled_Group; Event : in Event_Kind) diff --git a/spec/fltk-widgets-groups-windows-double-cairo.ads b/spec/fltk-widgets-groups-windows-double-cairo.ads index 8073a81..a5430c4 100644 --- a/spec/fltk-widgets-groups-windows-double-cairo.ads +++ b/spec/fltk-widgets-groups-windows-double-cairo.ads @@ -72,6 +72,8 @@ package FLTK.Widgets.Groups.Windows.Double.Cairo is + -- Cairo Callback -- + procedure Set_Cairo_Draw (This : in out Cairo_Window; Func : in Cairo_Callback); @@ -79,6 +81,8 @@ package FLTK.Widgets.Groups.Windows.Double.Cairo is + -- Drawing -- + procedure Draw (This : in out Cairo_Window); diff --git a/spec/fltk-widgets-groups-windows-double-overlay.ads b/spec/fltk-widgets-groups-windows-double-overlay.ads index bd60292..a6d271c 100644 --- a/spec/fltk-widgets-groups-windows-double-overlay.ads +++ b/spec/fltk-widgets-groups-windows-double-overlay.ads @@ -44,6 +44,8 @@ package FLTK.Widgets.Groups.Windows.Double.Overlay is + -- Visibility -- + procedure Show (This : in out Overlay_Window); @@ -59,6 +61,8 @@ package FLTK.Widgets.Groups.Windows.Double.Overlay is + -- Settings -- + function Can_Do_Overlay (This : in Overlay_Window) return Boolean; @@ -70,6 +74,8 @@ package FLTK.Widgets.Groups.Windows.Double.Overlay is + -- Drawing -- + -- You must override this subprogram procedure Draw_Overlay (This : in out Overlay_Window); diff --git a/spec/fltk-widgets-groups-windows-double.ads b/spec/fltk-widgets-groups-windows-double.ads index ed957ac..f9ccf85 100644 --- a/spec/fltk-widgets-groups-windows-double.ads +++ b/spec/fltk-widgets-groups-windows-double.ads @@ -44,6 +44,8 @@ package FLTK.Widgets.Groups.Windows.Double is + -- Visibility -- + procedure Show (This : in out Double_Window); @@ -62,6 +64,8 @@ package FLTK.Widgets.Groups.Windows.Double is + -- Dimensions -- + procedure Resize (This : in out Double_Window; X, Y, W, H : in Integer); diff --git a/spec/fltk-widgets-groups-windows-opengl.ads b/spec/fltk-widgets-groups-windows-opengl.ads index 2ce374d..825df4f 100644 --- a/spec/fltk-widgets-groups-windows-opengl.ads +++ b/spec/fltk-widgets-groups-windows-opengl.ads @@ -69,9 +69,7 @@ package FLTK.Widgets.Groups.Windows.OpenGL is - --------------- - -- Display -- - --------------- + -- Visibility -- procedure Show (This : in out GL_Window); @@ -91,9 +89,7 @@ package FLTK.Widgets.Groups.Windows.OpenGL is - ------------------ -- Dimensions -- - ------------------ function Pixel_H (This : in GL_Window) @@ -114,9 +110,7 @@ package FLTK.Widgets.Groups.Windows.OpenGL is - -------------------- -- OpenGL Modes -- - -------------------- function Get_Mode (This : in GL_Window) @@ -141,9 +135,7 @@ package FLTK.Widgets.Groups.Windows.OpenGL is - ----------------------- -- OpenGL Contexts -- - ----------------------- function Get_Context (This : in GL_Window) @@ -182,9 +174,7 @@ package FLTK.Widgets.Groups.Windows.OpenGL is - ---------------------------------- - -- Drawing and Event Handling -- - ---------------------------------- + -- Drawing, Events -- procedure Ortho (This : in out GL_Window); diff --git a/spec/fltk-widgets-groups-windows-single-menu.ads b/spec/fltk-widgets-groups-windows-single-menu.ads index 7b89f29..c9dd1ea 100644 --- a/spec/fltk-widgets-groups-windows-single-menu.ads +++ b/spec/fltk-widgets-groups-windows-single-menu.ads @@ -44,6 +44,8 @@ package FLTK.Widgets.Groups.Windows.Single.Menu is + -- Visibility -- + procedure Show (This : in out Menu_Window); @@ -59,6 +61,8 @@ package FLTK.Widgets.Groups.Windows.Single.Menu is + -- Overlay -- + function Is_Overlay (This : in Menu_Window) return Boolean; diff --git a/spec/fltk-widgets-groups-windows-single.ads b/spec/fltk-widgets-groups-windows-single.ads index bcc08a8..1517fbf 100644 --- a/spec/fltk-widgets-groups-windows-single.ads +++ b/spec/fltk-widgets-groups-windows-single.ads @@ -44,6 +44,8 @@ package FLTK.Widgets.Groups.Windows.Single is + -- Visibility -- + procedure Show (This : in out Single_Window); @@ -56,6 +58,8 @@ package FLTK.Widgets.Groups.Windows.Single is + -- Current -- + procedure Make_Current (This : in out Single_Window); diff --git a/spec/fltk-widgets-groups-windows.ads b/spec/fltk-widgets-groups-windows.ads index 6a3233d..e2f9b3e 100644 --- a/spec/fltk-widgets-groups-windows.ads +++ b/spec/fltk-widgets-groups-windows.ads @@ -8,10 +8,6 @@ with FLTK.Images.RGB; -private with - - Interfaces.C.Strings; - package FLTK.Widgets.Groups.Windows is @@ -21,8 +17,6 @@ package FLTK.Widgets.Groups.Windows is type Window_Reference (Data : not null access Window'Class) is limited null record with Implicit_Dereference => Data; - type Border_State is (None, Visible); - type Modal_State is (Normal, Non_Modal, Modal); @@ -57,6 +51,8 @@ package FLTK.Widgets.Groups.Windows is + -- Visibility -- + procedure Show (This : in out Window); @@ -82,11 +78,10 @@ package FLTK.Widgets.Groups.Windows is function Last_Made_Current return access Window'Class; - procedure Free_Position - (This : in out Window); + -- Fullscreen -- function Is_Fullscreen (This : in Window) @@ -109,12 +104,26 @@ package FLTK.Widgets.Groups.Windows is + -- Icons, Cursors -- + procedure Set_Icon (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class); + Pic : in FLTK.Images.RGB.RGB_Image'Class); + + procedure Set_Icons + (This : in out Window; + Pics : in FLTK.Images.RGB.RGB_Image_Array); + + procedure Reset_Icons + (This : in out Window); procedure Set_Default_Icon - (Pic : in out FLTK.Images.RGB.RGB_Image'Class); + (Pic : in FLTK.Images.RGB.RGB_Image'Class); + + procedure Set_Default_Icons + (Pics : in FLTK.Images.RGB.RGB_Image_Array); + + procedure Reset_Default_Icons; function Get_Icon_Label (This : in Window) @@ -130,7 +139,7 @@ package FLTK.Widgets.Groups.Windows is procedure Set_Cursor (This : in out Window; - Pic : in out FLTK.Images.RGB.RGB_Image'Class; + Pic : in FLTK.Images.RGB.RGB_Image'Class; Hot_X, Hot_Y : in Integer); procedure Set_Default_Cursor @@ -140,13 +149,18 @@ package FLTK.Widgets.Groups.Windows is - function Get_Border_State + -- Settings -- + + function Has_Border (This : in Window) - return Border_State; + return Boolean; - procedure Set_Border_State - (This : in out Window; - To : in Border_State); + procedure Set_Border + (This : in out Window; + Value : in Boolean := True); + + procedure Clear_Border + (This : in out Window); function Is_Override (This : in Window) @@ -155,16 +169,35 @@ package FLTK.Widgets.Groups.Windows is procedure Set_Override (This : in out Window); + function Is_Modal + (This : in Window) + return Boolean; + + function Is_Non_Modal + (This : in Window) + return Boolean; + function Get_Modal_State (This : in Window) return Modal_State; + procedure Set_Modal + (This : in out Window); + + procedure Set_Non_Modal + (This : in out Window); + procedure Set_Modal_State - (This : in out Window; - To : in Modal_State); + (This : in out Window; + Value : in Modal_State); + + procedure Clear_Modal_State + (This : in out Window); + + -- Labels, Hotspot, Shape -- function Get_Label (This : in Window) @@ -174,6 +207,10 @@ package FLTK.Widgets.Groups.Windows is (This : in out Window; Text : in String); + procedure Set_Labels + (This : in out Window; + Text, Icon_Text : in String); + procedure Hotspot (This : in out Window; X, Y : in Integer; @@ -184,18 +221,32 @@ package FLTK.Widgets.Groups.Windows is Item : in Widget'Class; Offscreen : in Boolean := False); + procedure Shape + (This : in out Window; + Pic : in FLTK.Images.Image'Class); + + + + + -- Dimensions -- + procedure Set_Size_Range (This : in out Window; Min_W, Min_H : in Integer; Max_W, Max_H, Incre_W, Incre_H : in Integer := 0; Keep_Aspect : in Boolean := False); - procedure Shape - (This : in out Window; - Pic : in out FLTK.Images.Image'Class); - + procedure Resize + (This : in out Window; + X, Y, W, H : in Integer); + function Is_Position_Forced + (This : in Window) + return Boolean; + procedure Force_Position + (This : in out Window; + State : in Boolean := True); function Get_X_Root (This : in Window) @@ -216,9 +267,41 @@ package FLTK.Widgets.Groups.Windows is + -- Class Info -- + + function Get_X_Class + (This : in Window) + return String; + + procedure Set_X_Class + (This : in out Window; + Value : in String); + + function Get_Default_X_Class + return String; + + procedure Set_Default_X_Class + (Value : in String); + + function Is_Menu_Window + (This : in Window) + return Boolean; + + function Is_Tooltip_Window + (This : in Window) + return Boolean; + + + + + -- Drawing, Events -- + procedure Draw (This : in out Window); + procedure Flush + (This : in out Window); + function Handle (This : in out Window; Event : in Event_Kind) @@ -255,7 +338,6 @@ private pragma Inline (Iconify); pragma Inline (Make_Current); pragma Inline (Last_Made_Current); - pragma Inline (Free_Position); pragma Inline (Is_Fullscreen); pragma Inline (Fullscreen_On); @@ -263,31 +345,53 @@ private pragma Inline (Fullscreen_Screens); pragma Inline (Set_Icon); + pragma Inline (Set_Icons); + pragma Inline (Reset_Icons); pragma Inline (Set_Default_Icon); + pragma Inline (Set_Default_Icons); + pragma Inline (Reset_Default_Icons); pragma Inline (Get_Icon_Label); pragma Inline (Set_Icon_Label); pragma Inline (Set_Cursor); pragma Inline (Set_Default_Cursor); - pragma Inline (Get_Border_State); - pragma Inline (Set_Border_State); + pragma Inline (Has_Border); + pragma Inline (Set_Border); + pragma Inline (Clear_Border); pragma Inline (Is_Override); pragma Inline (Set_Override); + pragma Inline (Is_Modal); + pragma Inline (Is_Non_Modal); pragma Inline (Get_Modal_State); + pragma Inline (Set_Modal); + pragma Inline (Set_Non_Modal); pragma Inline (Set_Modal_State); + pragma Inline (Clear_Modal_State); pragma Inline (Get_Label); pragma Inline (Set_Label); + pragma Inline (Set_Labels); pragma Inline (Hotspot); - pragma Inline (Set_Size_Range); pragma Inline (Shape); + pragma Inline (Set_Size_Range); + pragma Inline (Resize); + pragma Inline (Is_Position_Forced); + pragma Inline (Force_Position); pragma Inline (Get_X_Root); pragma Inline (Get_Y_Root); pragma Inline (Get_Decorated_W); pragma Inline (Get_Decorated_H); + pragma Inline (Get_X_Class); + pragma Inline (Set_X_Class); + pragma Inline (Get_Default_X_Class); + pragma Inline (Set_Default_X_Class); + pragma Inline (Is_Menu_Window); + pragma Inline (Is_Tooltip_Window); + pragma Inline (Draw); + pragma Inline (Flush); pragma Inline (Handle); diff --git a/spec/fltk-widgets-groups-wizards.ads b/spec/fltk-widgets-groups-wizards.ads index 0ec0e39..1d748be 100644 --- a/spec/fltk-widgets-groups-wizards.ads +++ b/spec/fltk-widgets-groups-wizards.ads @@ -33,6 +33,8 @@ package FLTK.Widgets.Groups.Wizards is + -- Navigation -- + procedure Next (This : in out Wizard); @@ -42,6 +44,8 @@ package FLTK.Widgets.Groups.Wizards is + -- Visibility -- + function Get_Visible (This : in Wizard) return access Widget'Class; @@ -53,6 +57,8 @@ package FLTK.Widgets.Groups.Wizards is + -- Drawing -- + procedure Draw (This : in out Wizard); diff --git a/spec/fltk-widgets-groups.ads b/spec/fltk-widgets-groups.ads index 33c0cb3..9532084 100644 --- a/spec/fltk-widgets-groups.ads +++ b/spec/fltk-widgets-groups.ads @@ -53,6 +53,8 @@ package FLTK.Widgets.Groups is + -- Contents Modification -- + procedure Add (This : in out Group; Item : in out Widget'Class); @@ -81,6 +83,8 @@ package FLTK.Widgets.Groups is + -- Contents Query -- + function Has_Child (This : in Group; Place : in Index) @@ -113,6 +117,8 @@ package FLTK.Widgets.Groups is + -- Iteration -- + package Group_Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Child); @@ -123,6 +129,8 @@ package FLTK.Widgets.Groups is + -- Clipping -- + function Get_Clip_Mode (This : in Group) return Clip_Mode; @@ -134,6 +142,8 @@ package FLTK.Widgets.Groups is + -- Dimensions -- + procedure Add_Resizable (This : in out Group; Item : in out Widget'Class); @@ -156,6 +166,8 @@ package FLTK.Widgets.Groups is + -- Current -- + function Get_Current return access Group'Class; @@ -171,6 +183,8 @@ package FLTK.Widgets.Groups is + -- Drawing, Events -- + procedure Draw (This : in out Group); diff --git a/spec/fltk-widgets-inputs-text-file.ads b/spec/fltk-widgets-inputs-text-file.ads index 1f2883b..7bc2564 100644 --- a/spec/fltk-widgets-inputs-text-file.ads +++ b/spec/fltk-widgets-inputs-text-file.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Inputs.Text.File is + -- Settings -- + function Get_Down_Box (This : in File_Input) return Box_Kind; @@ -57,6 +59,8 @@ package FLTK.Widgets.Inputs.Text.File is + -- Text Field -- + function Get_Value (This : in File_Input) return String; @@ -68,6 +72,8 @@ package FLTK.Widgets.Inputs.Text.File is + -- Drawing, Events -- + procedure Draw (This : in out File_Input); diff --git a/spec/fltk-widgets-inputs-text-floating_point.ads b/spec/fltk-widgets-inputs-text-floating_point.ads index db4e0ae..3d24652 100644 --- a/spec/fltk-widgets-inputs-text-floating_point.ads +++ b/spec/fltk-widgets-inputs-text-floating_point.ads @@ -4,6 +4,9 @@ -- Released into the public domain +-- Naming this package Float would have caused ambiguity with the Float type + + limited with FLTK.Widgets.Groups; @@ -38,6 +41,8 @@ package FLTK.Widgets.Inputs.Text.Floating_Point is + -- Text Field -- + function Get_Value (This : in Float_Input) return Long_Float; diff --git a/spec/fltk-widgets-inputs-text-secret.ads b/spec/fltk-widgets-inputs-text-secret.ads index cd98283..aa94b45 100644 --- a/spec/fltk-widgets-inputs-text-secret.ads +++ b/spec/fltk-widgets-inputs-text-secret.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Inputs.Text.Secret is + -- Events -- + function Handle (This : in out Secret_Input; Event : in Event_Kind) diff --git a/spec/fltk-widgets-inputs-text-whole_number.ads b/spec/fltk-widgets-inputs-text-whole_number.ads index 9c13dc6..7ff8514 100644 --- a/spec/fltk-widgets-inputs-text-whole_number.ads +++ b/spec/fltk-widgets-inputs-text-whole_number.ads @@ -4,6 +4,9 @@ -- Released into the public domain +-- Naming this package Integer would have caused ambiguity with the Integer type + + limited with FLTK.Widgets.Groups; @@ -38,6 +41,8 @@ package FLTK.Widgets.Inputs.Text.Whole_Number is + -- Text Field -- + function Get_Value (This : in Integer_Input) return Long_Integer; diff --git a/spec/fltk-widgets-inputs-text.ads b/spec/fltk-widgets-inputs-text.ads index c73e869..64ece1c 100644 --- a/spec/fltk-widgets-inputs-text.ads +++ b/spec/fltk-widgets-inputs-text.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Inputs.Text is + -- Drawing, Events -- + procedure Draw (This : in out Text_Input); diff --git a/spec/fltk-widgets-inputs.ads b/spec/fltk-widgets-inputs.ads index c7f9c17..6de80da 100644 --- a/spec/fltk-widgets-inputs.ads +++ b/spec/fltk-widgets-inputs.ads @@ -10,8 +10,7 @@ limited with private with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; package FLTK.Widgets.Inputs is @@ -50,6 +49,8 @@ package FLTK.Widgets.Inputs is + -- Clipboard -- + procedure Copy (This : in out Input; Destination : in Clipboard_Kind := Cut_Paste_Board); @@ -101,6 +102,8 @@ package FLTK.Widgets.Inputs is + -- Readonly, Tabs, Wrap -- + function Is_Readonly (This : in Input) return Boolean; @@ -128,15 +131,17 @@ package FLTK.Widgets.Inputs is + -- Shortcut, Input Position -- + function Get_Kind (This : in Input) return Input_Kind; - function Get_Shortcut_Key + function Get_Shortcut (This : in Input) return Key_Combo; - procedure Set_Shortcut_Key + procedure Set_Shortcut (This : in out Input; To : in Key_Combo); @@ -180,6 +185,8 @@ package FLTK.Widgets.Inputs is + -- Text Field -- + function Index (This : in Input; Place : in Integer) @@ -221,6 +228,8 @@ package FLTK.Widgets.Inputs is + -- Input Size -- + function Get_Maximum_Size (This : in Input) return Natural; @@ -236,6 +245,8 @@ package FLTK.Widgets.Inputs is + -- Cursors, Text Settings -- + function Get_Cursor_Color (This : in Input) return Color; @@ -271,6 +282,8 @@ package FLTK.Widgets.Inputs is + -- Dimensions -- + procedure Resize (This : in out Input; W, H : in Integer); @@ -282,6 +295,8 @@ package FLTK.Widgets.Inputs is + -- Changing Input Type -- + package Extra is procedure Set_Kind @@ -326,8 +341,8 @@ private pragma Inline (Set_Wrap); pragma Inline (Get_Kind); - pragma Inline (Get_Shortcut_Key); - pragma Inline (Set_Shortcut_Key); + pragma Inline (Get_Shortcut); + pragma Inline (Set_Shortcut); pragma Inline (Get_Mark); pragma Inline (Set_Mark); pragma Inline (Get_Position); diff --git a/spec/fltk-widgets-menus-choices.ads b/spec/fltk-widgets-menus-choices.ads index 7a5c225..cda6b64 100644 --- a/spec/fltk-widgets-menus-choices.ads +++ b/spec/fltk-widgets-menus-choices.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Menus.Choices is + -- Selection -- + function Chosen_Index (This : in Choice) return Extended_Index; @@ -63,6 +65,8 @@ package FLTK.Widgets.Menus.Choices is + -- Drawing, Events -- + procedure Draw (This : in out Choice); diff --git a/spec/fltk-widgets-menus-menu_bars-systemwide.ads b/spec/fltk-widgets-menus-menu_bars-systemwide.ads index 77dba9f..08f97d2 100644 --- a/spec/fltk-widgets-menus-menu_bars-systemwide.ads +++ b/spec/fltk-widgets-menus-menu_bars-systemwide.ads @@ -42,6 +42,8 @@ package FLTK.Widgets.Menus.Menu_Bars.Systemwide is + -- Menu Items -- + procedure Add (This : in out System_Menu_Bar; Text : in String); @@ -133,6 +135,8 @@ package FLTK.Widgets.Menus.Menu_Bars.Systemwide is + -- Item Query -- + function Item (This : in System_Menu_Bar; Place : in Index) @@ -141,6 +145,8 @@ package FLTK.Widgets.Menus.Menu_Bars.Systemwide is + -- Label, Shortcut, Flags -- + procedure Set_Only (This : in out System_Menu_Bar; Item : in out FLTK.Menu_Items.Menu_Item); @@ -168,6 +174,8 @@ package FLTK.Widgets.Menus.Menu_Bars.Systemwide is + -- Global -- + procedure Make_Global (This : in out System_Menu_Bar); @@ -177,6 +185,8 @@ package FLTK.Widgets.Menus.Menu_Bars.Systemwide is + -- Drawing -- + procedure Draw (This : in out System_Menu_Bar); diff --git a/spec/fltk-widgets-menus-menu_bars.ads b/spec/fltk-widgets-menus-menu_bars.ads index fc4b3ce..72c40de 100644 --- a/spec/fltk-widgets-menus-menu_bars.ads +++ b/spec/fltk-widgets-menus-menu_bars.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Menus.Menu_Bars is + -- Drawing, Events -- + procedure Draw (This : in out Menu_Bar); diff --git a/spec/fltk-widgets-menus-menu_buttons.ads b/spec/fltk-widgets-menus-menu_buttons.ads index b265d7c..7a93a6d 100644 --- a/spec/fltk-widgets-menus-menu_buttons.ads +++ b/spec/fltk-widgets-menus-menu_buttons.ads @@ -4,10 +4,6 @@ -- Released into the public domain -with - - FLTK.Menu_Items; - limited with FLTK.Widgets.Groups; @@ -45,6 +41,8 @@ package FLTK.Widgets.Menus.Menu_Buttons is + -- Popup -- + function Get_Popup_Kind (This : in Menu_Button) return Popup_Buttons; @@ -60,6 +58,8 @@ package FLTK.Widgets.Menus.Menu_Buttons is + -- Drawing, Events -- + procedure Draw (This : in out Menu_Button); diff --git a/spec/fltk-widgets-menus.ads b/spec/fltk-widgets-menus.ads index bce29dd..d24ebbe 100644 --- a/spec/fltk-widgets-menus.ads +++ b/spec/fltk-widgets-menus.ads @@ -68,6 +68,8 @@ package FLTK.Widgets.Menus is + -- Menu Items -- + procedure Add (This : in out Menu; Text : in String); @@ -163,6 +165,8 @@ package FLTK.Widgets.Menus is + -- Item Query -- + function Has_Item (This : in Menu; Place : in Index) @@ -224,6 +228,8 @@ package FLTK.Widgets.Menus is + -- Iteration -- + package Menu_Iterators is new Ada.Iterator_Interfaces (Cursor, Has_Item); @@ -234,6 +240,8 @@ package FLTK.Widgets.Menus is + -- Selection -- + function Chosen (This : in Menu) return FLTK.Menu_Items.Menu_Item_Reference; @@ -267,6 +275,8 @@ package FLTK.Widgets.Menus is + -- Label, Shortcut, Flags -- + procedure Set_Only (This : in out Menu; Item : in out FLTK.Menu_Items.Menu_Item); @@ -299,6 +309,8 @@ package FLTK.Widgets.Menus is + -- Text Settings -- + function Get_Text_Color (This : in Menu) return Color; @@ -326,6 +338,8 @@ package FLTK.Widgets.Menus is + -- Miscellaneous -- + function Get_Down_Box (This : in Menu) return Box_Kind; @@ -345,6 +359,8 @@ package FLTK.Widgets.Menus is + -- Menu Item Methods -- + function Popup (This : in Menu; X, Y : in Integer; @@ -380,6 +396,8 @@ package FLTK.Widgets.Menus is + -- Dimensions -- + procedure Resize (This : in out Menu; W, H : in Integer); @@ -387,6 +405,8 @@ package FLTK.Widgets.Menus is + -- Drawing -- + procedure Draw_Item (This : in out Menu; Item : in Index; diff --git a/spec/fltk-widgets-positioners.ads b/spec/fltk-widgets-positioners.ads index 0603239..4e06155 100644 --- a/spec/fltk-widgets-positioners.ads +++ b/spec/fltk-widgets-positioners.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Positioners is + -- Targeting -- + procedure Get_Coords (This : in Positioner; X, Y : out Long_Float); @@ -54,6 +56,8 @@ package FLTK.Widgets.Positioners is + -- X Axis -- + procedure Set_Ecks_Bounds (This : in out Positioner; Low, High : in Long_Float); @@ -94,6 +98,8 @@ package FLTK.Widgets.Positioners is + -- Y Axis -- + procedure Set_Why_Bounds (This : in out Positioner; Low, High : in Long_Float); @@ -134,6 +140,8 @@ package FLTK.Widgets.Positioners is + -- Drawing, Events -- + procedure Draw (This : in out Positioner); diff --git a/spec/fltk-widgets-progress_bars.ads b/spec/fltk-widgets-progress_bars.ads index 01fe674..068f8a7 100644 --- a/spec/fltk-widgets-progress_bars.ads +++ b/spec/fltk-widgets-progress_bars.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Progress_Bars is + -- Values -- + function Get_Minimum (This : in Progress_Bar) return Float; @@ -65,6 +67,8 @@ package FLTK.Widgets.Progress_Bars is + -- Drawing -- + procedure Draw (This : in out Progress_Bar); diff --git a/spec/fltk-widgets-valuators-adjusters.ads b/spec/fltk-widgets-valuators-adjusters.ads index c980d53..fb8fc9f 100644 --- a/spec/fltk-widgets-valuators-adjusters.ads +++ b/spec/fltk-widgets-valuators-adjusters.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators.Adjusters is + -- Allow Outside Range -- + function Is_Soft (This : in Adjuster) return Boolean; @@ -49,6 +51,8 @@ package FLTK.Widgets.Valuators.Adjusters is + -- Drawing, Events -- + procedure Value_Damage (This : in out Adjuster); diff --git a/spec/fltk-widgets-valuators-counters.ads b/spec/fltk-widgets-valuators-counters.ads index fd3cea8..0bea0a6 100644 --- a/spec/fltk-widgets-valuators-counters.ads +++ b/spec/fltk-widgets-valuators-counters.ads @@ -40,6 +40,8 @@ package FLTK.Widgets.Valuators.Counters is + -- Button Steps -- + function Get_Step (This : in Counter) return Long_Float; @@ -63,6 +65,8 @@ package FLTK.Widgets.Valuators.Counters is + -- Text Settings -- + function Get_Text_Color (This : in Counter) return Color; @@ -90,6 +94,8 @@ package FLTK.Widgets.Valuators.Counters is + -- Drawing, Events -- + procedure Draw (This : in out Counter); @@ -101,6 +107,8 @@ package FLTK.Widgets.Valuators.Counters is + -- Counter Type -- + function Get_Kind (This : in out Counter) return Counter_Kind; diff --git a/spec/fltk-widgets-valuators-dials.ads b/spec/fltk-widgets-valuators-dials.ads index 036c6f1..ff16ea6 100644 --- a/spec/fltk-widgets-valuators-dials.ads +++ b/spec/fltk-widgets-valuators-dials.ads @@ -40,6 +40,8 @@ package FLTK.Widgets.Valuators.Dials is + -- Limit Angles -- + function Get_First_Angle (This : in Dial) return Short_Integer; @@ -63,6 +65,8 @@ package FLTK.Widgets.Valuators.Dials is + -- Drawing, Events -- + procedure Draw (This : in out Dial); @@ -84,6 +88,8 @@ package FLTK.Widgets.Valuators.Dials is + -- Dial Type -- + function Get_Kind (This : in Dial) return Dial_Kind; diff --git a/spec/fltk-widgets-valuators-rollers.ads b/spec/fltk-widgets-valuators-rollers.ads index 7a5effc..782fefc 100644 --- a/spec/fltk-widgets-valuators-rollers.ads +++ b/spec/fltk-widgets-valuators-rollers.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators.Rollers is + -- Drawing, Events -- + procedure Draw (This : in out Roller); diff --git a/spec/fltk-widgets-valuators-sliders-scrollbars.ads b/spec/fltk-widgets-valuators-sliders-scrollbars.ads index 79b4c69..5ab2a54 100644 --- a/spec/fltk-widgets-valuators-sliders-scrollbars.ads +++ b/spec/fltk-widgets-valuators-sliders-scrollbars.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators.Sliders.Scrollbars is + -- Line Position -- + function Get_Line_Size (This : in Scrollbar) return Natural; @@ -64,6 +66,8 @@ package FLTK.Widgets.Valuators.Sliders.Scrollbars is + -- Drawing, Events -- + procedure Draw (This : in out Scrollbar); diff --git a/spec/fltk-widgets-valuators-sliders-value.ads b/spec/fltk-widgets-valuators-sliders-value.ads index f9f849f..a68c404 100644 --- a/spec/fltk-widgets-valuators-sliders-value.ads +++ b/spec/fltk-widgets-valuators-sliders-value.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators.Sliders.Value is + -- Text Settings -- + function Get_Text_Color (This : in Value_Slider) return Color; @@ -65,6 +67,8 @@ package FLTK.Widgets.Valuators.Sliders.Value is + -- Drawing, Events -- + procedure Draw (This : in out Value_Slider); diff --git a/spec/fltk-widgets-valuators-sliders.ads b/spec/fltk-widgets-valuators-sliders.ads index 786a9f5..9f4b7db 100644 --- a/spec/fltk-widgets-valuators-sliders.ads +++ b/spec/fltk-widgets-valuators-sliders.ads @@ -56,6 +56,8 @@ package FLTK.Widgets.Valuators.Sliders is + -- Settings -- + procedure Set_Bounds (This : in out Slider; Min, Max : in Long_Float); @@ -86,6 +88,8 @@ package FLTK.Widgets.Valuators.Sliders is + -- Drawing, Events -- + procedure Draw (This : in out Slider); @@ -107,6 +111,8 @@ package FLTK.Widgets.Valuators.Sliders is + -- Slider Type -- + function Get_Kind (This : in Slider) return Slider_Kind; diff --git a/spec/fltk-widgets-valuators-value_inputs.ads b/spec/fltk-widgets-valuators-value_inputs.ads index 7392e78..ba1d66f 100644 --- a/spec/fltk-widgets-valuators-value_inputs.ads +++ b/spec/fltk-widgets-valuators-value_inputs.ads @@ -42,6 +42,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Attributes -- + function Text_Field (This : in out Value_Input) return FLTK.Widgets.Inputs.Text.Text_Input_Reference; @@ -49,6 +51,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Cursors -- + function Get_Cursor_Color (This : in Value_Input) return Color; @@ -60,6 +64,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Shortcut -- + function Get_Shortcut (This : in Value_Input) return Key_Combo; @@ -71,6 +77,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Allow Outside Range -- + function Is_Soft (This : in Value_Input) return Boolean; @@ -82,6 +90,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Text Settings -- + function Get_Text_Color (This : in Value_Input) return Color; @@ -109,6 +119,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Dimensions -- + procedure Resize (This : in out Value_Input; X, Y, W, H : in Integer); @@ -116,6 +128,8 @@ package FLTK.Widgets.Valuators.Value_Inputs is + -- Drawing, Events -- + procedure Draw (This : in out Value_Input); diff --git a/spec/fltk-widgets-valuators-value_outputs.ads b/spec/fltk-widgets-valuators-value_outputs.ads index a8447a7..09c1da5 100644 --- a/spec/fltk-widgets-valuators-value_outputs.ads +++ b/spec/fltk-widgets-valuators-value_outputs.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators.Value_Outputs is + -- Allow Outside Range -- + function Is_Soft (This : in Value_Output) return Boolean; @@ -49,6 +51,8 @@ package FLTK.Widgets.Valuators.Value_Outputs is + -- Text Settings -- + function Get_Text_Color (This : in Value_Output) return Color; @@ -76,6 +80,8 @@ package FLTK.Widgets.Valuators.Value_Outputs is + -- Drawing, Events -- + procedure Draw (This : in out Value_Output); diff --git a/spec/fltk-widgets-valuators.ads b/spec/fltk-widgets-valuators.ads index 1e60f4b..e8180d6 100644 --- a/spec/fltk-widgets-valuators.ads +++ b/spec/fltk-widgets-valuators.ads @@ -38,6 +38,8 @@ package FLTK.Widgets.Valuators is + -- Formatting -- + -- You may override this to change the formatting of the Valuator function Format (This : in Valuator) @@ -46,6 +48,8 @@ package FLTK.Widgets.Valuators is + -- Calculation -- + function Clamp (This : in Valuator; Input : in Long_Float) @@ -65,6 +69,8 @@ package FLTK.Widgets.Valuators is + -- Settings, Value -- + function Get_Minimum (This : in Valuator) return Long_Float; @@ -121,6 +127,8 @@ package FLTK.Widgets.Valuators is + -- Drawing -- + procedure Value_Damage (This : in out Valuator); diff --git a/spec/fltk-widgets.ads b/spec/fltk-widgets.ads index 07f9b2e..67c1625 100644 --- a/spec/fltk-widgets.ads +++ b/spec/fltk-widgets.ads @@ -30,14 +30,6 @@ package FLTK.Widgets is type Widget_Callback is access procedure (Item : in out Widget'Class); - type Callback_Flag is private; - function "+" (Left, Right : in Callback_Flag) return Callback_Flag; - Call_Never : constant Callback_Flag; - When_Changed : constant Callback_Flag; - When_Interact : constant Callback_Flag; - When_Release : constant Callback_Flag; - When_Enter_Key : constant Callback_Flag; - @@ -59,6 +51,8 @@ package FLTK.Widgets is + -- Activity -- + procedure Activate (This : in out Widget); @@ -74,28 +68,53 @@ package FLTK.Widgets is return Boolean; procedure Set_Active + (This : in out Widget); + + procedure Set_Active (This : in out Widget; To : in Boolean); + procedure Clear_Active + (This : in out Widget); + + -- Changed and Output -- + function Has_Changed (This : in Widget) return Boolean; procedure Set_Changed + (This : in out Widget); + + procedure Set_Changed (This : in out Widget; To : in Boolean); + procedure Clear_Changed + (This : in out Widget); + function Is_Output_Only (This : in Widget) return Boolean; procedure Set_Output_Only + (This : in out Widget); + + procedure Set_Output_Only (This : in out Widget; To : in Boolean); + procedure Clear_Output_Only + (This : in out Widget); + + + + + -- Visibility -- + function Is_Visible (This : in Widget) return Boolean; @@ -105,20 +124,40 @@ package FLTK.Widgets is return Boolean; procedure Set_Visible + (This : in out Widget); + + procedure Set_Visible (This : in out Widget; To : in Boolean); + procedure Clear_Visible + (This : in out Widget); + + procedure Show + (This : in out Widget); + + procedure Hide + (This : in out Widget); + + + -- Focus -- function Has_Visible_Focus (This : in Widget) return Boolean; procedure Set_Visible_Focus + (This : in out Widget); + + procedure Set_Visible_Focus (This : in out Widget; To : in Boolean); + procedure Clear_Visible_Focus + (This : in out Widget); + function Take_Focus (This : in out Widget) return Boolean; @@ -130,6 +169,8 @@ package FLTK.Widgets is + -- Colors -- + function Get_Background_Color (This : in Widget) return Color; @@ -146,8 +187,14 @@ package FLTK.Widgets is (This : in out Widget; To : in Color); + procedure Set_Colors + (This : in out Widget; + Back, Sel : in Color); + + + -- Relatives -- function Parent (This : in Widget) @@ -172,13 +219,15 @@ package FLTK.Widgets is return access FLTK.Widgets.Groups.Windows.Window'Class; function Top_Window_Offset - (This : in Widget; - Offset_X, Offset_Y : out Integer) + (This : in Widget; + Offset_X, Offset_Y : out Integer) return access FLTK.Widgets.Groups.Windows.Window'Class; + -- Alignment, Box, Tooltip -- + function Get_Alignment (This : in Widget) return Alignment; @@ -206,6 +255,8 @@ package FLTK.Widgets is + -- Labels -- + function Get_Label (This : in Widget) return String; @@ -214,6 +265,11 @@ package FLTK.Widgets is (This : in out Widget; Text : in String); + procedure Set_Label + (This : in out Widget; + Kind : in Label_Kind; + Text : in String); + function Get_Label_Color (This : in Widget) return Color; @@ -253,6 +309,8 @@ package FLTK.Widgets is + -- Callbacks -- + function Get_Callback (This : in Widget) return Widget_Callback; @@ -264,6 +322,13 @@ package FLTK.Widgets is procedure Do_Callback (This : in out Widget); + procedure Do_Callback + (This : in Widget; + Using : in out Widget); + + procedure Default_Callback + (This : in out Widget'Class); + function Get_When (This : in Widget) return Callback_Flag; @@ -275,6 +340,8 @@ package FLTK.Widgets is + -- Dimensions -- + function Get_X (This : in Widget) return Integer; @@ -295,6 +362,10 @@ package FLTK.Widgets is (This : in out Widget; W, H : in Integer); + procedure Resize + (This : in out Widget; + X, Y, W, H : in Integer); + procedure Reposition (This : in out Widget; X, Y : in Integer); @@ -302,6 +373,8 @@ package FLTK.Widgets is + -- Images -- + function Get_Image (This : in Widget) return access FLTK.Images.Image'Class; @@ -321,26 +394,68 @@ package FLTK.Widgets is + -- Damage, Drawing, Events -- + function Is_Damaged (This : in Widget) return Boolean; - procedure Set_Damaged + function Get_Damage + (This : in Widget) + return Damage_Mask; + + procedure Set_Damage (This : in out Widget; - To : in Boolean); + Mask : in Damage_Mask); - procedure Set_Damaged + procedure Set_Damage (This : in out Widget; - To : in Boolean; + Mask : in Damage_Mask; X, Y, W, H : in Integer); + procedure Clear_Damage + (This : in out Widget; + Mask : in Damage_Mask := Damage_None); + procedure Draw (This : in out Widget); procedure Draw_Label - (This : in Widget; - X, Y, W, H : in Integer; - Align : in Alignment); + (This : in out Widget); + + procedure Draw_Label + (This : in out Widget; + X, Y, W, H : in Integer); + + procedure Draw_Label + (This : in out Widget; + X, Y, W, H : in Integer; + Align : in Alignment); + + procedure Draw_Backdrop + (This : in out Widget); + + procedure Draw_Box + (This : in out Widget); + + procedure Draw_Box + (This : in out Widget; + Kind : in Box_Kind; + Hue : in Color); + + procedure Draw_Box + (This : in out Widget; + Kind : in Box_Kind; + X, Y, W, H : in Integer; + Hue : in Color); + + procedure Draw_Focus + (This : in out Widget); + + procedure Draw_Focus + (This : in out Widget; + Kind : in Box_Kind; + X, Y, W, H : in Integer); procedure Redraw (This : in out Widget); @@ -354,6 +469,16 @@ package FLTK.Widgets is return Event_Outcome; + + + -- Miscellaneous -- + + -- Only relevant to MacOS + function Uses_Accents_Menu + (This : in Widget) + return Boolean; + + private @@ -391,15 +516,6 @@ private (This : in out Widget); - type Callback_Flag is new Interfaces.C.unsigned; - - Call_Never : constant Callback_Flag := 0; - When_Changed : constant Callback_Flag := 1; - When_Interact : constant Callback_Flag := 2; - When_Release : constant Callback_Flag := 4; - When_Enter_Key : constant Callback_Flag := 8; - - -- the user data portion should always be a reference back to the Ada binding procedure Callback_Hook (W, U : in Storage.Integer_Address); @@ -457,16 +573,24 @@ private pragma Inline (Is_Active); pragma Inline (Is_Tree_Active); pragma Inline (Set_Active); + pragma Inline (Clear_Active); pragma Inline (Has_Changed); pragma Inline (Set_Changed); + pragma Inline (Clear_Changed); pragma Inline (Is_Output_Only); pragma Inline (Set_Output_Only); + pragma Inline (Clear_Output_Only); + pragma Inline (Is_Visible); pragma Inline (Set_Visible); + pragma Inline (Clear_Visible); + pragma Inline (Show); + pragma Inline (Hide); pragma Inline (Has_Visible_Focus); pragma Inline (Set_Visible_Focus); + pragma Inline (Clear_Visible_Focus); pragma Inline (Take_Focus); pragma Inline (Takes_Events); @@ -474,6 +598,7 @@ private pragma Inline (Set_Background_Color); pragma Inline (Get_Selection_Color); pragma Inline (Set_Selection_Color); + pragma Inline (Set_Colors); pragma Inline (Parent); pragma Inline (Contains); @@ -504,6 +629,7 @@ private pragma Inline (Get_Callback); pragma Inline (Set_Callback); pragma Inline (Do_Callback); + pragma Inline (Default_Callback); pragma Inline (Get_When); pragma Inline (Set_When); @@ -520,13 +646,20 @@ private pragma Inline (Set_Inactive_Image); pragma Inline (Is_Damaged); - pragma Inline (Set_Damaged); + pragma Inline (Get_Damage); + pragma Inline (Set_Damage); pragma Inline (Draw); pragma Inline (Draw_Label); + pragma Inline (Draw_Backdrop); + pragma Inline (Draw_Box); + pragma Inline (Draw_Focus); pragma Inline (Redraw); pragma Inline (Redraw_Label); pragma Inline (Handle); + pragma Inline (Uses_Accents_Menu); + end FLTK.Widgets; + diff --git a/spec/fltk.ads b/spec/fltk.ads index 6e5ef0f..964af79 100644 --- a/spec/fltk.ads +++ b/spec/fltk.ads @@ -6,11 +6,13 @@ with - Ada.Finalization; + Ada.Finalization, + System; private with - Interfaces.C, + Ada.Unchecked_Conversion, + Interfaces.C.Strings, System.Storage_Elements; @@ -33,21 +35,70 @@ package FLTK is -- Text buffers for marshalling purposes will be this size. Buffer_Size : constant Natural := 1024; + -- For image data arrays. + type Size_Type is mod 2 ** System.Word_Size; + subtype Positive_Size is Size_Type range 1 .. Size_Type'Last; - -- Values scale from A/Black to X/White + + -- Color -- + + -- Values scale from A/Black to X/White. type Greyscale is new Character range 'A' .. 'X'; type Color is mod 2**32; type Color_Component is mod 256; - type Color_Component_Array is array (Positive range <>) of aliased Color_Component; + type Color_Component_Array is array (Positive_Size range <>) of aliased Color_Component; + + subtype Blend is Float range 0.0 .. 1.0; + + function RGB_Color + (Light : in Greyscale) + return Color; + + function RGB_Color + (Light : in Color_Component) + return Color; function RGB_Color (R, G, B : in Color_Component) return Color; + function Color_Cube + (R, G, B : in Color_Component) + return Color; + + function Grey_Ramp + (Light : in Greyscale) + return Color; + + function Grey_Ramp + (Light : in Color_Component) + return Color; + + function Darker + (Tone : in Color) + return Color; + + function Lighter + (Tone : in Color) + return Color; + + function Contrast + (Fore, Back : in Color) + return Color; + + function Inactive + (Tone : in Color) + return Color; + + function Color_Average + (Tone1, Tone2 : in Color; + Weight : in Blend := 0.5) + return Color; + -- Examples of RGB colors without the above function -- The lowest byte has to be 00 for the color to be RGB RGB_Red_Color : constant Color := 16#ff000000#; @@ -61,6 +112,9 @@ package FLTK is Inactive_Color : constant Color := 8; Selection_Color : constant Color := 15; + -- X allocation area + Free_Color : constant Color := 16; + -- Standard boxtype colors Grey0_Color : constant Color := 32; Dark3_Color : constant Color := 39; @@ -90,6 +144,8 @@ package FLTK is + -- Alignment -- + -- This should be a bitmask, except there are magic values... type Alignment is private; @@ -124,6 +180,8 @@ package FLTK is + -- Mouse Cursors -- + type Mouse_Cursor_Kind is (Default_Mouse, Arrow_Mouse, @@ -145,14 +203,19 @@ package FLTK is SW_Mouse, W_Mouse, NW_Mouse, - None_Mouse); + None_Mouse) + with Default_Value => Default_Mouse; + -- Keyboard and Mouse Input -- + type Keypress is private; subtype Pressable_Key is Character range Character'Val (32) .. Character'Val (126); + function Press (Key : in Pressable_Key) return Keypress; + Enter_Key : constant Keypress; Keypad_Enter_Key : constant Keypress; Backspace_Key : constant Keypress; @@ -169,20 +232,34 @@ package FLTK is Escape_Key : constant Keypress; Tab_Key : constant Keypress; - type Mouse_Button is (No_Button, Left_Button, Middle_Button, Right_Button); + + type Mouse_Button is + (No_Button, + Left_Button, + Middle_Button, + Right_Button, + Back_Button, + Forward_Button, + Any_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; function "+" (Left : in Modifier; Right : in Keypress) return Key_Combo; function "+" (Left : in Modifier; Right : in Mouse_Button) return Key_Combo; function "+" (Left : in Modifier; Right : in Key_Combo) return Key_Combo; + Mod_None : constant Modifier; Mod_Shift : constant Modifier; Mod_Caps_Lock : constant Modifier; @@ -196,86 +273,102 @@ package FLTK is - type Box_Kind is - (No_Box, - Flat_Box, - Up_Box, - Down_Box, - Up_Frame, - Down_Frame, - Thin_Up_Box, - Thin_Down_Box, - Thin_Up_Frame, - Thin_Down_Frame, - Engraved_Box, - Embossed_Box, - Engraved_Frame, - Embossed_Frame, - Border_Box, - Shadow_Box, - Border_Frame, - Shadow_Frame, - Rounded_Box, - RShadow_Box, - Rounded_Frame, - RFlat_Box, - Round_Up_Box, - Round_Down_Box, - Diamond_Up_Box, - Diamond_Down_Box, - Oval_Box, - OShadow_Box, - Oval_Frame, - OFlat_Box, - Plastic_Up_Box, - Plastic_Down_Box, - Plastic_Up_Frame, - Plastic_Down_Frame, - Plastic_Thin_Up_Box, - Plastic_Thin_Down_Box, - Plastic_Round_Up_Box, - Plastic_Round_Down_Box, - Gtk_Up_Box, - Gtk_Down_Box, - Gtk_Up_Frame, - Gtk_Down_Frame, - Gtk_Thin_Up_Box, - Gtk_Thin_Down_Box, - Gtk_Thin_Up_Frame, - Gtk_Thin_Down_Frame, - Gtk_Round_Up_Box, - Gtk_Round_Down_Box, - Gleam_Up_Box, - Gleam_Down_Box, - Gleam_Up_Frame, - Gleam_Down_Frame, - Gleam_Thin_Up_Box, - Gleam_Thin_Down_Box, - Gleam_Round_Up_Box, - Gleam_Round_Down_Box, - Free_Box); - - + -- Box Types -- + type Box_Kind is + (No_Box, + Flat_Box, + Up_Box, + Down_Box, + Up_Frame, + Down_Frame, + Thin_Up_Box, + Thin_Down_Box, + Thin_Up_Frame, + Thin_Down_Frame, + Engraved_Box, + Embossed_Box, + Engraved_Frame, + Embossed_Frame, + Border_Box, + Shadow_Box, + Border_Frame, + Shadow_Frame, + Rounded_Box, + RShadow_Box, + Rounded_Frame, + RFlat_Box, + Round_Up_Box, + Round_Down_Box, + Diamond_Up_Box, + Diamond_Down_Box, + Oval_Box, + OShadow_Box, + Oval_Frame, + OFlat_Box, + Plastic_Up_Box, + Plastic_Down_Box, + Plastic_Up_Frame, + Plastic_Down_Frame, + Plastic_Thin_Up_Box, + Plastic_Thin_Down_Box, + Plastic_Round_Up_Box, + Plastic_Round_Down_Box, + Gtk_Up_Box, + Gtk_Down_Box, + Gtk_Up_Frame, + Gtk_Down_Frame, + Gtk_Thin_Up_Box, + Gtk_Thin_Down_Box, + Gtk_Thin_Up_Frame, + Gtk_Thin_Down_Frame, + Gtk_Round_Up_Box, + Gtk_Round_Down_Box, + Gleam_Up_Box, + Gleam_Down_Box, + Gleam_Up_Frame, + Gleam_Down_Frame, + Gleam_Thin_Up_Box, + Gleam_Thin_Down_Box, + Gleam_Round_Up_Box, + Gleam_Round_Down_Box, + Free_Box); + + function Filled + (Box : in Box_Kind) + return Box_Kind; + + function Frame + (Box : in Box_Kind) + return Box_Kind; + + function Down + (Box : in Box_Kind) + return Box_Kind; + + + + + -- Fonts -- type Font_Kind is - (Helvetica, - Helvetica_Bold, - Helvetica_Italic, - Helvetica_Bold_Italic, - Courier, - Courier_Bold, - Courier_Italic, - Courier_Bold_Italic, - Times, - Times_Bold, - Times_Italic, - Times_Bold_Italic, - Symbol, - Monospace, - Monospace_Bold, - Zapf_Dingbats, - Free_Font); + (Helvetica, + Helvetica_Bold, + Helvetica_Italic, + Helvetica_Bold_Italic, + Courier, + Courier_Bold, + Courier_Italic, + Courier_Bold_Italic, + Times, + Times_Bold, + Times_Italic, + Times_Bold_Italic, + Symbol, + Monospace, + Monospace_Bold, + Zapf_Dingbats, + Free_Font); type Font_Size is new Natural; Normal_Size : constant Font_Size := 14; @@ -285,55 +378,97 @@ package FLTK is + -- Label Types -- + type Label_Kind is - (Normal_Label, - No_Label, - Shadow_Label, - Engraved_Label, - Embossed_Label, - Multi_Label, - Icon_Label, - Image_Label, - Free_Label); + (Normal_Label, + No_Label, + Shadow_Label, + Engraved_Label, + Embossed_Label, + Multi_Label, + Icon_Label, + Image_Label, + Free_Label); + + -- Events -- type Event_Kind is - (No_Event, - Push, - Release, - Enter, - Leave, - Drag, - Focus, - Unfocus, - Keydown, - Keyup, - Close, - Move, - Shortcut, - Deactivate, - Activate, - Hide, - Show, - Paste, - Selection_Clear, - Mouse_Wheel, - DnD_Enter, - DnD_Drag, - DnD_Leave, - DnD_Release, - Screen_Config_Changed, - Fullscreen); + (No_Event, + Push, + Release, + Enter, + Leave, + Drag, + Focus, + Unfocus, + Keydown, + Keyup, + Close, + Move, + Shortcut, + Deactivate, + Activate, + Hide, + Show, + Paste, + Selection_Clear, + Mouse_Wheel, + DnD_Enter, + DnD_Drag, + DnD_Leave, + DnD_Release, + Screen_Config_Changed, + Fullscreen); type Event_Outcome is (Not_Handled, Handled); - type Menu_Flag is private; + -- Callback Flags -- + + type Callback_Flag is record + Changed : Boolean := False; + Interact : Boolean := False; + Release : Boolean := False; + Enter_Key : Boolean := False; + end record; + + function "+" (Left, Right : in Callback_Flag) return Callback_Flag; + function "-" (Left, Right : in Callback_Flag) return Callback_Flag; + + Call_Never : constant Callback_Flag; + When_Changed : constant Callback_Flag; + When_Interact : constant Callback_Flag; + When_Release : constant Callback_Flag; + When_Release_Always : constant Callback_Flag; + When_Enter_Key : constant Callback_Flag; + When_Enter_Key_Always : constant Callback_Flag; + + + + + -- Menu Flags -- + + -- It's easier to have this here rather than in Menu_Items for visibility reasons. + + type Menu_Flag is record + Inactive : Boolean := False; + Toggle : Boolean := False; + Value : Boolean := False; + Radio : Boolean := False; + Invisible : Boolean := False; + Submenu : Boolean := False; + Divider : Boolean := False; + end record; + function "+" (Left, Right : in Menu_Flag) return Menu_Flag; + function "-" (Left, Right : in Menu_Flag) return Menu_Flag; + Flag_Normal : constant Menu_Flag; Flag_Inactive : constant Menu_Flag; Flag_Toggle : constant Menu_Flag; @@ -346,48 +481,64 @@ package FLTK is - type Version_Number is new Natural; - + -- Damage Bits -- + type Damage_Mask is record + Child : Boolean := False; + Expose : Boolean := False; + Scroll : Boolean := False; + Overlay : Boolean := False; + User_1 : Boolean := False; + User_2 : Boolean := False; + Full : Boolean := False; + end record; + function "+" (Left, Right : in Damage_Mask) return Damage_Mask; + function "-" (Left, Right : in Damage_Mask) return Damage_Mask; - function ABI_Check - (ABI_Ver : in Version_Number) - return Boolean; + Damage_None : constant Damage_Mask; + Damage_Child : constant Damage_Mask; + Damage_Expose : constant Damage_Mask; + Damage_Scroll : constant Damage_Mask; + Damage_Overlay : constant Damage_Mask; + Damage_User_1 : constant Damage_Mask; + Damage_User_2 : constant Damage_Mask; + Damage_Full : constant Damage_Mask; - function ABI_Version - return Version_Number; - function API_Version - return Version_Number; - function Version - return Version_Number; + -- Clipboard Attributes -- + Clipboard_Image : constant String; + Clipboard_Plain_Text : constant String; - procedure Awake; - procedure Lock; - procedure Unlock; + -- Versioning -- + type Version_Number is new Natural; + function ABI_Check + (ABI_Ver : in Version_Number) + return Boolean; + function ABI_Version + return Version_Number; - function Is_Damaged - return Boolean; + function API_Version + return Version_Number; - procedure Set_Damaged - (To : in Boolean); + function Version + return Version_Number; - procedure Flush; - procedure Redraw; + -- Event Loop -- + procedure Check; function Check return Boolean; @@ -400,7 +551,7 @@ package FLTK is function Wait (Seconds : in Long_Float) - return Integer; + return Long_Float; function Run return Integer; @@ -437,21 +588,16 @@ private -- Note: This has to be Limited because otherwise the various init subprograms -- wouldn't work, the widget callbacks wouldn't work, deallocation would be -- a mess, really just all sorts of problems. - type Wrapper is new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : Storage.Integer_Address := Null_Pointer; - Needs_Dealloc : Boolean := True; - end record; - - overriding procedure Initialize - (This : in out Wrapper); + type Wrapper is new Ada.Finalization.Limited_Controlled with record + Void_Ptr : Storage.Integer_Address := Null_Pointer; + Needs_Dealloc : Boolean := True; + end record; for Color_Component_Array'Component_Size use Interfaces.C.CHAR_BIT; pragma Convention (C, Color_Component_Array); - pragma Pack (Color_Component_Array); @@ -493,70 +639,70 @@ private -- What delightful magic numbers FLTK cursors are! -- (These correspond to the enum found in Enumerations.H) Cursor_Values : array (Mouse_Cursor_Kind) of Interfaces.C.int := - (Default_Mouse => 0, - Arrow_Mouse => 35, - Crosshair_Mouse => 66, - Wait_Mouse => 76, - Insert_Mouse => 77, - Hand_Mouse => 31, - Help_Mouse => 47, - Move_Mouse => 27, - NS_Mouse => 78, - WE_Mouse => 79, - NWSE_Mouse => 80, - NESW_Mouse => 81, - N_Mouse => 70, - NE_Mouse => 69, - E_Mouse => 49, - SE_Mouse => 8, - S_Mouse => 9, - SW_Mouse => 7, - W_Mouse => 36, - NW_Mouse => 68, - None_Mouse => 255); + (Default_Mouse => 0, + Arrow_Mouse => 35, + Crosshair_Mouse => 66, + Wait_Mouse => 76, + Insert_Mouse => 77, + Hand_Mouse => 31, + Help_Mouse => 47, + Move_Mouse => 27, + NS_Mouse => 78, + WE_Mouse => 79, + NWSE_Mouse => 80, + NESW_Mouse => 81, + N_Mouse => 70, + NE_Mouse => 69, + E_Mouse => 49, + SE_Mouse => 8, + S_Mouse => 9, + SW_Mouse => 7, + W_Mouse => 36, + NW_Mouse => 68, + None_Mouse => 255); type Keypress is new Interfaces.Unsigned_16; type Modifier is new Interfaces.Unsigned_16; - type Key_Combo is - record - Modcode : Modifier; - Keycode : Keypress; - Mousecode : Mouse_Button; - end record; + + type Key_Combo is record + Modcode : Modifier; + Keycode : Keypress; + Mousecode : Mouse_Button; + end record; function To_C (Key : in Key_Combo) - return Interfaces.C.int; + return Interfaces.C.unsigned; function To_Ada - (Key : in Interfaces.C.int) + (Key : in Interfaces.C.unsigned) return Key_Combo; function To_C (Key : in Keypress) - return Interfaces.C.int; + return Interfaces.C.unsigned; function To_Ada - (Key : in Interfaces.C.int) + (Key : in Interfaces.C.unsigned) return Keypress; function To_C (Modi : in Modifier) - return Interfaces.C.int; + return Interfaces.C.unsigned; function To_Ada - (Modi : in Interfaces.C.int) + (Modi : in Interfaces.C.unsigned) return Modifier; function To_C (Button : in Mouse_Button) - return Interfaces.C.int; + return Interfaces.C.unsigned; function To_Ada - (Button : in Interfaces.C.int) + (Button : in Interfaces.C.unsigned) return Mouse_Button; -- these values designed to align with FLTK enumeration types @@ -595,47 +741,127 @@ private - type Menu_Flag is new Interfaces.Unsigned_8; - Flag_Normal : constant Menu_Flag := 2#00000000#; - Flag_Inactive : constant Menu_Flag := 2#00000001#; - Flag_Toggle : constant Menu_Flag := 2#00000010#; - Flag_Value : constant Menu_Flag := 2#00000100#; - Flag_Radio : constant Menu_Flag := 2#00001000#; - Flag_Invisible : constant Menu_Flag := 2#00010000#; - -- Flag_Submenu_Pointer unlikely to be used - Flag_Submenu : constant Menu_Flag := 2#01000000#; - Flag_Divider : constant Menu_Flag := 2#10000000#; + for Callback_Flag use record + Changed at 0 range 0 .. 0; + Interact at 0 range 1 .. 1; + Release at 0 range 2 .. 2; + Enter_Key at 0 range 3 .. 3; + end record; + for Callback_Flag'Size use Interfaces.C.unsigned_char'Size; + Call_Never : constant Callback_Flag := (others => False); + When_Changed : constant Callback_Flag := (Changed => True, others => False); + When_Interact : constant Callback_Flag := (Interact => True, others => False); + When_Release : constant Callback_Flag := (Release => True, others => False); + When_Enter_Key : constant Callback_Flag := (Enter_Key => True, others => False); + When_Release_Always : constant Callback_Flag := + (Release => True, Interact => True, others => False); + When_Enter_Key_Always : constant Callback_Flag := + (Enter_Key => True, Interact => True, others => False); - pragma Import (C, Awake, "fl_awake"); - pragma Import (C, Lock, "fl_lock"); - pragma Import (C, Unlock, "fl_unlock"); + function Flag_To_UChar is new + Ada.Unchecked_Conversion (Callback_Flag, Interfaces.C.unsigned_char); + function UChar_To_Flag is new + Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Callback_Flag); - pragma Import (C, Flush, "fl_flush"); - pragma Import (C, Redraw, "fl_redraw"); + for Menu_Flag use record + Inactive at 0 range 0 .. 0; + Toggle at 0 range 1 .. 1; + Value at 0 range 2 .. 2; + Radio at 0 range 3 .. 3; + Invisible at 0 range 4 .. 4; + -- Submenu_Pointer unused + Submenu at 0 range 6 .. 6; + Divider at 0 range 7 .. 7; + end record; - pragma Inline (ABI_Check); - pragma Inline (ABI_Version); - pragma Inline (API_Version); - pragma Inline (Version); + for Menu_Flag'Size use Interfaces.C.int'Size; + + Flag_Normal : constant Menu_Flag := (others => False); + Flag_Inactive : constant Menu_Flag := (Inactive => True, others => False); + Flag_Toggle : constant Menu_Flag := (Toggle => True, others => False); + Flag_Value : constant Menu_Flag := (Value => True, others => False); + Flag_Radio : constant Menu_Flag := (Radio => True, others => False); + Flag_Invisible : constant Menu_Flag := (Invisible => True, others => False); + -- Flag_Submenu_Pointer unused + Flag_Submenu : constant Menu_Flag := (Submenu => True, others => False); + Flag_Divider : constant Menu_Flag := (Divider => True, others => False); + + function MFlag_To_Cint is new + Ada.Unchecked_Conversion (Menu_Flag, Interfaces.C.int); + + function Cint_To_MFlag is new + Ada.Unchecked_Conversion (Interfaces.C.int, Menu_Flag); + + + + + for Damage_Mask use record + Child at 0 range 0 .. 0; + Expose at 0 range 1 .. 1; + Scroll at 0 range 2 .. 2; + Overlay at 0 range 3 .. 3; + User_1 at 0 range 4 .. 4; + User_2 at 0 range 5 .. 5; + -- bit 6 missing + Full at 0 range 7 .. 7; + end record; + + for Damage_Mask'Size use Interfaces.C.unsigned_char'Size; + + Damage_None : constant Damage_Mask := (others => False); + Damage_Child : constant Damage_Mask := (Child => True, others => False); + Damage_Expose : constant Damage_Mask := (Expose => True, others => False); + Damage_Scroll : constant Damage_Mask := (Scroll => True, others => False); + Damage_Overlay : constant Damage_Mask := (Overlay => True, others => False); + Damage_User_1 : constant Damage_Mask := (User_1 => True, others => False); + Damage_User_2 : constant Damage_Mask := (User_2 => True, others => False); + Damage_Full : constant Damage_Mask := (Full => True, others => False); + + function Mask_To_UChar is new + Ada.Unchecked_Conversion (Damage_Mask, Interfaces.C.unsigned_char); + function UChar_To_Mask is new + Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Damage_Mask); - pragma Inline (Awake); - pragma Inline (Lock); - pragma Inline (Unlock); - pragma Inline (Is_Damaged); - pragma Inline (Set_Damaged); - pragma Inline (Flush); - pragma Inline (Redraw); + clip_image_char_ptr : Interfaces.C.Strings.chars_ptr; + pragma Import (C, clip_image_char_ptr, "fl_clip_image_char_ptr"); + + clip_plain_text_char_ptr : Interfaces.C.Strings.chars_ptr; + pragma Import (C, clip_plain_text_char_ptr, "fl_clip_plain_text_char_ptr"); + + Clipboard_Image : constant String := Interfaces.C.Strings.Value (clip_image_char_ptr); + Clipboard_Plain_Text : constant String := Interfaces.C.Strings.Value (clip_plain_text_char_ptr); + + + + + pragma Inline (RGB_Color); + pragma Inline (Color_Cube); + pragma Inline (Grey_Ramp); + pragma Inline (Darker); + pragma Inline (Lighter); + pragma Inline (Contrast); + pragma Inline (Inactive); + pragma Inline (Color_Average); + + pragma Inline (Filled); + pragma Inline (Frame); + pragma Inline (Down); + + pragma Inline (ABI_Check); + pragma Inline (ABI_Version); + pragma Inline (API_Version); + pragma Inline (Version); pragma Inline (Check); pragma Inline (Ready); @@ -645,3 +871,4 @@ private end FLTK; + |