From 524edbb4463b66d61e92c92a7020d9d09b82e744 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Thu, 26 May 2016 00:38:43 +1000 Subject: The Great Package Naming Style Change(tm) --- src/adapad.adb | 22 ++- src/editor.ads | 41 ------ src/editors.ads | 41 ++++++ src/fltk_binding/fltk-widget-box.adb | 54 -------- src/fltk_binding/fltk-widget-box.ads | 22 --- .../fltk-widget-button-light-check.adb | 53 -------- .../fltk-widget-button-light-check.ads | 25 ---- .../fltk-widget-button-light-radio.adb | 53 -------- .../fltk-widget-button-light-radio.ads | 25 ---- .../fltk-widget-button-light-round-radio.adb | 53 -------- .../fltk-widget-button-light-round-radio.ads | 25 ---- .../fltk-widget-button-light-round.adb | 53 -------- .../fltk-widget-button-light-round.ads | 25 ---- src/fltk_binding/fltk-widget-button-light.adb | 53 -------- src/fltk_binding/fltk-widget-button-light.ads | 25 ---- src/fltk_binding/fltk-widget-button-radio.adb | 53 -------- src/fltk_binding/fltk-widget-button-radio.ads | 25 ---- src/fltk_binding/fltk-widget-button-repeat.adb | 53 -------- src/fltk_binding/fltk-widget-button-repeat.ads | 25 ---- src/fltk_binding/fltk-widget-button-ret.adb | 53 -------- src/fltk_binding/fltk-widget-button-ret.ads | 26 ---- src/fltk_binding/fltk-widget-button-toggle.adb | 53 -------- src/fltk_binding/fltk-widget-button-toggle.ads | 25 ---- src/fltk_binding/fltk-widget-button.adb | 96 ------------- src/fltk_binding/fltk-widget-button.ads | 40 ------ .../fltk-widget-group-text_display.adb | 151 --------------------- .../fltk-widget-group-text_display.ads | 58 -------- .../fltk-widget-group-window-double.adb | 95 ------------- .../fltk-widget-group-window-double.ads | 25 ---- src/fltk_binding/fltk-widget-group-window.adb | 86 ------------ src/fltk_binding/fltk-widget-group-window.ads | 25 ---- src/fltk_binding/fltk-widget-group.adb | 149 -------------------- src/fltk_binding/fltk-widget-group.ads | 57 -------- src/fltk_binding/fltk-widget-input.adb | 47 ------- src/fltk_binding/fltk-widget-input.ads | 22 --- src/fltk_binding/fltk-widget.adb | 140 ------------------- src/fltk_binding/fltk-widget.ads | 80 ----------- src/fltk_binding/fltk-widgets-boxes.adb | 54 ++++++++ src/fltk_binding/fltk-widgets-boxes.ads | 22 +++ src/fltk_binding/fltk-widgets-buttons-enter.adb | 53 ++++++++ src/fltk_binding/fltk-widgets-buttons-enter.ads | 26 ++++ .../fltk-widgets-buttons-light-check.adb | 53 ++++++++ .../fltk-widgets-buttons-light-check.ads | 25 ++++ .../fltk-widgets-buttons-light-radio.adb | 53 ++++++++ .../fltk-widgets-buttons-light-radio.ads | 25 ++++ .../fltk-widgets-buttons-light-round-radio.adb | 53 ++++++++ .../fltk-widgets-buttons-light-round-radio.ads | 25 ++++ .../fltk-widgets-buttons-light-round.adb | 53 ++++++++ .../fltk-widgets-buttons-light-round.ads | 25 ++++ src/fltk_binding/fltk-widgets-buttons-light.adb | 53 ++++++++ src/fltk_binding/fltk-widgets-buttons-light.ads | 25 ++++ src/fltk_binding/fltk-widgets-buttons-radio.adb | 53 ++++++++ src/fltk_binding/fltk-widgets-buttons-radio.ads | 25 ++++ src/fltk_binding/fltk-widgets-buttons-repeat.adb | 53 ++++++++ src/fltk_binding/fltk-widgets-buttons-repeat.ads | 25 ++++ src/fltk_binding/fltk-widgets-buttons-toggle.adb | 53 ++++++++ src/fltk_binding/fltk-widgets-buttons-toggle.ads | 25 ++++ src/fltk_binding/fltk-widgets-buttons.adb | 96 +++++++++++++ src/fltk_binding/fltk-widgets-buttons.ads | 40 ++++++ .../fltk-widgets-groups-text_displays.adb | 151 +++++++++++++++++++++ .../fltk-widgets-groups-text_displays.ads | 58 ++++++++ .../fltk-widgets-groups-windows-double.adb | 95 +++++++++++++ .../fltk-widgets-groups-windows-double.ads | 25 ++++ src/fltk_binding/fltk-widgets-groups-windows.adb | 86 ++++++++++++ src/fltk_binding/fltk-widgets-groups-windows.ads | 25 ++++ src/fltk_binding/fltk-widgets-groups.adb | 149 ++++++++++++++++++++ src/fltk_binding/fltk-widgets-groups.ads | 57 ++++++++ src/fltk_binding/fltk-widgets-inputs.adb | 47 +++++++ src/fltk_binding/fltk-widgets-inputs.ads | 22 +++ src/fltk_binding/fltk-widgets.adb | 140 +++++++++++++++++++ src/fltk_binding/fltk-widgets.ads | 80 +++++++++++ 71 files changed, 1906 insertions(+), 1898 deletions(-) delete mode 100644 src/editor.ads create mode 100644 src/editors.ads delete mode 100644 src/fltk_binding/fltk-widget-box.adb delete mode 100644 src/fltk_binding/fltk-widget-box.ads delete mode 100644 src/fltk_binding/fltk-widget-button-light-check.adb delete mode 100644 src/fltk_binding/fltk-widget-button-light-check.ads delete mode 100644 src/fltk_binding/fltk-widget-button-light-radio.adb delete mode 100644 src/fltk_binding/fltk-widget-button-light-radio.ads delete mode 100644 src/fltk_binding/fltk-widget-button-light-round-radio.adb delete mode 100644 src/fltk_binding/fltk-widget-button-light-round-radio.ads delete mode 100644 src/fltk_binding/fltk-widget-button-light-round.adb delete mode 100644 src/fltk_binding/fltk-widget-button-light-round.ads delete mode 100644 src/fltk_binding/fltk-widget-button-light.adb delete mode 100644 src/fltk_binding/fltk-widget-button-light.ads delete mode 100644 src/fltk_binding/fltk-widget-button-radio.adb delete mode 100644 src/fltk_binding/fltk-widget-button-radio.ads delete mode 100644 src/fltk_binding/fltk-widget-button-repeat.adb delete mode 100644 src/fltk_binding/fltk-widget-button-repeat.ads delete mode 100644 src/fltk_binding/fltk-widget-button-ret.adb delete mode 100644 src/fltk_binding/fltk-widget-button-ret.ads delete mode 100644 src/fltk_binding/fltk-widget-button-toggle.adb delete mode 100644 src/fltk_binding/fltk-widget-button-toggle.ads delete mode 100644 src/fltk_binding/fltk-widget-button.adb delete mode 100644 src/fltk_binding/fltk-widget-button.ads delete mode 100644 src/fltk_binding/fltk-widget-group-text_display.adb delete mode 100644 src/fltk_binding/fltk-widget-group-text_display.ads delete mode 100644 src/fltk_binding/fltk-widget-group-window-double.adb delete mode 100644 src/fltk_binding/fltk-widget-group-window-double.ads delete mode 100644 src/fltk_binding/fltk-widget-group-window.adb delete mode 100644 src/fltk_binding/fltk-widget-group-window.ads delete mode 100644 src/fltk_binding/fltk-widget-group.adb delete mode 100644 src/fltk_binding/fltk-widget-group.ads delete mode 100644 src/fltk_binding/fltk-widget-input.adb delete mode 100644 src/fltk_binding/fltk-widget-input.ads delete mode 100644 src/fltk_binding/fltk-widget.adb delete mode 100644 src/fltk_binding/fltk-widget.ads create mode 100644 src/fltk_binding/fltk-widgets-boxes.adb create mode 100644 src/fltk_binding/fltk-widgets-boxes.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-enter.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-enter.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-check.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-check.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-radio.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-radio.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-round.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-light-round.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-light.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-light.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-radio.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-radio.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-repeat.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-repeat.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons-toggle.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons-toggle.ads create mode 100644 src/fltk_binding/fltk-widgets-buttons.adb create mode 100644 src/fltk_binding/fltk-widgets-buttons.ads create mode 100644 src/fltk_binding/fltk-widgets-groups-text_displays.adb create mode 100644 src/fltk_binding/fltk-widgets-groups-text_displays.ads create mode 100644 src/fltk_binding/fltk-widgets-groups-windows-double.adb create mode 100644 src/fltk_binding/fltk-widgets-groups-windows-double.ads create mode 100644 src/fltk_binding/fltk-widgets-groups-windows.adb create mode 100644 src/fltk_binding/fltk-widgets-groups-windows.ads create mode 100644 src/fltk_binding/fltk-widgets-groups.adb create mode 100644 src/fltk_binding/fltk-widgets-groups.ads create mode 100644 src/fltk_binding/fltk-widgets-inputs.adb create mode 100644 src/fltk_binding/fltk-widgets-inputs.ads create mode 100644 src/fltk_binding/fltk-widgets.adb create mode 100644 src/fltk_binding/fltk-widgets.ads diff --git a/src/adapad.adb b/src/adapad.adb index 271b77d..63ad67f 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -1,19 +1,27 @@ -- with Editor; -with FLTK.Widget.Group.Window.Double; -with FLTK.Widget.Box; -with FLTK.Widget.Group.Text_Display; +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Boxes; +with FLTK.Widgets.Buttons.Enter; +with FLTK.Widgets.Buttons.Light.Check; +with FLTK.Widgets.Buttons.Light.Radio; +with FLTK.Widgets.Buttons.Light.Round.Radio; +with FLTK.Widgets.Buttons.Radio; +with FLTK.Widgets.Buttons.Repeat; +with FLTK.Widgets.Buttons.Toggle; +with FLTK.Widgets.Inputs; +with FLTK.Widgets.Groups.Text_Displays; with FLTK.Enums; use FLTK.Enums; function AdaPad return Integer is - package Dbl renames FLTK.Widget.Group.Window.Double; - package Box renames FLTK.Widget.Box; + package Dbl renames FLTK.Widgets.Groups.Windows.Double; + package Bx renames FLTK.Widgets.Boxes; - W : Dbl.Double_Type := Dbl.Create (340, 180); - B : Box.Box_Type := Box.Create (20, 40, 300, 100, "Test"); + W : Dbl.Double_Window := Dbl.Create (340, 180); + B : Bx.Box := Bx.Create (20, 40, 300, 100, "Test"); begin diff --git a/src/editor.ads b/src/editor.ads deleted file mode 100644 index e80111a..0000000 --- a/src/editor.ads +++ /dev/null @@ -1,41 +0,0 @@ - - -with FLTK.Widget.Group.Window.Double; -with FLTK.Widget.Input; -with FLTK.Widget.Button.Ret; - - -package Editor is - - - package Window renames FLTK.Widget.Group.Window; - - type Editor_Type is new Window.Double.Double_Type with private; - - - function Create - (X, Y, W, H : in Integer; - Label : in String) - return Editor_Type; - - -private - - - type Editor_Type is new Window.Double.Double_Type with - record - Replace_Dialog : Window.Window_Type; - Replace_Find : FLTK.Widget.Input.Input_Type; - Replace_With : FLTK.Widget.Input.Input_Type; - Replace_All : FLTK.Widget.Button.Button_Type; - Replace_Next : FLTK.Widget.Button.Ret.Return_Type; - Replace_Cancel : FLTK.Widget.Button.Button_Type; - end record; - - - overriding procedure Initialize (This : in out Editor_Type); - overriding procedure Finalize (This : in out Editor_Type); - - -end Editor; - diff --git a/src/editors.ads b/src/editors.ads new file mode 100644 index 0000000..27d54d7 --- /dev/null +++ b/src/editors.ads @@ -0,0 +1,41 @@ + + +with FLTK.Widgets.Groups.Windows.Double; +with FLTK.Widgets.Inputs; +with FLTK.Widgets.Buttons.Enter; + + +package Editors is + + + package Windows renames FLTK.Widgets.Groups.Windows; + + type Editor is new Windows.Double.Double_Window with private; + + + function Create + (X, Y, W, H : in Integer; + Label : in String) + return Editor; + + +private + + + type Editor is new Windows.Double.Double_Window with + record + Replace_Dialog : Windows.Window; + Replace_Find : FLTK.Widgets.Inputs.Input; + Replace_With : FLTK.Widgets.Inputs.Input; + Replace_All : FLTK.Widgets.Buttons.Button; + Replace_Next : FLTK.Widgets.Buttons.Enter.Enter_Button; + Replace_Cancel : FLTK.Widgets.Buttons.Button; + end record; + + + overriding procedure Initialize (This : in out Editor); + overriding procedure Finalize (This : in out Editor); + + +end Editors; + diff --git a/src/fltk_binding/fltk-widget-box.adb b/src/fltk_binding/fltk-widget-box.adb deleted file mode 100644 index 8aa18cb..0000000 --- a/src/fltk_binding/fltk-widget-box.adb +++ /dev/null @@ -1,54 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Box is - - - function new_fl_box - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_box, "new_fl_box"); - - procedure free_fl_box (B : in System.Address); - pragma Import (C, free_fl_box, "free_fl_box"); - - - - - procedure Finalize (This : in out Box_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_box (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Box_Type is - - VP : System.Address; - - begin - - VP := new_fl_box - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - - end Create; - - -end FLTK.Widget.Box; - diff --git a/src/fltk_binding/fltk-widget-box.ads b/src/fltk_binding/fltk-widget-box.ads deleted file mode 100644 index 2ce03e7..0000000 --- a/src/fltk_binding/fltk-widget-box.ads +++ /dev/null @@ -1,22 +0,0 @@ - - -package FLTK.Widget.Box is - - - type Box_Type is new Widget_Type with private; - - - function Create (X, Y, W, H : Integer; Label : String) return Box_Type; - - -private - - - type Box_Type is new Widget_Type with null record; - - - overriding procedure Finalize (This : in out Box_Type); - - -end FLTK.Widget.Box; - diff --git a/src/fltk_binding/fltk-widget-button-light-check.adb b/src/fltk_binding/fltk-widget-button-light-check.adb deleted file mode 100644 index 0be477e..0000000 --- a/src/fltk_binding/fltk-widget-button-light-check.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Light.Check is - - - function new_fl_check_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_check_button, "new_fl_check_button"); - - procedure free_fl_check_button - (B : in System.Address); - pragma Import (C, free_fl_check_button, "free_fl_check_button"); - - - - - procedure Finalize (This : in out Check_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_check_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Check_Type is - - VP : System.Address; - - begin - VP := new_fl_check_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Light.Check; - diff --git a/src/fltk_binding/fltk-widget-button-light-check.ads b/src/fltk_binding/fltk-widget-button-light-check.ads deleted file mode 100644 index 14eab60..0000000 --- a/src/fltk_binding/fltk-widget-button-light-check.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Light.Check is - - - type Check_Type is new Light_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Check_Type; - - -private - - - type Check_Type is new Light_Type with null record; - - - overriding procedure Finalize (This : in out Check_Type); - - -end FLTK.Widget.Button.Light.Check; - diff --git a/src/fltk_binding/fltk-widget-button-light-radio.adb b/src/fltk_binding/fltk-widget-button-light-radio.adb deleted file mode 100644 index d3a5e48..0000000 --- a/src/fltk_binding/fltk-widget-button-light-radio.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Light.Radio is - - - function new_fl_radio_light_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); - - procedure free_fl_radio_light_button - (B : in System.Address); - pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); - - - - - procedure Finalize (This : in out Radio_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_radio_light_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type is - - VP : System.Address; - - begin - VP := new_fl_radio_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Light.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-light-radio.ads b/src/fltk_binding/fltk-widget-button-light-radio.ads deleted file mode 100644 index bf78d65..0000000 --- a/src/fltk_binding/fltk-widget-button-light-radio.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Light.Radio is - - - type Radio_Type is new Light_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type; - - -private - - - type Radio_Type is new Light_Type with null record; - - - overriding procedure Finalize (This : in out Radio_Type); - - -end FLTK.Widget.Button.Light.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-light-round-radio.adb b/src/fltk_binding/fltk-widget-button-light-round-radio.adb deleted file mode 100644 index d3a857d..0000000 --- a/src/fltk_binding/fltk-widget-button-light-round-radio.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Light.Round.Radio is - - - function new_fl_radio_round_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); - - procedure free_fl_radio_round_button - (B : in System.Address); - pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); - - - - - procedure Finalize (This : in out Radio_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_radio_round_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type is - - VP : System.Address; - - begin - VP := new_fl_radio_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Light.Round.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-light-round-radio.ads b/src/fltk_binding/fltk-widget-button-light-round-radio.ads deleted file mode 100644 index c0e4f38..0000000 --- a/src/fltk_binding/fltk-widget-button-light-round-radio.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Light.Round.Radio is - - - type Radio_Type is new Round_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type; - - -private - - - type Radio_Type is new Round_Type with null record; - - - overriding procedure Finalize (This : in out Radio_Type); - - -end FLTK.Widget.Button.Light.Round.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-light-round.adb b/src/fltk_binding/fltk-widget-button-light-round.adb deleted file mode 100644 index bda70f4..0000000 --- a/src/fltk_binding/fltk-widget-button-light-round.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Light.Round is - - - function new_fl_round_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_round_button, "new_fl_round_button"); - - procedure free_fl_round_button - (B : in System.Address); - pragma Import (C, free_fl_round_button, "free_fl_round_button"); - - - - - procedure Finalize (This : in out Round_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_round_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Round_Type is - - VP : System.Address; - - begin - VP := new_fl_round_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Light.Round; - diff --git a/src/fltk_binding/fltk-widget-button-light-round.ads b/src/fltk_binding/fltk-widget-button-light-round.ads deleted file mode 100644 index e440b1a..0000000 --- a/src/fltk_binding/fltk-widget-button-light-round.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Light.Round is - - - type Round_Type is new Light_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Round_Type; - - -private - - - type Round_Type is new Light_Type with null record; - - - overriding procedure Finalize (This : in out Round_Type); - - -end FLTK.Widget.Button.Light.Round; - diff --git a/src/fltk_binding/fltk-widget-button-light.adb b/src/fltk_binding/fltk-widget-button-light.adb deleted file mode 100644 index 6f76890..0000000 --- a/src/fltk_binding/fltk-widget-button-light.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Light is - - - function new_fl_light_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_light_button, "new_fl_light_button"); - - procedure free_fl_light_button - (B : in System.Address); - pragma Import (C, free_fl_light_button, "free_fl_light_button"); - - - - - procedure Finalize (This : in out Light_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_light_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Light_Type is - - VP : System.Address; - - begin - VP := new_fl_light_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Light; - diff --git a/src/fltk_binding/fltk-widget-button-light.ads b/src/fltk_binding/fltk-widget-button-light.ads deleted file mode 100644 index bbc2c9e..0000000 --- a/src/fltk_binding/fltk-widget-button-light.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Light is - - - type Light_Type is new Button_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Light_Type; - - -private - - - type Light_Type is new Button_Type with null record; - - - overriding procedure Finalize (This : in out Light_Type); - - -end FLTK.Widget.Button.Light; - diff --git a/src/fltk_binding/fltk-widget-button-radio.adb b/src/fltk_binding/fltk-widget-button-radio.adb deleted file mode 100644 index 4af17e4..0000000 --- a/src/fltk_binding/fltk-widget-button-radio.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Radio is - - - function new_fl_radio_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); - - procedure free_fl_radio_button - (B : in System.Address); - pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); - - - - - procedure Finalize (This : in out Radio_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_radio_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type is - - VP : System.Address; - - begin - VP := new_fl_radio_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-radio.ads b/src/fltk_binding/fltk-widget-button-radio.ads deleted file mode 100644 index 2c36c77..0000000 --- a/src/fltk_binding/fltk-widget-button-radio.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Radio is - - - type Radio_Type is new Button_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Radio_Type; - - -private - - - type Radio_Type is new Button_Type with null record; - - - overriding procedure Finalize (This : in out Radio_Type); - - -end FLTK.Widget.Button.Radio; - diff --git a/src/fltk_binding/fltk-widget-button-repeat.adb b/src/fltk_binding/fltk-widget-button-repeat.adb deleted file mode 100644 index 3bdc52b..0000000 --- a/src/fltk_binding/fltk-widget-button-repeat.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Repeat is - - - function new_fl_repeat_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); - - procedure free_fl_repeat_button - (B : in System.Address); - pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); - - - - - procedure Finalize (This : in out Repeat_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_repeat_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Repeat_Type is - - VP : System.Address; - - begin - VP := new_fl_repeat_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Repeat; - diff --git a/src/fltk_binding/fltk-widget-button-repeat.ads b/src/fltk_binding/fltk-widget-button-repeat.ads deleted file mode 100644 index d7cd383..0000000 --- a/src/fltk_binding/fltk-widget-button-repeat.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Repeat is - - - type Repeat_Type is new Button_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Repeat_Type; - - -private - - - type Repeat_Type is new Button_Type with null record; - - - overriding procedure Finalize (This : in out Repeat_Type); - - -end FLTK.Widget.Button.Repeat; - diff --git a/src/fltk_binding/fltk-widget-button-ret.adb b/src/fltk_binding/fltk-widget-button-ret.adb deleted file mode 100644 index 8f68341..0000000 --- a/src/fltk_binding/fltk-widget-button-ret.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Ret is - - - function new_fl_return_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_return_button, "new_fl_return_button"); - - procedure free_fl_return_button - (B : in System.Address); - pragma Import (C, free_fl_return_button, "free_fl_return_button"); - - - - - procedure Finalize (This : in out Return_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_return_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Return_Type is - - VP : System.Address; - - begin - VP := new_fl_return_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Ret; - diff --git a/src/fltk_binding/fltk-widget-button-ret.ads b/src/fltk_binding/fltk-widget-button-ret.ads deleted file mode 100644 index ed0da3c..0000000 --- a/src/fltk_binding/fltk-widget-button-ret.ads +++ /dev/null @@ -1,26 +0,0 @@ - - --- FLTK.Widget.Button.Return, but return is a reserved word -package FLTK.Widget.Button.Ret is - - - type Return_Type is new Button_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Return_Type; - - -private - - - type Return_Type is new Button_Type with null record; - - - overriding procedure Finalize (This : in out Return_Type); - - -end FLTK.Widget.Button.Ret; - diff --git a/src/fltk_binding/fltk-widget-button-toggle.adb b/src/fltk_binding/fltk-widget-button-toggle.adb deleted file mode 100644 index 3bd692c..0000000 --- a/src/fltk_binding/fltk-widget-button-toggle.adb +++ /dev/null @@ -1,53 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button.Toggle is - - - function new_fl_toggle_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); - - procedure free_fl_toggle_button - (B : in System.Address); - pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); - - - - - procedure Finalize (This : in out Toggle_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_toggle_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Toggle_Type is - - VP : System.Address; - - begin - VP := new_fl_toggle_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Button.Toggle; - diff --git a/src/fltk_binding/fltk-widget-button-toggle.ads b/src/fltk_binding/fltk-widget-button-toggle.ads deleted file mode 100644 index e9d185e..0000000 --- a/src/fltk_binding/fltk-widget-button-toggle.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Button.Toggle is - - - type Toggle_Type is new Button_Type with private; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Toggle_Type; - - -private - - - type Toggle_Type is new Button_Type with null record; - - - overriding procedure Finalize (This : in out Toggle_Type); - - -end FLTK.Widget.Button.Toggle; - diff --git a/src/fltk_binding/fltk-widget-button.adb b/src/fltk_binding/fltk-widget-button.adb deleted file mode 100644 index 238e761..0000000 --- a/src/fltk_binding/fltk-widget-button.adb +++ /dev/null @@ -1,96 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Button is - - - function new_fl_button - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_button, "new_fl_button"); - - procedure free_fl_button - (B : in System.Address); - pragma Import (C, free_fl_button, "free_fl_button"); - - function fl_button_get_state - (B : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_button_get_state, "fl_button_get_state"); - - procedure fl_button_set_state - (B : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_button_set_state, "fl_button_set_state"); - - procedure fl_button_set_only - (B : in System.Address); - pragma Import (C, fl_button_set_only, "fl_button_set_only"); - - - - - procedure Finalize (This : in out Button_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_button (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Button_Type is - - VP : System.Address; - - begin - VP := new_fl_button - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - function Get_State - (B : in Button_Type'Class) - return State is - begin - return State'Val (fl_button_get_state (B.Void_Ptr)); - end Get_State; - - - - - procedure Set_State - (B : in Button_Type'Class; - S : in State) is - begin - fl_button_set_state (B.Void_Ptr, State'Pos (S)); - end Set_State; - - - - - procedure Set_Only - (B : in Button_Type'Class) is - begin - fl_button_set_only (B.Void_Ptr); - end Set_Only; - - -end FLTK.Widget.Button; - diff --git a/src/fltk_binding/fltk-widget-button.ads b/src/fltk_binding/fltk-widget-button.ads deleted file mode 100644 index 14762bf..0000000 --- a/src/fltk_binding/fltk-widget-button.ads +++ /dev/null @@ -1,40 +0,0 @@ - - -package FLTK.Widget.Button is - - - type Button_Type is new Widget_Type with private; - type State is (On, Off); - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Button_Type; - - - function Get_State - (B : in Button_Type'Class) - return State; - - - procedure Set_State - (B : in Button_Type'Class; - S : in State); - - - procedure Set_Only - (B : in Button_Type'Class); - - -private - - - type Button_Type is new Widget_Type with null record; - - - overriding procedure Finalize (This : in out Button_Type); - - -end FLTK.Widget.Button; - diff --git a/src/fltk_binding/fltk-widget-group-text_display.adb b/src/fltk_binding/fltk-widget-group-text_display.adb deleted file mode 100644 index e558d9a..0000000 --- a/src/fltk_binding/fltk-widget-group-text_display.adb +++ /dev/null @@ -1,151 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Group.Text_Display is - - - function new_fl_text_display - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_text_display, "new_fl_text_display"); - - procedure free_fl_text_display - (TD : in System.Address); - pragma Import (C, free_fl_text_display, "free_fl_text_display"); - - function fl_text_display_get_text_color - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); - - procedure fl_text_display_set_text_color - (TD : in System.Address; - C : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); - - function fl_text_display_get_text_font - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); - - procedure fl_text_display_set_text_font - (TD : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); - - function fl_text_display_get_text_size - (TD : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); - - procedure fl_text_display_set_text_size - (TD : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); - - - - - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - - procedure Finalize (This : in out Text_Display_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_text_display (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Label : in String) - return Text_Display_Type is - - VP : System.Address; - - begin - VP := new_fl_text_display - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - function Get_Text_Color - (TD : in Text_Display_Type) - return Color is - begin - return Color (fl_text_display_get_text_color (TD.Void_Ptr)); - end Get_Text_Color; - - - - - procedure Set_Text_Color - (TD : in Text_Display_Type; - C : in Color) is - begin - fl_text_display_set_text_color (TD.Void_Ptr, Interfaces.C.int (C)); - end Set_Text_Color; - - - - - function Get_Text_Font - (TD : in Text_Display_Type) - return Font_Kind is - begin - return Font_Kind'Val (fl_text_display_get_text_font (TD.Void_Ptr)); - end Get_Text_Font; - - - - - procedure Set_Text_Font - (TD : in Text_Display_Type; - F : in Font_Kind) is - begin - fl_text_display_set_text_font (TD.Void_Ptr, Font_Kind'Pos (F)); - end Set_Text_Font; - - - - - function Get_Text_Size - (TD : in Text_Display_Type) - return Font_Size is - begin - return Font_Size (fl_text_display_get_text_size (TD.Void_Ptr)); - end Get_Text_Size; - - - - - procedure Set_Text_Size - (TD : in Text_Display_Type; - S : in Font_Size) is - begin - fl_text_display_set_text_size (TD.Void_Ptr, Interfaces.C.int (S)); - end Set_Text_Size; - - -end FLTK.Widget.Group.Text_Display; - diff --git a/src/fltk_binding/fltk-widget-group-text_display.ads b/src/fltk_binding/fltk-widget-group-text_display.ads deleted file mode 100644 index adbbeb4..0000000 --- a/src/fltk_binding/fltk-widget-group-text_display.ads +++ /dev/null @@ -1,58 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; - - -package FLTK.Widget.Group.Text_Display is - - - type Text_Display_Type is new Group_Type with private; - - - function Create - (X, Y, W, H : in Integer; - Label : in String) - return Text_Display_Type; - - - function Get_Text_Color - (TD : in Text_Display_Type) - return Color; - - - procedure Set_Text_Color - (TD : in Text_Display_Type; - C : in Color); - - - function Get_Text_Font - (TD : in Text_Display_Type) - return Font_Kind; - - - procedure Set_Text_Font - (TD : in Text_Display_Type; - F : in Font_Kind); - - - function Get_Text_Size - (TD : in Text_Display_Type) - return Font_Size; - - - procedure Set_Text_Size - (TD : in Text_Display_Type; - S : in Font_Size); - - -private - - - type Text_Display_Type is new Group_Type with null record; - - - overriding procedure Finalize (This : in out Text_Display_Type); - - -end FLTK.Widget.Group.Text_Display; - diff --git a/src/fltk_binding/fltk-widget-group-window-double.adb b/src/fltk_binding/fltk-widget-group-window-double.adb deleted file mode 100644 index 1e678f3..0000000 --- a/src/fltk_binding/fltk-widget-group-window-double.adb +++ /dev/null @@ -1,95 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Group.Window.Double is - - - function new_fl_double_window - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_double_window, "new_fl_double_window"); - - function new_fl_double_window2 - (X, Y : in Interfaces.C.int) - return System.Address; - pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); - - procedure free_fl_double_window - (W : in System.Address); - pragma Import (C, free_fl_double_window, "free_fl_double_window"); - - procedure fl_double_window_show - (W : in System.Address); - pragma Import (C, fl_double_window_show, "fl_double_window_show"); - - - - - procedure fl_group_end (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - - procedure Finalize (This : in out Double_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_double_window (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Double_Type is - - VP : System.Address; - - begin - VP := new_fl_double_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - function Create - (W, H : in Integer) - return Double_Type is - - VP : System.Address; - - begin - VP := new_fl_double_window2 - (Interfaces.C.int (W), - Interfaces.C.int (H)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - procedure Show - (W : in Double_Type) is - begin - fl_double_window_show (W.Void_Ptr); - end Show; - - -end FLTK.Widget.Group.Window.Double; - diff --git a/src/fltk_binding/fltk-widget-group-window-double.ads b/src/fltk_binding/fltk-widget-group-window-double.ads deleted file mode 100644 index 687b876..0000000 --- a/src/fltk_binding/fltk-widget-group-window-double.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Group.Window.Double is - - - type Double_Type is new Window_Type with private; - - - function Create (X, Y, W, H : Integer; Label : String) return Double_Type; - function Create (W, H : in Integer) return Double_Type; - - procedure Show (W : in Double_Type); - - -private - - - type Double_Type is new Window_Type with null record; - - - overriding procedure Finalize (This : in out Double_Type); - - -end FLTK.Widget.Group.Window.Double; - diff --git a/src/fltk_binding/fltk-widget-group-window.adb b/src/fltk_binding/fltk-widget-group-window.adb deleted file mode 100644 index 1007d71..0000000 --- a/src/fltk_binding/fltk-widget-group-window.adb +++ /dev/null @@ -1,86 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Group.Window is - - - function new_fl_window - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_window, "new_fl_window"); - - function new_fl_window2 (W, H : in Interfaces.C.int) return System.Address; - pragma Import (C, new_fl_window2, "new_fl_window2"); - - procedure free_fl_window (W : in System.Address); - pragma Import (C, free_fl_window, "free_fl_window"); - - procedure fl_window_show (W : in System.Address); - pragma Import (C, fl_window_show, "fl_window_show"); - - - - - procedure fl_group_end (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - - - - procedure Finalize (This : in out Window_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_window (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Window_Type is - - VP : System.Address; - - begin - - VP := new_fl_window - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - - end Create; - - - - - function Create (W, H : in Integer) return Window_Type is - VP : System.Address; - begin - VP := new_fl_window2 (Interfaces.C.int (W), Interfaces.C.int (H)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - procedure Show (W : in Window_Type) is - begin - fl_window_show (W.Void_Ptr); - end Show; - - -end FLTK.Widget.Group.Window; - diff --git a/src/fltk_binding/fltk-widget-group-window.ads b/src/fltk_binding/fltk-widget-group-window.ads deleted file mode 100644 index 6d4a32d..0000000 --- a/src/fltk_binding/fltk-widget-group-window.ads +++ /dev/null @@ -1,25 +0,0 @@ - - -package FLTK.Widget.Group.Window is - - - type Window_Type is new Group_Type with private; - - - function Create (X, Y, W, H : Integer; Label : String) return Window_Type; - function Create (W, H : in Integer) return Window_Type; - - procedure Show (W : in Window_Type); - - -private - - - type Window_Type is new Group_Type with null record; - - - overriding procedure Finalize (This : in out Window_Type); - - -end FLTK.Widget.Group.Window; - diff --git a/src/fltk_binding/fltk-widget-group.adb b/src/fltk_binding/fltk-widget-group.adb deleted file mode 100644 index 76414b7..0000000 --- a/src/fltk_binding/fltk-widget-group.adb +++ /dev/null @@ -1,149 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Group is - - - function new_fl_group - (X, Y, W, H : in Interfaces.C.int; - L : in Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_group, "new_fl_group"); - - procedure free_fl_group - (G : in System.Address); - pragma Import (C, free_fl_group, "free_fl_group"); - - procedure fl_group_end - (G : in System.Address); - pragma Import (C, fl_group_end, "fl_group_end"); - - procedure fl_group_add - (G, W : in System.Address); - pragma Import (C, fl_group_add, "fl_group_add"); - - procedure fl_group_clear - (G : in System.Address); - pragma Import (C, fl_group_clear, "fl_group_clear"); - - function fl_group_find - (G, W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_group_find, "fl_group_find"); - - procedure fl_group_insert - (G, W : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_insert, "fl_group_insert"); - - procedure fl_group_remove - (G, W : in System.Address); - pragma Import (C, fl_group_remove, "fl_group_remove"); - - procedure fl_group_remove2 - (G : in System.Address; - P : in Interfaces.C.int); - pragma Import (C, fl_group_remove2, "fl_group_remove2"); - - - - - procedure Finalize (This : in out Group_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_group (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create - (X, Y, W, H : in Integer; - Label : in String) - return Group_Type is - - VP : System.Address; - - begin - VP := new_fl_group - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - fl_group_end (VP); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - - - - procedure Add - (This : Group_Type'Class; - Item : Widget_Type'Class) is - begin - fl_group_add (This.Void_Ptr, Item.Void_Ptr); - end Add; - - - - - procedure Clear - (This : Group_Type'Class) is - begin - fl_group_clear (This.Void_Ptr); - end Clear; - - - - - function Find - (This : Group_Type'Class; - Item : Widget_Type'Class) - return Index is - begin - return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); - end Find; - - - - - procedure Insert - (This : Group_Type'Class; - Item : Widget_Type'Class; - Place : Index) is - begin - fl_group_insert - (This.Void_Ptr, - Item.Void_Ptr, - Interfaces.C.int (Place)); - end Insert; - - - - - procedure Remove - (This : Group_Type'Class; - Item : Widget_Type'Class) is - begin - fl_group_remove (This.Void_Ptr, Item.Void_Ptr); - end Remove; - - - - - procedure Remove - (This : Group_Type'Class; - Place : Index) is - begin - fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); - end Remove; - - -end FLTK.Widget.Group; - diff --git a/src/fltk_binding/fltk-widget-group.ads b/src/fltk_binding/fltk-widget-group.ads deleted file mode 100644 index d71f76c..0000000 --- a/src/fltk_binding/fltk-widget-group.ads +++ /dev/null @@ -1,57 +0,0 @@ - - -package FLTK.Widget.Group is - - - type Group_Type is new Widget_Type with private; - type Index is new Integer; - - - function Create - (X, Y, W, H : Integer; - Label : String) - return Group_Type; - - - procedure Add - (This : Group_Type'Class; - Item : Widget_Type'Class); - - - procedure Clear - (This : Group_Type'Class); - - - function Find - (This : Group_Type'Class; - Item : Widget_Type'Class) - return Index; - - - procedure Insert - (This : Group_Type'Class; - Item : Widget_Type'Class; - Place : Index); - - - procedure Remove - (This : Group_Type'Class; - Item : Widget_Type'Class); - - - procedure Remove - (This : Group_Type'Class; - Place : Index); - - -private - - - type Group_Type is new Widget_Type with null record; - - - overriding procedure Finalize (This : in out Group_Type); - - -end FLTK.Widget.Group; - diff --git a/src/fltk_binding/fltk-widget-input.adb b/src/fltk_binding/fltk-widget-input.adb deleted file mode 100644 index 2428dde..0000000 --- a/src/fltk_binding/fltk-widget-input.adb +++ /dev/null @@ -1,47 +0,0 @@ - - -with Interfaces.C; -with System; -use type System.Address; - - -package body FLTK.Widget.Input is - - - function new_fl_input - (X, Y, W, H : Interfaces.C.int; - L : Interfaces.C.char_array) - return System.Address; - pragma Import (C, new_fl_input, "new_fl_input"); - - procedure free_fl_input (F : in System.Address); - pragma Import (C, free_fl_input, "free_fl_input"); - - - - - procedure Finalize (This : in out Input_Type) is - begin - if (This.Void_Ptr /= System.Null_Address) then - free_fl_input (This.Void_Ptr); - end if; - end Finalize; - - - - - function Create (X, Y, W, H : Integer; Label : String) return Input_Type is - VP : System.Address; - begin - VP := new_fl_input - (Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H), - Interfaces.C.To_C (Label)); - return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); - end Create; - - -end FLTK.Widget.Input; - diff --git a/src/fltk_binding/fltk-widget-input.ads b/src/fltk_binding/fltk-widget-input.ads deleted file mode 100644 index c537aef..0000000 --- a/src/fltk_binding/fltk-widget-input.ads +++ /dev/null @@ -1,22 +0,0 @@ - - -package FLTK.Widget.Input is - - - type Input_Type is new Widget_Type with private; - - - function Create (X, Y, W, H : Integer; Label : String) return Input_Type; - - -private - - - type Input_Type is new Widget_Type with null record; - - - overriding procedure Finalize (This : in out Input_Type); - - -end FLTK.Widget.Input; - diff --git a/src/fltk_binding/fltk-widget.adb b/src/fltk_binding/fltk-widget.adb deleted file mode 100644 index a19969f..0000000 --- a/src/fltk_binding/fltk-widget.adb +++ /dev/null @@ -1,140 +0,0 @@ - - -with Interfaces.C; -with System; - - -package body FLTK.Widget is - - - function fl_widget_get_box - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); - - procedure fl_widget_set_box - (W : in System.Address; - B : in Interfaces.C.int); - pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); - - function fl_widget_get_label_font - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_font, "fl_widget_get_label_font"); - - procedure fl_widget_set_label_font - (W : in System.Address; - F : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_font, "fl_widget_set_label_font"); - - function fl_widget_get_label_size - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_size, "fl_widget_get_label_size"); - - procedure fl_widget_set_label_size - (W : in System.Address; - S : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_size, "fl_widget_set_label_size"); - - function fl_widget_get_label_type - (W : in System.Address) - return Interfaces.C.int; - pragma Import (C, fl_widget_get_label_type, "fl_widget_get_label_type"); - - procedure fl_widget_set_label_type - (W : in System.Address; - L : in Interfaces.C.int); - pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); - - - - - procedure Initialize (This : in out Widget_Type) is - begin - This.Void_Ptr := System.Null_Address; - end Initialize; - - - - - function Get_Box - (W : in Widget_Type'Class) - return Box_Kind is - begin - return Box_Kind'Val (fl_widget_get_box (W.Void_Ptr)); - end Get_Box; - - - - - procedure Set_Box - (W : in Widget_Type'Class; - B : in Box_Kind) is - begin - fl_widget_set_box (W.Void_Ptr, Box_Kind'Pos (B)); - end Set_Box; - - - - - function Get_Label_Font - (W : in Widget_Type'Class) - return Font_Kind is - begin - return Font_Kind'Val (fl_widget_get_label_font (W.Void_Ptr)); - end Get_Label_Font; - - - - - procedure Set_Label_Font - (W : in Widget_Type'Class; - F : in Font_Kind) is - begin - fl_widget_set_label_font (W.Void_Ptr, Font_Kind'Pos (F)); - end Set_Label_Font; - - - - - function Get_Label_Size - (W : in Widget_Type'Class) - return Font_Size is - begin - return Font_Size (fl_widget_get_label_size (W.Void_Ptr)); - end Get_Label_Size; - - - - - procedure Set_Label_Size - (W : in Widget_Type'Class; - S : in Font_Size) is - begin - fl_widget_set_label_size (W.Void_Ptr, Interfaces.C.int (S)); - end Set_Label_Size; - - - - - function Get_Label_Type - (W : in Widget_Type'Class) - return Label_Kind is - begin - return Label_Kind'Val (fl_widget_get_label_type (W.Void_Ptr)); - end Get_Label_Type; - - - - - procedure Set_Label_Type - (W : in Widget_Type'Class; - L : in Label_Kind) is - begin - fl_widget_set_label_type (W.Void_Ptr, Label_Kind'Pos (L)); - end Set_Label_Type; - - -end FLTK.Widget; - diff --git a/src/fltk_binding/fltk-widget.ads b/src/fltk_binding/fltk-widget.ads deleted file mode 100644 index ef4650e..0000000 --- a/src/fltk_binding/fltk-widget.ads +++ /dev/null @@ -1,80 +0,0 @@ - - -with FLTK.Enums; use FLTK.Enums; -with Ada.Finalization; -private with System; - - -package FLTK.Widget is - - - type Widget_Type is abstract new Ada.Finalization.Limited_Controlled with private; - - - type Font_Size is new Natural; - Normal_Size : constant Font_Size := 14; - - - type Color is new Natural; - - - function Create - (X, Y, W, H : in Integer; - Label : in String) - return Widget_Type is abstract; - - - function Get_Box - (W : in Widget_Type'Class) - return Box_Kind; - - - procedure Set_Box - (W : in Widget_Type'Class; - B : in Box_Kind); - - - function Get_Label_Font - (W : in Widget_Type'Class) - return Font_Kind; - - - procedure Set_Label_Font - (W : in Widget_Type'Class; - F : in Font_Kind); - - - function Get_Label_Size - (W : in Widget_Type'Class) - return Font_Size; - - - procedure Set_Label_Size - (W : in Widget_Type'Class; - S : in Font_Size); - - - function Get_Label_Type - (W : in Widget_Type'Class) - return Label_Kind; - - - procedure Set_Label_Type - (W : in Widget_Type'Class; - L : in Label_Kind); - - -private - - - type Widget_Type is abstract new Ada.Finalization.Limited_Controlled with - record - Void_Ptr : System.Address; - end record; - - - overriding procedure Initialize (This : in out Widget_Type); - - -end FLTK.Widget; - diff --git a/src/fltk_binding/fltk-widgets-boxes.adb b/src/fltk_binding/fltk-widgets-boxes.adb new file mode 100644 index 0000000..a176c30 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-boxes.adb @@ -0,0 +1,54 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Boxes is + + + function new_fl_box + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_box, "new_fl_box"); + + procedure free_fl_box (B : in System.Address); + pragma Import (C, free_fl_box, "free_fl_box"); + + + + + procedure Finalize (This : in out Box) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_box (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Box is + + VP : System.Address; + + begin + + VP := new_fl_box + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + + end Create; + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk_binding/fltk-widgets-boxes.ads b/src/fltk_binding/fltk-widgets-boxes.ads new file mode 100644 index 0000000..4b27e1e --- /dev/null +++ b/src/fltk_binding/fltk-widgets-boxes.ads @@ -0,0 +1,22 @@ + + +package FLTK.Widgets.Boxes is + + + type Box is new Widget with private; + + + function Create (X, Y, W, H : Integer; Label : String) return Box; + + +private + + + type Box is new Widget with null record; + + + overriding procedure Finalize (This : in out Box); + + +end FLTK.Widgets.Boxes; + diff --git a/src/fltk_binding/fltk-widgets-buttons-enter.adb b/src/fltk_binding/fltk-widgets-buttons-enter.adb new file mode 100644 index 0000000..89b6c2f --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-enter.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Enter is + + + function new_fl_return_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_return_button, "new_fl_return_button"); + + procedure free_fl_return_button + (B : in System.Address); + pragma Import (C, free_fl_return_button, "free_fl_return_button"); + + + + + procedure Finalize (This : in out Enter_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_return_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Enter_Button is + + VP : System.Address; + + begin + VP := new_fl_return_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk_binding/fltk-widgets-buttons-enter.ads b/src/fltk_binding/fltk-widgets-buttons-enter.ads new file mode 100644 index 0000000..8649130 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-enter.ads @@ -0,0 +1,26 @@ + + +-- Return Buttons, but return is a reserved word, so it's Enter Buttons instead +package FLTK.Widgets.Buttons.Enter is + + + type Enter_Button is new Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Enter_Button; + + +private + + + type Enter_Button is new Button with null record; + + + overriding procedure Finalize (This : in out Enter_Button); + + +end FLTK.Widgets.Buttons.Enter; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-check.adb b/src/fltk_binding/fltk-widgets-buttons-light-check.adb new file mode 100644 index 0000000..319db9f --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-check.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Check is + + + function new_fl_check_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_check_button, "new_fl_check_button"); + + procedure free_fl_check_button + (B : in System.Address); + pragma Import (C, free_fl_check_button, "free_fl_check_button"); + + + + + procedure Finalize (This : in out Check_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_check_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Check_Button is + + VP : System.Address; + + begin + VP := new_fl_check_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-check.ads b/src/fltk_binding/fltk-widgets-buttons-light-check.ads new file mode 100644 index 0000000..77ac0e6 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-check.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Light.Check is + + + type Check_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Check_Button; + + +private + + + type Check_Button is new Light_Button with null record; + + + overriding procedure Finalize (This : in out Check_Button); + + +end FLTK.Widgets.Buttons.Light.Check; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-radio.adb b/src/fltk_binding/fltk-widgets-buttons-light-radio.adb new file mode 100644 index 0000000..779b612 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-radio.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Radio is + + + function new_fl_radio_light_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); + + procedure free_fl_radio_light_button + (B : in System.Address); + pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); + + + + + procedure Finalize (This : in out Radio_Light_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_radio_light_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Light_Button is + + VP : System.Address; + + begin + VP := new_fl_radio_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-radio.ads b/src/fltk_binding/fltk-widgets-buttons-light-radio.ads new file mode 100644 index 0000000..2fef2ab --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-radio.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Light.Radio is + + + type Radio_Light_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Light_Button; + + +private + + + type Radio_Light_Button is new Light_Button with null record; + + + overriding procedure Finalize (This : in out Radio_Light_Button); + + +end FLTK.Widgets.Buttons.Light.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb new file mode 100644 index 0000000..5852581 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round.Radio is + + + function new_fl_radio_round_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); + + procedure free_fl_radio_round_button + (B : in System.Address); + pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); + + + + + procedure Finalize (This : in out Radio_Round_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_radio_round_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Round_Button is + + VP : System.Address; + + begin + VP := new_fl_radio_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads new file mode 100644 index 0000000..666f944 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-round-radio.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Light.Round.Radio is + + + type Radio_Round_Button is new Round_Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Round_Button; + + +private + + + type Radio_Round_Button is new Round_Button with null record; + + + overriding procedure Finalize (This : in out Radio_Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round.adb b/src/fltk_binding/fltk-widgets-buttons-light-round.adb new file mode 100644 index 0000000..a9510ab --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-round.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light.Round is + + + function new_fl_round_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_round_button, "new_fl_round_button"); + + procedure free_fl_round_button + (B : in System.Address); + pragma Import (C, free_fl_round_button, "free_fl_round_button"); + + + + + procedure Finalize (This : in out Round_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_round_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Round_Button is + + VP : System.Address; + + begin + VP := new_fl_round_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light-round.ads b/src/fltk_binding/fltk-widgets-buttons-light-round.ads new file mode 100644 index 0000000..18d72d0 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light-round.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Light.Round is + + + type Round_Button is new Light_Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Round_Button; + + +private + + + type Round_Button is new Light_Button with null record; + + + overriding procedure Finalize (This : in out Round_Button); + + +end FLTK.Widgets.Buttons.Light.Round; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light.adb b/src/fltk_binding/fltk-widgets-buttons-light.adb new file mode 100644 index 0000000..f31f3a9 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Light is + + + function new_fl_light_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_light_button, "new_fl_light_button"); + + procedure free_fl_light_button + (B : in System.Address); + pragma Import (C, free_fl_light_button, "free_fl_light_button"); + + + + + procedure Finalize (This : in out Light_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_light_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Light_Button is + + VP : System.Address; + + begin + VP := new_fl_light_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk_binding/fltk-widgets-buttons-light.ads b/src/fltk_binding/fltk-widgets-buttons-light.ads new file mode 100644 index 0000000..d0c733d --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-light.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Light is + + + type Light_Button is new Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Light_Button; + + +private + + + type Light_Button is new Button with null record; + + + overriding procedure Finalize (This : in out Light_Button); + + +end FLTK.Widgets.Buttons.Light; + diff --git a/src/fltk_binding/fltk-widgets-buttons-radio.adb b/src/fltk_binding/fltk-widgets-buttons-radio.adb new file mode 100644 index 0000000..cd8d1ce --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-radio.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Radio is + + + function new_fl_radio_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); + + procedure free_fl_radio_button + (B : in System.Address); + pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); + + + + + procedure Finalize (This : in out Radio_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_radio_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Button is + + VP : System.Address; + + begin + VP := new_fl_radio_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-radio.ads b/src/fltk_binding/fltk-widgets-buttons-radio.ads new file mode 100644 index 0000000..3681e05 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-radio.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Radio is + + + type Radio_Button is new Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Radio_Button; + + +private + + + type Radio_Button is new Button with null record; + + + overriding procedure Finalize (This : in out Radio_Button); + + +end FLTK.Widgets.Buttons.Radio; + diff --git a/src/fltk_binding/fltk-widgets-buttons-repeat.adb b/src/fltk_binding/fltk-widgets-buttons-repeat.adb new file mode 100644 index 0000000..66e3e3d --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-repeat.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Repeat is + + + function new_fl_repeat_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); + + procedure free_fl_repeat_button + (B : in System.Address); + pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); + + + + + procedure Finalize (This : in out Repeat_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_repeat_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Repeat_Button is + + VP : System.Address; + + begin + VP := new_fl_repeat_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk_binding/fltk-widgets-buttons-repeat.ads b/src/fltk_binding/fltk-widgets-buttons-repeat.ads new file mode 100644 index 0000000..277a783 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-repeat.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Repeat is + + + type Repeat_Button is new Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Repeat_Button; + + +private + + + type Repeat_Button is new Button with null record; + + + overriding procedure Finalize (This : in out Repeat_Button); + + +end FLTK.Widgets.Buttons.Repeat; + diff --git a/src/fltk_binding/fltk-widgets-buttons-toggle.adb b/src/fltk_binding/fltk-widgets-buttons-toggle.adb new file mode 100644 index 0000000..1347845 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-toggle.adb @@ -0,0 +1,53 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons.Toggle is + + + function new_fl_toggle_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); + + procedure free_fl_toggle_button + (B : in System.Address); + pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); + + + + + procedure Finalize (This : in out Toggle_Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_toggle_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Toggle_Button is + + VP : System.Address; + + begin + VP := new_fl_toggle_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk_binding/fltk-widgets-buttons-toggle.ads b/src/fltk_binding/fltk-widgets-buttons-toggle.ads new file mode 100644 index 0000000..7f99872 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons-toggle.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Buttons.Toggle is + + + type Toggle_Button is new Button with private; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Toggle_Button; + + +private + + + type Toggle_Button is new Button with null record; + + + overriding procedure Finalize (This : in out Toggle_Button); + + +end FLTK.Widgets.Buttons.Toggle; + diff --git a/src/fltk_binding/fltk-widgets-buttons.adb b/src/fltk_binding/fltk-widgets-buttons.adb new file mode 100644 index 0000000..504c73f --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons.adb @@ -0,0 +1,96 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Buttons is + + + function new_fl_button + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_button, "new_fl_button"); + + procedure free_fl_button + (B : in System.Address); + pragma Import (C, free_fl_button, "free_fl_button"); + + function fl_button_get_state + (B : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_button_get_state, "fl_button_get_state"); + + procedure fl_button_set_state + (B : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_button_set_state, "fl_button_set_state"); + + procedure fl_button_set_only + (B : in System.Address); + pragma Import (C, fl_button_set_only, "fl_button_set_only"); + + + + + procedure Finalize (This : in out Button) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_button (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Button is + + VP : System.Address; + + begin + VP := new_fl_button + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + function Get_State + (B : in Button'Class) + return State is + begin + return State'Val (fl_button_get_state (B.Void_Ptr)); + end Get_State; + + + + + procedure Set_State + (B : in Button'Class; + S : in State) is + begin + fl_button_set_state (B.Void_Ptr, State'Pos (S)); + end Set_State; + + + + + procedure Set_Only + (B : in Button'Class) is + begin + fl_button_set_only (B.Void_Ptr); + end Set_Only; + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk_binding/fltk-widgets-buttons.ads b/src/fltk_binding/fltk-widgets-buttons.ads new file mode 100644 index 0000000..63329b8 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-buttons.ads @@ -0,0 +1,40 @@ + + +package FLTK.Widgets.Buttons is + + + type Button is new Widget with private; + type State is (On, Off); + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Button; + + + function Get_State + (B : in Button'Class) + return State; + + + procedure Set_State + (B : in Button'Class; + S : in State); + + + procedure Set_Only + (B : in Button'Class); + + +private + + + type Button is new Widget with null record; + + + overriding procedure Finalize (This : in out Button); + + +end FLTK.Widgets.Buttons; + diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.adb b/src/fltk_binding/fltk-widgets-groups-text_displays.adb new file mode 100644 index 0000000..8d08fbb --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.adb @@ -0,0 +1,151 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Text_Displays is + + + function new_fl_text_display + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_text_display, "new_fl_text_display"); + + procedure free_fl_text_display + (TD : in System.Address); + pragma Import (C, free_fl_text_display, "free_fl_text_display"); + + function fl_text_display_get_text_color + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); + + procedure fl_text_display_set_text_color + (TD : in System.Address; + C : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); + + function fl_text_display_get_text_font + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); + + procedure fl_text_display_set_text_font + (TD : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); + + function fl_text_display_get_text_size + (TD : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); + + procedure fl_text_display_set_text_size + (TD : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); + + + + + procedure fl_group_end + (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + + + + procedure Finalize (This : in out Text_Display) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_text_display (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Label : in String) + return Text_Display is + + VP : System.Address; + + begin + VP := new_fl_text_display + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + function Get_Text_Color + (TD : in Text_Display) + return Color is + begin + return Color (fl_text_display_get_text_color (TD.Void_Ptr)); + end Get_Text_Color; + + + + + procedure Set_Text_Color + (TD : in Text_Display; + C : in Color) is + begin + fl_text_display_set_text_color (TD.Void_Ptr, Interfaces.C.int (C)); + end Set_Text_Color; + + + + + function Get_Text_Font + (TD : in Text_Display) + return Font_Kind is + begin + return Font_Kind'Val (fl_text_display_get_text_font (TD.Void_Ptr)); + end Get_Text_Font; + + + + + procedure Set_Text_Font + (TD : in Text_Display; + F : in Font_Kind) is + begin + fl_text_display_set_text_font (TD.Void_Ptr, Font_Kind'Pos (F)); + end Set_Text_Font; + + + + + function Get_Text_Size + (TD : in Text_Display) + return Font_Size is + begin + return Font_Size (fl_text_display_get_text_size (TD.Void_Ptr)); + end Get_Text_Size; + + + + + procedure Set_Text_Size + (TD : in Text_Display; + S : in Font_Size) is + begin + fl_text_display_set_text_size (TD.Void_Ptr, Interfaces.C.int (S)); + end Set_Text_Size; + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk_binding/fltk-widgets-groups-text_displays.ads b/src/fltk_binding/fltk-widgets-groups-text_displays.ads new file mode 100644 index 0000000..e5391d1 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-text_displays.ads @@ -0,0 +1,58 @@ + + +with FLTK.Enums; use FLTK.Enums; + + +package FLTK.Widgets.Groups.Text_Displays is + + + type Text_Display is new Group with private; + + + function Create + (X, Y, W, H : in Integer; + Label : in String) + return Text_Display; + + + function Get_Text_Color + (TD : in Text_Display) + return Color; + + + procedure Set_Text_Color + (TD : in Text_Display; + C : in Color); + + + function Get_Text_Font + (TD : in Text_Display) + return Font_Kind; + + + procedure Set_Text_Font + (TD : in Text_Display; + F : in Font_Kind); + + + function Get_Text_Size + (TD : in Text_Display) + return Font_Size; + + + procedure Set_Text_Size + (TD : in Text_Display; + S : in Font_Size); + + +private + + + type Text_Display is new Group with null record; + + + overriding procedure Finalize (This : in out Text_Display); + + +end FLTK.Widgets.Groups.Text_Displays; + diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.adb b/src/fltk_binding/fltk-widgets-groups-windows-double.adb new file mode 100644 index 0000000..4d46d7e --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.adb @@ -0,0 +1,95 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows.Double is + + + function new_fl_double_window + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_double_window, "new_fl_double_window"); + + function new_fl_double_window2 + (X, Y : in Interfaces.C.int) + return System.Address; + pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); + + procedure free_fl_double_window + (W : in System.Address); + pragma Import (C, free_fl_double_window, "free_fl_double_window"); + + procedure fl_double_window_show + (W : in System.Address); + pragma Import (C, fl_double_window_show, "fl_double_window_show"); + + + + + procedure fl_group_end (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + + + + procedure Finalize (This : in out Double_Window) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_double_window (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Double_Window is + + VP : System.Address; + + begin + VP := new_fl_double_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + function Create + (W, H : in Integer) + return Double_Window is + + VP : System.Address; + + begin + VP := new_fl_double_window2 + (Interfaces.C.int (W), + Interfaces.C.int (H)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + procedure Show + (W : in Double_Window) is + begin + fl_double_window_show (W.Void_Ptr); + end Show; + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk_binding/fltk-widgets-groups-windows-double.ads b/src/fltk_binding/fltk-widgets-groups-windows-double.ads new file mode 100644 index 0000000..6876508 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-windows-double.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Groups.Windows.Double is + + + type Double_Window is new Window with private; + + + function Create (X, Y, W, H : Integer; Label : String) return Double_Window; + function Create (W, H : in Integer) return Double_Window; + + procedure Show (W : in Double_Window); + + +private + + + type Double_Window is new Window with null record; + + + overriding procedure Finalize (This : in out Double_Window); + + +end FLTK.Widgets.Groups.Windows.Double; + diff --git a/src/fltk_binding/fltk-widgets-groups-windows.adb b/src/fltk_binding/fltk-widgets-groups-windows.adb new file mode 100644 index 0000000..c304521 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-windows.adb @@ -0,0 +1,86 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups.Windows is + + + function new_fl_window + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_window, "new_fl_window"); + + function new_fl_window2 (W, H : in Interfaces.C.int) return System.Address; + pragma Import (C, new_fl_window2, "new_fl_window2"); + + procedure free_fl_window (W : in System.Address); + pragma Import (C, free_fl_window, "free_fl_window"); + + procedure fl_window_show (W : in System.Address); + pragma Import (C, fl_window_show, "fl_window_show"); + + + + + procedure fl_group_end (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + + + + procedure Finalize (This : in out Window) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_window (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Window is + + VP : System.Address; + + begin + + VP := new_fl_window + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + + end Create; + + + + + function Create (W, H : in Integer) return Window is + VP : System.Address; + begin + VP := new_fl_window2 (Interfaces.C.int (W), Interfaces.C.int (H)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + procedure Show (W : in Window) is + begin + fl_window_show (W.Void_Ptr); + end Show; + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk_binding/fltk-widgets-groups-windows.ads b/src/fltk_binding/fltk-widgets-groups-windows.ads new file mode 100644 index 0000000..69d2df4 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups-windows.ads @@ -0,0 +1,25 @@ + + +package FLTK.Widgets.Groups.Windows is + + + type Window is new Group with private; + + + function Create (X, Y, W, H : Integer; Label : String) return Window; + function Create (W, H : in Integer) return Window; + + procedure Show (W : in Window); + + +private + + + type Window is new Group with null record; + + + overriding procedure Finalize (This : in out Window); + + +end FLTK.Widgets.Groups.Windows; + diff --git a/src/fltk_binding/fltk-widgets-groups.adb b/src/fltk_binding/fltk-widgets-groups.adb new file mode 100644 index 0000000..b3322b7 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups.adb @@ -0,0 +1,149 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Groups is + + + function new_fl_group + (X, Y, W, H : in Interfaces.C.int; + L : in Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_group, "new_fl_group"); + + procedure free_fl_group + (G : in System.Address); + pragma Import (C, free_fl_group, "free_fl_group"); + + procedure fl_group_end + (G : in System.Address); + pragma Import (C, fl_group_end, "fl_group_end"); + + procedure fl_group_add + (G, W : in System.Address); + pragma Import (C, fl_group_add, "fl_group_add"); + + procedure fl_group_clear + (G : in System.Address); + pragma Import (C, fl_group_clear, "fl_group_clear"); + + function fl_group_find + (G, W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_group_find, "fl_group_find"); + + procedure fl_group_insert + (G, W : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_insert, "fl_group_insert"); + + procedure fl_group_remove + (G, W : in System.Address); + pragma Import (C, fl_group_remove, "fl_group_remove"); + + procedure fl_group_remove2 + (G : in System.Address; + P : in Interfaces.C.int); + pragma Import (C, fl_group_remove2, "fl_group_remove2"); + + + + + procedure Finalize (This : in out Group) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_group (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create + (X, Y, W, H : in Integer; + Label : in String) + return Group is + + VP : System.Address; + + begin + VP := new_fl_group + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + fl_group_end (VP); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + + + + procedure Add + (This : Group'Class; + Item : Widget'Class) is + begin + fl_group_add (This.Void_Ptr, Item.Void_Ptr); + end Add; + + + + + procedure Clear + (This : Group'Class) is + begin + fl_group_clear (This.Void_Ptr); + end Clear; + + + + + function Find + (This : Group'Class; + Item : Widget'Class) + return Index is + begin + return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr)); + end Find; + + + + + procedure Insert + (This : Group'Class; + Item : Widget'Class; + Place : Index) is + begin + fl_group_insert + (This.Void_Ptr, + Item.Void_Ptr, + Interfaces.C.int (Place)); + end Insert; + + + + + procedure Remove + (This : Group'Class; + Item : Widget'Class) is + begin + fl_group_remove (This.Void_Ptr, Item.Void_Ptr); + end Remove; + + + + + procedure Remove + (This : Group'Class; + Place : Index) is + begin + fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place)); + end Remove; + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk_binding/fltk-widgets-groups.ads b/src/fltk_binding/fltk-widgets-groups.ads new file mode 100644 index 0000000..bf4891f --- /dev/null +++ b/src/fltk_binding/fltk-widgets-groups.ads @@ -0,0 +1,57 @@ + + +package FLTK.Widgets.Groups is + + + type Group is new Widget with private; + type Index is new Integer; + + + function Create + (X, Y, W, H : Integer; + Label : String) + return Group; + + + procedure Add + (This : Group'Class; + Item : Widget'Class); + + + procedure Clear + (This : Group'Class); + + + function Find + (This : Group'Class; + Item : Widget'Class) + return Index; + + + procedure Insert + (This : Group'Class; + Item : Widget'Class; + Place : Index); + + + procedure Remove + (This : Group'Class; + Item : Widget'Class); + + + procedure Remove + (This : Group'Class; + Place : Index); + + +private + + + type Group is new Widget with null record; + + + overriding procedure Finalize (This : in out Group); + + +end FLTK.Widgets.Groups; + diff --git a/src/fltk_binding/fltk-widgets-inputs.adb b/src/fltk_binding/fltk-widgets-inputs.adb new file mode 100644 index 0000000..436ef36 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-inputs.adb @@ -0,0 +1,47 @@ + + +with Interfaces.C; +with System; +use type System.Address; + + +package body FLTK.Widgets.Inputs is + + + function new_fl_input + (X, Y, W, H : Interfaces.C.int; + L : Interfaces.C.char_array) + return System.Address; + pragma Import (C, new_fl_input, "new_fl_input"); + + procedure free_fl_input (F : in System.Address); + pragma Import (C, free_fl_input, "free_fl_input"); + + + + + procedure Finalize (This : in out Input) is + begin + if (This.Void_Ptr /= System.Null_Address) then + free_fl_input (This.Void_Ptr); + end if; + end Finalize; + + + + + function Create (X, Y, W, H : Integer; Label : String) return Input is + VP : System.Address; + begin + VP := new_fl_input + (Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.To_C (Label)); + return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP); + end Create; + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk_binding/fltk-widgets-inputs.ads b/src/fltk_binding/fltk-widgets-inputs.ads new file mode 100644 index 0000000..e0661f1 --- /dev/null +++ b/src/fltk_binding/fltk-widgets-inputs.ads @@ -0,0 +1,22 @@ + + +package FLTK.Widgets.Inputs is + + + type Input is new Widget with private; + + + function Create (X, Y, W, H : Integer; Label : String) return Input; + + +private + + + type Input is new Widget with null record; + + + overriding procedure Finalize (This : in out Input); + + +end FLTK.Widgets.Inputs; + diff --git a/src/fltk_binding/fltk-widgets.adb b/src/fltk_binding/fltk-widgets.adb new file mode 100644 index 0000000..cd91841 --- /dev/null +++ b/src/fltk_binding/fltk-widgets.adb @@ -0,0 +1,140 @@ + + +with Interfaces.C; +with System; + + +package body FLTK.Widgets is + + + function fl_widget_get_box + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); + + procedure fl_widget_set_box + (W : in System.Address; + B : in Interfaces.C.int); + pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); + + function fl_widget_get_label_font + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_font, "fl_widget_get_label_font"); + + procedure fl_widget_set_label_font + (W : in System.Address; + F : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_font, "fl_widget_set_label_font"); + + function fl_widget_get_label_size + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_size, "fl_widget_get_label_size"); + + procedure fl_widget_set_label_size + (W : in System.Address; + S : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_size, "fl_widget_set_label_size"); + + function fl_widget_get_label_type + (W : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_get_label_type, "fl_widget_get_label_type"); + + procedure fl_widget_set_label_type + (W : in System.Address; + L : in Interfaces.C.int); + pragma Import (C, fl_widget_set_label_type, "fl_widget_set_label_type"); + + + + + procedure Initialize (This : in out Widget) is + begin + This.Void_Ptr := System.Null_Address; + end Initialize; + + + + + function Get_Box + (W : in Widget'Class) + return Box_Kind is + begin + return Box_Kind'Val (fl_widget_get_box (W.Void_Ptr)); + end Get_Box; + + + + + procedure Set_Box + (W : in Widget'Class; + B : in Box_Kind) is + begin + fl_widget_set_box (W.Void_Ptr, Box_Kind'Pos (B)); + end Set_Box; + + + + + function Get_Label_Font + (W : in Widget'Class) + return Font_Kind is + begin + return Font_Kind'Val (fl_widget_get_label_font (W.Void_Ptr)); + end Get_Label_Font; + + + + + procedure Set_Label_Font + (W : in Widget'Class; + F : in Font_Kind) is + begin + fl_widget_set_label_font (W.Void_Ptr, Font_Kind'Pos (F)); + end Set_Label_Font; + + + + + function Get_Label_Size + (W : in Widget'Class) + return Font_Size is + begin + return Font_Size (fl_widget_get_label_size (W.Void_Ptr)); + end Get_Label_Size; + + + + + procedure Set_Label_Size + (W : in Widget'Class; + S : in Font_Size) is + begin + fl_widget_set_label_size (W.Void_Ptr, Interfaces.C.int (S)); + end Set_Label_Size; + + + + + function Get_Label_Type + (W : in Widget'Class) + return Label_Kind is + begin + return Label_Kind'Val (fl_widget_get_label_type (W.Void_Ptr)); + end Get_Label_Type; + + + + + procedure Set_Label_Type + (W : in Widget'Class; + L : in Label_Kind) is + begin + fl_widget_set_label_type (W.Void_Ptr, Label_Kind'Pos (L)); + end Set_Label_Type; + + +end FLTK.Widgets; + diff --git a/src/fltk_binding/fltk-widgets.ads b/src/fltk_binding/fltk-widgets.ads new file mode 100644 index 0000000..3cbef76 --- /dev/null +++ b/src/fltk_binding/fltk-widgets.ads @@ -0,0 +1,80 @@ + + +with FLTK.Enums; use FLTK.Enums; +with Ada.Finalization; +private with System; + + +package FLTK.Widgets is + + + type Widget is abstract new Ada.Finalization.Limited_Controlled with private; + + + type Font_Size is new Natural; + Normal_Size : constant Font_Size := 14; + + + type Color is new Natural; + + + function Create + (X, Y, W, H : in Integer; + Label : in String) + return Widget is abstract; + + + function Get_Box + (W : in Widget'Class) + return Box_Kind; + + + procedure Set_Box + (W : in Widget'Class; + B : in Box_Kind); + + + function Get_Label_Font + (W : in Widget'Class) + return Font_Kind; + + + procedure Set_Label_Font + (W : in Widget'Class; + F : in Font_Kind); + + + function Get_Label_Size + (W : in Widget'Class) + return Font_Size; + + + procedure Set_Label_Size + (W : in Widget'Class; + S : in Font_Size); + + + function Get_Label_Type + (W : in Widget'Class) + return Label_Kind; + + + procedure Set_Label_Type + (W : in Widget'Class; + L : in Label_Kind); + + +private + + + type Widget is abstract new Ada.Finalization.Limited_Controlled with + record + Void_Ptr : System.Address; + end record; + + + overriding procedure Initialize (This : in out Widget); + + +end FLTK.Widgets; + -- cgit