diff options
Diffstat (limited to 'src')
36 files changed, 1293 insertions, 0 deletions
diff --git a/src/adapad.adb b/src/adapad.adb new file mode 100644 index 0000000..b9fc616 --- /dev/null +++ b/src/adapad.adb @@ -0,0 +1,29 @@ + + +-- 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; + + +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"); + +begin + + B.Set_Box (Engraved_Box); + B.Set_Label_Font (Times_Bold_Italic); + W.Add (B); + + W.Show; + return FLTK.Run; + +end AdaPad; + diff --git a/src/editor.ads b/src/editor.ads new file mode 100644 index 0000000..fe98691 --- /dev/null +++ b/src/editor.ads @@ -0,0 +1,27 @@ + + +with FLTK.Widget.Group.Window.Double; +with FLTK.Widget.Input; + + +package Editor is + + + package Window renames FLTK.Widget.Group.Window; + + type Editor_Type is new Window.Double.Double_Type with private; + + +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; + end record; + + +end Editor; + diff --git a/src/fltk_binding/c_fl.cpp b/src/fltk_binding/c_fl.cpp new file mode 100644 index 0000000..b628c41 --- /dev/null +++ b/src/fltk_binding/c_fl.cpp @@ -0,0 +1,10 @@ + + +#include <FL/Fl.H> +#include "c_fl.h" + + +int fl_run(void) { + return Fl::run(); +} + diff --git a/src/fltk_binding/c_fl.h b/src/fltk_binding/c_fl.h new file mode 100644 index 0000000..69e2e72 --- /dev/null +++ b/src/fltk_binding/c_fl.h @@ -0,0 +1,11 @@ + + +#ifndef FL_GUARD +#define FL_GUARD + + +extern "C" int fl_run(void); + + +#endif + diff --git a/src/fltk_binding/c_fl_box.cpp b/src/fltk_binding/c_fl_box.cpp new file mode 100644 index 0000000..01685f8 --- /dev/null +++ b/src/fltk_binding/c_fl_box.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Box.H> +#include "c_fl_box.h" + + +my_fl_box new_fl_box(int x, int y, int w, int h, char * label) { + Fl_Box *box = new Fl_Box(x, y, w, h, label); + return box; +} + + +void free_fl_box(my_fl_box f) { + delete reinterpret_cast<Fl_Box*>(f); +} + diff --git a/src/fltk_binding/c_fl_box.h b/src/fltk_binding/c_fl_box.h new file mode 100644 index 0000000..e21f875 --- /dev/null +++ b/src/fltk_binding/c_fl_box.h @@ -0,0 +1,15 @@ + + +#ifndef FL_BOX_GUARD +#define FL_BOX_GUARD + + +typedef void* my_fl_box; + + +extern "C" my_fl_box new_fl_box(int x, int y, int w, int h, char * label); +extern "C" void free_fl_box(my_fl_box f); + + +#endif + diff --git a/src/fltk_binding/c_fl_button.cpp b/src/fltk_binding/c_fl_button.cpp new file mode 100644 index 0000000..935a14b --- /dev/null +++ b/src/fltk_binding/c_fl_button.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Button.H> +#include "c_fl_button.h" + + +my_fl_button new_fl_button(int x, int y, int w, int h, char * label) { + Fl_Button *button = new Fl_Button(x, y, w, h, label); + return button; +} + + +void free_fl_button(my_fl_button f) { + delete reinterpret_cast<Fl_Button*>(f); +} + diff --git a/src/fltk_binding/c_fl_button.h b/src/fltk_binding/c_fl_button.h new file mode 100644 index 0000000..a83e3d8 --- /dev/null +++ b/src/fltk_binding/c_fl_button.h @@ -0,0 +1,15 @@ + + +#ifndef FL_BUTTON_GUARD +#define FL_BUTTON_GUARD + + +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); + + +#endif + diff --git a/src/fltk_binding/c_fl_double_window.cpp b/src/fltk_binding/c_fl_double_window.cpp new file mode 100644 index 0000000..7a9899c --- /dev/null +++ b/src/fltk_binding/c_fl_double_window.cpp @@ -0,0 +1,27 @@ + + +#include <FL/Fl_Double_Window.H> +#include "c_fl_double_window.h" + + +my_fl_double_window new_fl_double_window(int x, int y, int w, int h, char * label) { + Fl_Double_Window *window = new Fl_Double_Window(x, y, w, h, label); + return window; +} + + +my_fl_double_window new_fl_double_window2(int w, int h) { + Fl_Double_Window *window = new Fl_Double_Window(w, h); + return window; +} + + +void free_fl_double_window(my_fl_double_window f) { + delete reinterpret_cast<Fl_Double_Window*>(f); +} + + +void fl_double_window_show(my_fl_double_window f) { + reinterpret_cast<Fl_Double_Window*>(f)->show(); +} + diff --git a/src/fltk_binding/c_fl_double_window.h b/src/fltk_binding/c_fl_double_window.h new file mode 100644 index 0000000..eb6784d --- /dev/null +++ b/src/fltk_binding/c_fl_double_window.h @@ -0,0 +1,18 @@ + + +#ifndef FL_DOUBLE_WINDOW_GUARD +#define FL_DOUBLE_WINDOW_GUARD + + +typedef void* my_fl_double_window; + + +extern "C" my_fl_double_window new_fl_double_window(int x, int y, int w, int h, char * label); +extern "C" my_fl_double_window new_fl_double_window2(int w, int h); +extern "C" void free_fl_double_window(my_fl_double_window f); + +extern "C" void fl_double_window_show(my_fl_double_window f); + + +#endif + diff --git a/src/fltk_binding/c_fl_group.cpp b/src/fltk_binding/c_fl_group.cpp new file mode 100644 index 0000000..44aeb34 --- /dev/null +++ b/src/fltk_binding/c_fl_group.cpp @@ -0,0 +1,52 @@ + + +#include <FL/Fl_Group.H> +#include <FL/Fl_Widget.H> +#include "c_fl_group.h" + + +my_fl_group new_fl_group(int x, int y, int w, int h, char * label) { + Fl_Group *group = new Fl_Group(x, y, w, h, label); + return group; +} + + +void free_fl_group(my_fl_group f) { + delete reinterpret_cast<Fl_Group*>(f); +} + + +void fl_group_end(my_fl_group f) { + reinterpret_cast<Fl_Group*>(f)->end(); +} + + +void fl_group_add(my_fl_group f, void * item) { + reinterpret_cast<Fl_Group*>(f)->add(reinterpret_cast<Fl_Widget*>(item)); +} + + +void fl_group_clear(my_fl_group f) { + reinterpret_cast<Fl_Group*>(f)->clear(); +} + + +int fl_group_find(my_fl_group f, void * item) { + return reinterpret_cast<Fl_Group*>(f)->find(reinterpret_cast<Fl_Widget*>(item)); +} + + +void fl_group_insert(my_fl_group f, void * item, int place) { + reinterpret_cast<Fl_Group*>(f)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); +} + + +void fl_group_remove(my_fl_group f, void * item) { + reinterpret_cast<Fl_Group*>(f)->remove(reinterpret_cast<Fl_Widget*>(item)); +} + + +void fl_group_remove2(my_fl_group f, int place) { + reinterpret_cast<Fl_Group*>(f)->remove(place); +} + diff --git a/src/fltk_binding/c_fl_group.h b/src/fltk_binding/c_fl_group.h new file mode 100644 index 0000000..8fbd671 --- /dev/null +++ b/src/fltk_binding/c_fl_group.h @@ -0,0 +1,24 @@ + + +#ifndef FL_GROUP_GUARD +#define FL_GROUP_GUARD + + +typedef void* my_fl_group; + + +extern "C" my_fl_group new_fl_group(int x, int y, int w, int h, char * label); +extern "C" void free_fl_group(my_fl_group f); + +extern "C" void fl_group_end(my_fl_group f); + +extern "C" void fl_group_add(my_fl_group f, void * item); +extern "C" void fl_group_clear(my_fl_group f); +extern "C" int fl_group_find(my_fl_group f, void * item); +extern "C" void fl_group_insert(my_fl_group f, void * item, int place); +extern "C" void fl_group_remove(my_fl_group f, void * item); +extern "C" void fl_group_remove2(my_fl_group f, int place); + + +#endif + diff --git a/src/fltk_binding/c_fl_input.cpp b/src/fltk_binding/c_fl_input.cpp new file mode 100644 index 0000000..8504e56 --- /dev/null +++ b/src/fltk_binding/c_fl_input.cpp @@ -0,0 +1,16 @@ + + +#include <FL/Fl_Input.H> +#include "c_fl_input.h" + + +my_fl_input new_fl_input(int x, int y, int w, int h, char * label) { + Fl_Input *input = new Fl_Input(x, y, w, h, label); + return input; +} + + +void free_fl_input(my_fl_input f) { + delete reinterpret_cast<Fl_Input*>(f); +} + diff --git a/src/fltk_binding/c_fl_input.h b/src/fltk_binding/c_fl_input.h new file mode 100644 index 0000000..6cec6ec --- /dev/null +++ b/src/fltk_binding/c_fl_input.h @@ -0,0 +1,15 @@ + + +#ifndef FL_INPUT_GUARD +#define FL_INPUT_GUARD + + +typedef void* my_fl_input; + + +extern "C" my_fl_input new_fl_input(int x, int y, int w, int h, char * label); +extern "C" void free_fl_input(my_fl_input f); + + +#endif + diff --git a/src/fltk_binding/c_fl_widget.cpp b/src/fltk_binding/c_fl_widget.cpp new file mode 100644 index 0000000..cf99c41 --- /dev/null +++ b/src/fltk_binding/c_fl_widget.cpp @@ -0,0 +1,25 @@ + + +#include <FL/Fl_Widget.H> +#include "c_fl_widget.h" + + +int fl_widget_get_box(my_fl_widget w) { + return reinterpret_cast<Fl_Widget*>(w)->box(); +} + + +void fl_widget_set_box(my_fl_widget w, int b) { + reinterpret_cast<Fl_Widget*>(w)->box(static_cast<Fl_Boxtype>(b)); +} + + +int fl_widget_get_label_font(my_fl_widget w) { + return reinterpret_cast<Fl_Widget*>(w)->labelfont(); +} + + +void fl_widget_set_label_font(my_fl_widget w, int f) { + reinterpret_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f)); +} + diff --git a/src/fltk_binding/c_fl_widget.h b/src/fltk_binding/c_fl_widget.h new file mode 100644 index 0000000..40d22f3 --- /dev/null +++ b/src/fltk_binding/c_fl_widget.h @@ -0,0 +1,17 @@ + + +#ifndef FL_WIDGET_GUARD +#define FL_WIDGET_GUARD + + +typedef void* my_fl_widget; + + +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); + + +#endif + diff --git a/src/fltk_binding/c_fl_window.cpp b/src/fltk_binding/c_fl_window.cpp new file mode 100644 index 0000000..64a1c38 --- /dev/null +++ b/src/fltk_binding/c_fl_window.cpp @@ -0,0 +1,27 @@ + + +#include <FL/Fl_Window.H> +#include "c_fl_window.h" + + +my_fl_window new_fl_window(int x, int y, int w, int h, char * label) { + Fl_Window *window = new Fl_Window(x, y, w, h, label); + return window; +} + + +my_fl_window new_fl_window2(int w, int h) { + Fl_Window *window = new Fl_Window(w, h); + return window; +} + + +void free_fl_window(my_fl_window f) { + delete reinterpret_cast<Fl_Window*>(f); +} + + +void fl_window_show(my_fl_window f) { + reinterpret_cast<Fl_Window*>(f)->show(); +} + diff --git a/src/fltk_binding/c_fl_window.h b/src/fltk_binding/c_fl_window.h new file mode 100644 index 0000000..2d03c4e --- /dev/null +++ b/src/fltk_binding/c_fl_window.h @@ -0,0 +1,18 @@ + + +#ifndef FL_WINDOW_GUARD +#define FL_WINDOW_GUARD + + +typedef void* my_fl_window; + + +extern "C" my_fl_window new_fl_window(int x, int y, int w, int h, char * label); +extern "C" my_fl_window new_fl_window2(int w, int h); +extern "C" void free_fl_window(my_fl_window f); + +extern "C" void fl_window_show(my_fl_window f); + + +#endif + diff --git a/src/fltk_binding/fltk-enum_values.ads b/src/fltk_binding/fltk-enum_values.ads new file mode 100644 index 0000000..068d5c1 --- /dev/null +++ b/src/fltk_binding/fltk-enum_values.ads @@ -0,0 +1,7 @@ + + +private package FLTK.Enum_Values is + + +end FLTK.Enum_Values; + diff --git a/src/fltk_binding/fltk-enums.ads b/src/fltk_binding/fltk-enums.ads new file mode 100644 index 0000000..da4920d --- /dev/null +++ b/src/fltk_binding/fltk-enums.ads @@ -0,0 +1,87 @@ + + +package FLTK.Enums is + + + type Box_Kind is + (No_Box, + Flat_Box, + Up_Box, + Down_Box, + Up_Frame, + Down_Frame, + Thin_Up_Box, + Thin_Down_Box, + Thin_Up_Frame, + Thin_Down_Frame, + Engraved_Box, + Embossed_Box, + Engraved_Frame, + Embossed_Frame, + Border_Box, + Shadow_Box, + Border_Frame, + Shadow_Frame, + Rounded_Box, + RShadow_Box, + Rounded_Frame, + RFlat_Box, + Round_Up_Box, + Round_Down_Box, + Diamond_Up_Box, + Diamond_Down_Box, + Oval_Box, + OShadow_Box, + Oval_Frame, + OFlat_Box, + Plastic_Up_Box, + Plastic_Down_Box, + Plastic_Up_Frame, + Plastic_Down_Frame, + Plastic_Thin_Up_Box, + Plastic_Thin_Down_Box, + Plastic_Round_Up_Box, + Plastic_Round_Down_Box, + Gtk_Up_Box, + Gtk_Down_Box, + Gtk_Up_Frame, + Gtk_Down_Frame, + Gtk_Thin_Up_Box, + Gtk_Thin_Down_Box, + Gtk_Thin_Up_Frame, + Gtk_Thin_Down_Frame, + Gtk_Round_Up_Box, + Gtk_Round_Down_Box, + Gleam_Up_Box, + Gleam_Down_Box, + Gleam_Up_Frame, + Gleam_Down_Frame, + Gleam_Thin_Up_Box, + Gleam_Thin_Down_Box, + Gleam_Round_Up_Box, + Gleam_Round_Down_Box, + Free_Box); + + + type Font_Kind is + (Helvetica, + Helvetica_Bold, + Helvetica_Italic, + Helvetica_Bold_Italic, + Courier, + Courier_Bold, + Courier_Italic, + Courier_Bold_Italic, + Times, + Times_Bold, + Times_Italic, + Times_Bold_Italic, + Symbol, + Screen, + Screen_Bold, + Zapf_Dingbats, + Free_Font); + + +end FLTK.Enums; + diff --git a/src/fltk_binding/fltk-widget-box.adb b/src/fltk_binding/fltk-widget-box.adb new file mode 100644 index 0000000..8aa18cb --- /dev/null +++ b/src/fltk_binding/fltk-widget-box.adb @@ -0,0 +1,54 @@ + + +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 new file mode 100644 index 0000000..2ce03e7 --- /dev/null +++ b/src/fltk_binding/fltk-widget-box.ads @@ -0,0 +1,22 @@ + + +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.adb b/src/fltk_binding/fltk-widget-button.adb new file mode 100644 index 0000000..8ec03ce --- /dev/null +++ b/src/fltk_binding/fltk-widget-button.adb @@ -0,0 +1,54 @@ + + +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"); + + + + + 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; + + +end FLTK.Widget.Button; + diff --git a/src/fltk_binding/fltk-widget-button.ads b/src/fltk_binding/fltk-widget-button.ads new file mode 100644 index 0000000..8212fe3 --- /dev/null +++ b/src/fltk_binding/fltk-widget-button.ads @@ -0,0 +1,22 @@ + + +package FLTK.Widget.Button is + + + type Button_Type is new Widget_Type with private; + + + function Create (X, Y, W, H : Integer; Label : String) return Button_Type; + + +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-window-double.adb b/src/fltk_binding/fltk-widget-group-window-double.adb new file mode 100644 index 0000000..1e678f3 --- /dev/null +++ b/src/fltk_binding/fltk-widget-group-window-double.adb @@ -0,0 +1,95 @@ + + +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 new file mode 100644 index 0000000..687b876 --- /dev/null +++ b/src/fltk_binding/fltk-widget-group-window-double.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..1007d71 --- /dev/null +++ b/src/fltk_binding/fltk-widget-group-window.adb @@ -0,0 +1,86 @@ + + +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 new file mode 100644 index 0000000..6d4a32d --- /dev/null +++ b/src/fltk_binding/fltk-widget-group-window.ads @@ -0,0 +1,25 @@ + + +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 new file mode 100644 index 0000000..b6db1f9 --- /dev/null +++ b/src/fltk_binding/fltk-widget-group.adb @@ -0,0 +1,149 @@ + + +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 : Integer; + Label : 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; + Item : Widget_Type'Class) is + begin + fl_group_add (This.Void_Ptr, Item.Void_Ptr); + end Add; + + + + + procedure Clear + (This : Group_Type) is + begin + fl_group_clear (This.Void_Ptr); + end Clear; + + + + + function Find + (This : Group_Type; + 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; + 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; + Item : Widget_Type'Class) is + begin + fl_group_remove (This.Void_Ptr, Item.Void_Ptr); + end Remove; + + + + + procedure Remove + (This : Group_Type; + 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 new file mode 100644 index 0000000..689d798 --- /dev/null +++ b/src/fltk_binding/fltk-widget-group.ads @@ -0,0 +1,57 @@ + + +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; + Item : Widget_Type'Class); + + + procedure Clear + (This : Group_Type); + + + function Find + (This : Group_Type; + Item : Widget_Type'Class) + return Index; + + + procedure Insert + (This : Group_Type; + Item : Widget_Type'Class; + Place : Index); + + + procedure Remove + (This : Group_Type; + Item : Widget_Type'Class); + + + procedure Remove + (This : Group_Type; + 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 new file mode 100644 index 0000000..2428dde --- /dev/null +++ b/src/fltk_binding/fltk-widget-input.adb @@ -0,0 +1,47 @@ + + +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 new file mode 100644 index 0000000..c537aef --- /dev/null +++ b/src/fltk_binding/fltk-widget-input.ads @@ -0,0 +1,22 @@ + + +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 new file mode 100644 index 0000000..7f3edd6 --- /dev/null +++ b/src/fltk_binding/fltk-widget.adb @@ -0,0 +1,80 @@ + + +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"); + + + + + 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; + + +end FLTK.Widget; + diff --git a/src/fltk_binding/fltk-widget.ads b/src/fltk_binding/fltk-widget.ads new file mode 100644 index 0000000..1e56c4f --- /dev/null +++ b/src/fltk_binding/fltk-widget.ads @@ -0,0 +1,53 @@ + + +with FLTK.Enums; use FLTK.Enums; +private with Ada.Finalization; +private with System; + + +package FLTK.Widget is + + + type Widget_Type is abstract tagged limited private; + + + 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); + + +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.adb b/src/fltk_binding/fltk.adb new file mode 100644 index 0000000..674a54a --- /dev/null +++ b/src/fltk_binding/fltk.adb @@ -0,0 +1,20 @@ + + +with Interfaces.C; + + +package body FLTK is + + + function fl_run return Interfaces.C.int; + pragma Import (C, fl_run, "fl_run"); + + + function Run return Integer is + begin + return Integer (fl_run); + end Run; + + +end FLTK; + diff --git a/src/fltk_binding/fltk.ads b/src/fltk_binding/fltk.ads new file mode 100644 index 0000000..33363df --- /dev/null +++ b/src/fltk_binding/fltk.ads @@ -0,0 +1,10 @@ + + +package FLTK is + + + function Run return Integer; + + +end FLTK; + |