diff options
Diffstat (limited to 'src')
47 files changed, 1208 insertions, 13 deletions
diff --git a/src/adapad.adb b/src/adapad.adb index b9fc616..a2fe4c5 100644 --- a/src/adapad.adb +++ b/src/adapad.adb @@ -2,9 +2,7 @@ -- with Editor; with FLTK.Widget.Group.Window.Double; -with FLTK.Widget.Button; with FLTK.Widget.Box; -with FLTK.Widget.Input; with FLTK.Enums; use FLTK.Enums; @@ -13,13 +11,15 @@ function AdaPad return Integer is package Dbl renames FLTK.Widget.Group.Window.Double; package Box renames FLTK.Widget.Box; - W : Dbl.Double_Type := Dbl.Create (300, 300, 300, 300, "AdaPad"); - B : Box.Box_Type := Box.Create (100, 100, 100, 100, "Test"); + W : Dbl.Double_Type := Dbl.Create (340, 180); + B : Box.Box_Type := Box.Create (20, 40, 300, 100, "Test"); begin B.Set_Box (Engraved_Box); B.Set_Label_Font (Times_Bold_Italic); + B.Set_Label_Size (36); + B.Set_Label_Type (Shadow_Label); W.Add (B); W.Show; diff --git a/src/editor.ads b/src/editor.ads index fe98691..e80111a 100644 --- a/src/editor.ads +++ b/src/editor.ads @@ -2,6 +2,7 @@ with FLTK.Widget.Group.Window.Double; with FLTK.Widget.Input; +with FLTK.Widget.Button.Ret; package Editor is @@ -12,16 +13,29 @@ package Editor is 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 : access Window.Window_Type; - Replace_Find : access FLTK.Widget.Input.Input_Type; - Replace_With : access FLTK.Widget.Input.Input_Type; + 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/fltk_binding/c_fl_button.cpp b/src/fltk_binding/c_fl_button.cpp index 935a14b..dd4286e 100644 --- a/src/fltk_binding/c_fl_button.cpp +++ b/src/fltk_binding/c_fl_button.cpp @@ -14,3 +14,18 @@ void free_fl_button(my_fl_button f) { delete reinterpret_cast<Fl_Button*>(f); } + +int fl_button_get_state(my_fl_button b) { + return reinterpret_cast<Fl_Button*>(b)->value(); +} + + +void fl_button_set_state(my_fl_button b, int s) { + reinterpret_cast<Fl_Button*>(b)->value(s); +} + + +void fl_button_set_only(my_fl_button b) { + reinterpret_cast<Fl_Button*>(b)->setonly(); +} + diff --git a/src/fltk_binding/c_fl_button.h b/src/fltk_binding/c_fl_button.h index a83e3d8..21e18dc 100644 --- a/src/fltk_binding/c_fl_button.h +++ b/src/fltk_binding/c_fl_button.h @@ -10,6 +10,10 @@ typedef void* my_fl_button; extern "C" my_fl_button new_fl_button(int x, int y, int w, int h, char * label); extern "C" void free_fl_button(my_fl_button f); +extern "C" int fl_button_get_state(my_fl_button b); +extern "C" void fl_button_set_state(my_fl_button b, int s); +extern "C" void fl_button_set_only(my_fl_button b); + #endif diff --git a/src/fltk_binding/c_fl_check_button.cpp b/src/fltk_binding/c_fl_check_button.cpp new file mode 100644 index 0000000..2eafd0f --- /dev/null +++ b/src/fltk_binding/c_fl_check_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Check_Button.H> +#include "c_fl_check_button.h" + + +my_fl_check_button new_fl_check_button(int x, int y, int w, int h, char * label) { + Fl_Check_Button *button = new Fl_Check_Button(x, y, w, h, label); + return button; +} + + +void free_fl_check_button(my_fl_check_button b) { + delete reinterpret_cast<Fl_Check_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_check_button.h b/src/fltk_binding/c_fl_check_button.h new file mode 100644 index 0000000..23834df --- /dev/null +++ b/src/fltk_binding/c_fl_check_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_CHECK_BUTTON_GUARD +#define FL_CHECK_BUTTON_GUARD + + +typedef void* my_fl_check_button; + + +extern "C" my_fl_check_button new_fl_check_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_check_button(my_fl_check_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_light_button.cpp b/src/fltk_binding/c_fl_light_button.cpp new file mode 100644 index 0000000..31faff3 --- /dev/null +++ b/src/fltk_binding/c_fl_light_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Light_Button.H> +#include "c_fl_light_button.h" + + +my_fl_light_button new_fl_light_button(int x, int y, int w, int h, char * label) { + Fl_Light_Button *button = new Fl_Light_Button(x, y, w, h, label); + return button; +} + + +void free_fl_light_button(my_fl_light_button b) { + delete reinterpret_cast<Fl_Light_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_light_button.h b/src/fltk_binding/c_fl_light_button.h new file mode 100644 index 0000000..0aa8bd8 --- /dev/null +++ b/src/fltk_binding/c_fl_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_LIGHT_BUTTON_GUARD +#define FL_LIGHT_BUTTON_GUARD + + +typedef void* my_fl_light_button; + + +extern "C" my_fl_light_button new_fl_light_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_light_button(my_fl_light_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_radio_button.cpp b/src/fltk_binding/c_fl_radio_button.cpp new file mode 100644 index 0000000..56f16c9 --- /dev/null +++ b/src/fltk_binding/c_fl_radio_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Button.H> +#include "c_fl_radio_button.h" + + +my_fl_radio_button new_fl_radio_button(int x, int y, int w, int h, char * label) { + Fl_Radio_Button *button = new Fl_Radio_Button(x, y, w, h, label); + return button; +} + + +void free_fl_radio_button(my_fl_radio_button b) { + delete reinterpret_cast<Fl_Radio_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_radio_button.h b/src/fltk_binding/c_fl_radio_button.h new file mode 100644 index 0000000..06c3afc --- /dev/null +++ b/src/fltk_binding/c_fl_radio_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_BUTTON_GUARD +#define FL_RADIO_BUTTON_GUARD + + +typedef void* my_fl_radio_button; + + +extern "C" my_fl_radio_button new_fl_radio_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_radio_button(my_fl_radio_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_radio_light_button.cpp b/src/fltk_binding/c_fl_radio_light_button.cpp new file mode 100644 index 0000000..82fafd6 --- /dev/null +++ b/src/fltk_binding/c_fl_radio_light_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Light_Button.H> +#include "c_fl_radio_light_button.h" + + +my_fl_radio_light_button new_fl_radio_light_button(int x, int y, int w, int h, char * label) { + Fl_Radio_Light_Button *button = new Fl_Radio_Light_Button(x, y, w, h, label); + return button; +} + + +void free_fl_radio_light_button(my_fl_radio_light_button b) { + delete reinterpret_cast<Fl_Radio_Light_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_radio_light_button.h b/src/fltk_binding/c_fl_radio_light_button.h new file mode 100644 index 0000000..21bc675 --- /dev/null +++ b/src/fltk_binding/c_fl_radio_light_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_LIGHT_BUTTON_GUARD +#define FL_RADIO_LIGHT_BUTTON_GUARD + + +typedef void* my_fl_radio_light_button; + + +extern "C" my_fl_radio_light_button new_fl_radio_light_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_radio_light_button(my_fl_radio_light_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_radio_round_button.cpp b/src/fltk_binding/c_fl_radio_round_button.cpp new file mode 100644 index 0000000..9e7943c --- /dev/null +++ b/src/fltk_binding/c_fl_radio_round_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Radio_Round_Button.H> +#include "c_fl_radio_round_button.h" + + +my_fl_radio_round_button new_fl_radio_round_button(int x, int y, int w, int h, char * label) { + Fl_Radio_Round_Button *button = new Fl_Radio_Round_Button(x, y, w, h, label); + return button; +} + + +void free_fl_radio_round_button(my_fl_radio_round_button b) { + delete reinterpret_cast<Fl_Radio_Round_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_radio_round_button.h b/src/fltk_binding/c_fl_radio_round_button.h new file mode 100644 index 0000000..acf3936 --- /dev/null +++ b/src/fltk_binding/c_fl_radio_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RADIO_ROUND_BUTTON_GUARD +#define FL_RADIO_ROUND_BUTTON_GUARD + + +typedef void* my_fl_radio_round_button; + + +extern "C" my_fl_radio_round_button new_fl_radio_round_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_radio_round_button(my_fl_radio_round_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_repeat_button.cpp b/src/fltk_binding/c_fl_repeat_button.cpp new file mode 100644 index 0000000..d81f301 --- /dev/null +++ b/src/fltk_binding/c_fl_repeat_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Repeat_Button.H> +#include "c_fl_repeat_button.h" + + +my_fl_repeat_button new_fl_repeat_button(int x, int y, int w, int h, char * label) { + Fl_Repeat_Button *button = new Fl_Repeat_Button(x, y, w, h, label); + return button; +} + + +void free_fl_repeat_button(my_fl_repeat_button b) { + delete reinterpret_cast<Fl_Repeat_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_repeat_button.h b/src/fltk_binding/c_fl_repeat_button.h new file mode 100644 index 0000000..9712f41 --- /dev/null +++ b/src/fltk_binding/c_fl_repeat_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_REPEAT_BUTTON_GUARD +#define FL_REPEAT_BUTTON_GUARD + + +typedef void* my_fl_repeat_button; + + +extern "C" my_fl_repeat_button new_fl_repeat_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_repeat_button(my_fl_repeat_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_return_button.cpp b/src/fltk_binding/c_fl_return_button.cpp new file mode 100644 index 0000000..fb0ade2 --- /dev/null +++ b/src/fltk_binding/c_fl_return_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Return_Button.H> +#include "c_fl_return_button.h" + + +my_fl_return_button new_fl_return_button(int x, int y, int w, int h, char * label) { + Fl_Return_Button *button = new Fl_Return_Button(x, y, w, h, label); + return button; +} + + +void free_fl_return_button(my_fl_return_button b) { + delete reinterpret_cast<Fl_Return_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_return_button.h b/src/fltk_binding/c_fl_return_button.h new file mode 100644 index 0000000..84274af --- /dev/null +++ b/src/fltk_binding/c_fl_return_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_RETURN_BUTTON_GUARD +#define FL_RETURN_BUTTON_GUARD + + +typedef void* my_fl_return_button; + + +extern "C" my_fl_return_button new_fl_return_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_return_button(my_fl_return_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_round_button.cpp b/src/fltk_binding/c_fl_round_button.cpp new file mode 100644 index 0000000..aec7ada --- /dev/null +++ b/src/fltk_binding/c_fl_round_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Round_Button.H> +#include "c_fl_round_button.h" + + +my_fl_round_button new_fl_round_button(int x, int y, int w, int h, char * label) { + Fl_Round_Button *button = new Fl_Round_Button(x, y, w, h, label); + return button; +} + + +void free_fl_round_button(my_fl_round_button b) { + delete reinterpret_cast<Fl_Round_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_round_button.h b/src/fltk_binding/c_fl_round_button.h new file mode 100644 index 0000000..3cca483 --- /dev/null +++ b/src/fltk_binding/c_fl_round_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_ROUND_BUTTON_GUARD +#define FL_ROUND_BUTTON_GUARD + + +typedef void* my_fl_round_button; + + +extern "C" my_fl_round_button new_fl_round_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_round_button(my_fl_round_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_toggle_button.cpp b/src/fltk_binding/c_fl_toggle_button.cpp new file mode 100644 index 0000000..db89a86 --- /dev/null +++ b/src/fltk_binding/c_fl_toggle_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Toggle_Button.H> +#include "c_fl_toggle_button.h" + + +my_fl_toggle_button new_fl_toggle_button(int x, int y, int w, int h, char * label) { + Fl_Toggle_Button *button = new Fl_Toggle_Button(x, y, w, h, label); + return button; +} + + +void free_fl_toggle_button(my_fl_toggle_button b) { + delete reinterpret_cast<Fl_Toggle_Button*>(b); +} + diff --git a/src/fltk_binding/c_fl_toggle_button.h b/src/fltk_binding/c_fl_toggle_button.h new file mode 100644 index 0000000..a5d7f13 --- /dev/null +++ b/src/fltk_binding/c_fl_toggle_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_TOGGLE_BUTTON_GUARD +#define FL_TOGGLE_BUTTON_GUARD + + +typedef void* my_fl_toggle_button; + + +extern "C" my_fl_toggle_button new_fl_toggle_button(int x, int y, int w, int h, char * label); +extern "C" void free_fl_toggle_button(my_fl_toggle_button b); + + +#endif + diff --git a/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp index cf99c41..8a9e897 100644 --- a/src/fltk_binding/c_fl_widget.cpp +++ b/src/fltk_binding/c_fl_widget.cpp @@ -23,3 +23,23 @@ void fl_widget_set_label_font(my_fl_widget w, int f) { reinterpret_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f)); } + +int fl_widget_get_label_size(my_fl_widget w) { + return reinterpret_cast<Fl_Widget*>(w)->labelsize(); +} + + +void fl_widget_set_label_size(my_fl_widget w, int s) { + reinterpret_cast<Fl_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s)); +} + + +int fl_widget_get_label_type(my_fl_widget w) { + return reinterpret_cast<Fl_Widget*>(w)->labeltype(); +} + + +void fl_widget_set_label_type(my_fl_widget w, int l) { + reinterpret_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l)); +} + diff --git a/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h index 40d22f3..9fb5385 100644 --- a/src/fltk_binding/c_fl_widget.h +++ b/src/fltk_binding/c_fl_widget.h @@ -11,6 +11,10 @@ extern "C" int fl_widget_get_box(my_fl_widget w); extern "C" void fl_widget_set_box(my_fl_widget w, int b); extern "C" int fl_widget_get_label_font(my_fl_widget w); extern "C" void fl_widget_set_label_font(my_fl_widget w, int f); +extern "C" int fl_widget_get_label_size(my_fl_widget w); +extern "C" void fl_widget_set_label_size(my_fl_widget w, int s); +extern "C" int fl_widget_get_label_type(my_fl_widget w); +extern "C" void fl_widget_set_label_type(my_fl_widget w, int l); #endif diff --git a/src/fltk_binding/fltk-enums.ads b/src/fltk_binding/fltk-enums.ads index da4920d..00a56c2 100644 --- a/src/fltk_binding/fltk-enums.ads +++ b/src/fltk_binding/fltk-enums.ads @@ -83,5 +83,17 @@ package FLTK.Enums is Free_Font); + type Label_Kind is + (Normal_Label, + No_Label, + Shadow_Label, + Engraved_Label, + Embossed_Label, + Multi_Label, + Icon_Label, + Image_Label, + Free_Label); + + end FLTK.Enums; diff --git a/src/fltk_binding/fltk-widget-button-light-check.adb b/src/fltk_binding/fltk-widget-button-light-check.adb new file mode 100644 index 0000000..0be477e --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-check.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..14eab60 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-check.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..d3a5e48 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-radio.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..bf78d65 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-radio.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..d3a857d --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-round-radio.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..c0e4f38 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-round-radio.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..bda70f4 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-round.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..e440b1a --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light-round.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..6f76890 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..bbc2c9e --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-light.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..4af17e4 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-radio.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..2c36c77 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-radio.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..3bdc52b --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-repeat.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..d7cd383 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-repeat.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..8f68341 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-ret.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..ed0da3c --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-ret.ads @@ -0,0 +1,26 @@ + + +-- 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 new file mode 100644 index 0000000..3bd692c --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-toggle.adb @@ -0,0 +1,53 @@ + + +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 new file mode 100644 index 0000000..e9d185e --- /dev/null +++ b/src/fltk_binding/fltk-widget-button-toggle.ads @@ -0,0 +1,25 @@ + + +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 index 8ec03ce..238e761 100644 --- a/src/fltk_binding/fltk-widget-button.adb +++ b/src/fltk_binding/fltk-widget-button.adb @@ -14,9 +14,24 @@ package body FLTK.Widget.Button is return System.Address; pragma Import (C, new_fl_button, "new_fl_button"); - procedure free_fl_button (B : in System.Address); + 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"); + @@ -38,7 +53,6 @@ package body FLTK.Widget.Button is VP : System.Address; begin - VP := new_fl_button (Interfaces.C.int (X), Interfaces.C.int (Y), @@ -46,9 +60,37 @@ package body FLTK.Widget.Button is 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 index 8212fe3..14762bf 100644 --- a/src/fltk_binding/fltk-widget-button.ads +++ b/src/fltk_binding/fltk-widget-button.ads @@ -4,9 +4,27 @@ 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 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 diff --git a/src/fltk_binding/fltk-widget.adb b/src/fltk_binding/fltk-widget.adb index 7f3edd6..a19969f 100644 --- a/src/fltk_binding/fltk-widget.adb +++ b/src/fltk_binding/fltk-widget.adb @@ -27,6 +27,26 @@ package body FLTK.Widget is 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"); + @@ -76,5 +96,45 @@ package body FLTK.Widget is 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 index 1e56c4f..a8b2b27 100644 --- a/src/fltk_binding/fltk-widget.ads +++ b/src/fltk_binding/fltk-widget.ads @@ -1,14 +1,18 @@ with FLTK.Enums; use FLTK.Enums; -private with Ada.Finalization; +with Ada.Finalization; private with System; package FLTK.Widget is - type Widget_Type is abstract tagged limited private; + type Widget_Type is abstract new Ada.Finalization.Limited_Controlled with private; + + + type Font_Size is new Natural; + Normal_Size : constant Font_Size := 14; function Create @@ -37,6 +41,26 @@ package FLTK.Widget is 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 |