From b4438b2fbe895694be98e6e8426103deefc51448 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 21 Jan 2025 21:04:54 +1300 Subject: Split public API and private implementation files into different directories --- spec/fltk-widgets.ads | 532 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 532 insertions(+) create mode 100644 spec/fltk-widgets.ads (limited to 'spec/fltk-widgets.ads') diff --git a/spec/fltk-widgets.ads b/spec/fltk-widgets.ads new file mode 100644 index 0000000..07f9b2e --- /dev/null +++ b/spec/fltk-widgets.ads @@ -0,0 +1,532 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Images; + +limited with + + FLTK.Widgets.Groups.Windows; + +private with + + System.Address_To_Access_Conversions, + Interfaces.C, + FLTK.Widget_Callback_Conversions; + + +package FLTK.Widgets is + + + type Widget is new Wrapper with private; + + type Widget_Reference (Data : not null access Widget'Class) is limited null record + with Implicit_Dereference => Data; + + 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; + + + + + package Forge is + + function Create + (X, Y, W, H : in Integer; + Text : in String := "") + return Widget; + + function Create + (Parent : in out FLTK.Widgets.Groups.Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Widget; + + end Forge; + + + + + procedure Activate + (This : in out Widget); + + procedure Deactivate + (This : in out Widget); + + function Is_Active + (This : in Widget) + return Boolean; + + function Is_Tree_Active + (This : in Widget) + return Boolean; + + procedure Set_Active + (This : in out Widget; + To : in Boolean); + + + + + function Has_Changed + (This : in Widget) + return Boolean; + + procedure Set_Changed + (This : in out Widget; + To : in Boolean); + + function Is_Output_Only + (This : in Widget) + return Boolean; + + procedure Set_Output_Only + (This : in out Widget; + To : in Boolean); + + function Is_Visible + (This : in Widget) + return Boolean; + + function Is_Tree_Visible + (This : in Widget) + return Boolean; + + procedure Set_Visible + (This : in out Widget; + To : in Boolean); + + + + + function Has_Visible_Focus + (This : in Widget) + return Boolean; + + procedure Set_Visible_Focus + (This : in out Widget; + To : in Boolean); + + function Take_Focus + (This : in out Widget) + return Boolean; + + function Takes_Events + (This : in Widget) + return Boolean; + + + + + function Get_Background_Color + (This : in Widget) + return Color; + + procedure Set_Background_Color + (This : in out Widget; + To : in Color); + + function Get_Selection_Color + (This : in Widget) + return Color; + + procedure Set_Selection_Color + (This : in out Widget; + To : in Color); + + + + + function Parent + (This : in Widget) + return access FLTK.Widgets.Groups.Group'Class; + + function Contains + (This : in Widget; + Item : in Widget'Class) + return Boolean; + + function Inside + (This : in Widget; + Parent : in Widget'Class) + return Boolean; + + function Nearest_Window + (This : in Widget) + return access FLTK.Widgets.Groups.Windows.Window'Class; + + function Top_Window + (This : in Widget) + return access FLTK.Widgets.Groups.Windows.Window'Class; + + function Top_Window_Offset + (This : in Widget; + Offset_X, Offset_Y : out Integer) + return access FLTK.Widgets.Groups.Windows.Window'Class; + + + + + function Get_Alignment + (This : in Widget) + return Alignment; + + procedure Set_Alignment + (This : in out Widget; + New_Align : in Alignment); + + function Get_Box + (This : in Widget) + return Box_Kind; + + procedure Set_Box + (This : in out Widget; + Box : in Box_Kind); + + function Get_Tooltip + (This : in Widget) + return String; + + procedure Set_Tooltip + (This : in out Widget; + Text : in String); + + + + + function Get_Label + (This : in Widget) + return String; + + procedure Set_Label + (This : in out Widget; + Text : in String); + + function Get_Label_Color + (This : in Widget) + return Color; + + procedure Set_Label_Color + (This : in out Widget; + Value : in Color); + + function Get_Label_Font + (This : in Widget) + return Font_Kind; + + procedure Set_Label_Font + (This : in out Widget; + Font : in Font_Kind); + + function Get_Label_Size + (This : in Widget) + return Font_Size; + + procedure Set_Label_Size + (This : in out Widget; + Size : in Font_Size); + + function Get_Label_Kind + (This : in Widget) + return Label_Kind; + + procedure Set_Label_Kind + (This : in out Widget; + Label : in Label_Kind); + + procedure Measure_Label + (This : in Widget; + W, H : out Integer); + + + + + function Get_Callback + (This : in Widget) + return Widget_Callback; + + procedure Set_Callback + (This : in out Widget; + Func : in Widget_Callback); + + procedure Do_Callback + (This : in out Widget); + + function Get_When + (This : in Widget) + return Callback_Flag; + + procedure Set_When + (This : in out Widget; + To : in Callback_Flag); + + + + + function Get_X + (This : in Widget) + return Integer; + + function Get_Y + (This : in Widget) + return Integer; + + function Get_W + (This : in Widget) + return Integer; + + function Get_H + (This : in Widget) + return Integer; + + procedure Resize + (This : in out Widget; + W, H : in Integer); + + procedure Reposition + (This : in out Widget; + X, Y : in Integer); + + + + + function Get_Image + (This : in Widget) + return access FLTK.Images.Image'Class; + + procedure Set_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class); + + function Get_Inactive_Image + (This : in Widget) + return access FLTK.Images.Image'Class; + + procedure Set_Inactive_Image + (This : in out Widget; + Pic : in out FLTK.Images.Image'Class); + + + + + function Is_Damaged + (This : in Widget) + return Boolean; + + procedure Set_Damaged + (This : in out Widget; + To : in Boolean); + + procedure Set_Damaged + (This : in out Widget; + To : in Boolean; + X, Y, W, H : in Integer); + + procedure Draw + (This : in out Widget); + + procedure Draw_Label + (This : in Widget; + X, Y, W, H : in Integer; + Align : in Alignment); + + procedure Redraw + (This : in out Widget); + + procedure Redraw_Label + (This : in out Widget); + + function Handle + (This : in out Widget; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Widget is new Wrapper with + record + Callback : Widget_Callback; + Current_Image : access FLTK.Images.Image'Class; + Inactive_Image : access FLTK.Images.Image'Class; + Draw_Ptr : System.Address; + Handle_Ptr : System.Address; + end record; + + overriding procedure Initialize + (This : in out Widget); + + overriding procedure Finalize + (This : in out Widget); + + -- Widgets that might cause problems for this setup in the future: + -- Menus (gets various Menu_Items added to it) + -- Groups.Text_Displays (gets a Text_Buffer attached) + -- Groups.Text_Displays.Text_Editors (also gets a Text_Buffer attached) + -- If weird Init/Final errors start mysteriously occuring then check there first. + + -- Extra_Init functionality is also duplicated in FLTK.File_Choosers + -- for reasons of hierarchy visibility. Really, the File_Chooser should be in + -- the Widget hierarchy like Color_Chooser but for some reason it isn't. + + procedure Extra_Init + (This : in out Widget; + X, Y, W, H : in Integer; + Text : in String); + + procedure Extra_Final + (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); + pragma Export (C, Callback_Hook, "widget_callback_hook"); + + procedure Draw_Hook + (U : in Storage.Integer_Address); + pragma Export (C, Draw_Hook, "widget_draw_hook"); + + function Handle_Hook + (U : in Storage.Integer_Address; + E : in Interfaces.C.int) + return Interfaces.C.int; + pragma Export (C, Handle_Hook, "widget_handle_hook"); + + + package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); + package Callback_Convert renames FLTK.Widget_Callback_Conversions; + + + function fl_widget_get_user_data + (W : in Storage.Integer_Address) + return Storage.Integer_Address; + pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); + pragma Inline (fl_widget_get_user_data); + + procedure fl_widget_set_user_data + (W, D : in Storage.Integer_Address); + pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); + pragma Inline (fl_widget_set_user_data); + + + procedure fl_widget_set_label + (W : in Storage.Integer_Address; + T : in Interfaces.C.char_array); + pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); + pragma Inline (fl_widget_set_label); + + + function fl_widget_get_type + (W : in Storage.Integer_Address) + return Interfaces.C.unsigned_char; + pragma Import (C, fl_widget_get_type, "fl_widget_get_type"); + pragma Inline (fl_widget_get_type); + + procedure fl_widget_set_type + (W : in Storage.Integer_Address; + T : in Interfaces.C.unsigned_char); + pragma Import (C, fl_widget_set_type, "fl_widget_set_type"); + pragma Inline (fl_widget_set_type); + + + pragma Inline (Activate); + pragma Inline (Deactivate); + pragma Inline (Is_Active); + pragma Inline (Is_Tree_Active); + pragma Inline (Set_Active); + + pragma Inline (Has_Changed); + pragma Inline (Set_Changed); + pragma Inline (Is_Output_Only); + pragma Inline (Set_Output_Only); + pragma Inline (Is_Visible); + pragma Inline (Set_Visible); + + pragma Inline (Has_Visible_Focus); + pragma Inline (Set_Visible_Focus); + pragma Inline (Take_Focus); + pragma Inline (Takes_Events); + + pragma Inline (Get_Background_Color); + pragma Inline (Set_Background_Color); + pragma Inline (Get_Selection_Color); + pragma Inline (Set_Selection_Color); + + pragma Inline (Parent); + pragma Inline (Contains); + pragma Inline (Inside); + pragma Inline (Nearest_Window); + pragma Inline (Top_Window); + pragma Inline (Top_Window_Offset); + + pragma Inline (Get_Alignment); + pragma Inline (Set_Alignment); + pragma Inline (Get_Box); + pragma Inline (Set_Box); + pragma Inline (Get_Tooltip); + pragma Inline (Set_Tooltip); + + pragma Inline (Get_Label); + pragma Inline (Set_Label); + pragma Inline (Get_Label_Color); + pragma Inline (Set_Label_Color); + pragma Inline (Get_Label_Font); + pragma Inline (Set_Label_Font); + pragma Inline (Get_Label_Size); + pragma Inline (Set_Label_Size); + pragma Inline (Get_Label_Kind); + pragma Inline (Set_Label_Kind); + pragma Inline (Measure_Label); + + pragma Inline (Get_Callback); + pragma Inline (Set_Callback); + pragma Inline (Do_Callback); + pragma Inline (Get_When); + pragma Inline (Set_When); + + pragma Inline (Get_X); + pragma Inline (Get_Y); + pragma Inline (Get_W); + pragma Inline (Get_H); + pragma Inline (Resize); + pragma Inline (Reposition); + + pragma Inline (Get_Image); + pragma Inline (Set_Image); + pragma Inline (Get_Inactive_Image); + pragma Inline (Set_Inactive_Image); + + pragma Inline (Is_Damaged); + pragma Inline (Set_Damaged); + pragma Inline (Draw); + pragma Inline (Draw_Label); + pragma Inline (Redraw); + pragma Inline (Redraw_Label); + pragma Inline (Handle); + + +end FLTK.Widgets; + -- cgit