diff options
| author | Jed Barber <jjbarber@y7mail.com> | 2016-05-24 02:25:30 +1000 | 
|---|---|---|
| committer | Jed Barber <jjbarber@y7mail.com> | 2016-05-24 02:25:30 +1000 | 
| commit | ac5c51b6ee492b504e165408b742d2505e308e94 (patch) | |
| tree | f0d0dc1bcade720f368f119240a0ade500adf092 | |
It's a start
34 files changed, 1237 insertions, 0 deletions
diff --git a/c_fl.cpp b/c_fl.cpp new file mode 100644 index 0000000..b628c41 --- /dev/null +++ b/c_fl.cpp @@ -0,0 +1,10 @@ + + +#include <FL/Fl.H> +#include "c_fl.h" + + +int fl_run(void) { +    return Fl::run(); +} + @@ -0,0 +1,11 @@ + + +#ifndef FL_GUARD +#define FL_GUARD + + +extern "C" int fl_run(void); + + +#endif + diff --git a/c_fl_box.cpp b/c_fl_box.cpp new file mode 100644 index 0000000..01685f8 --- /dev/null +++ b/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/c_fl_box.h b/c_fl_box.h new file mode 100644 index 0000000..e21f875 --- /dev/null +++ b/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/c_fl_button.cpp b/c_fl_button.cpp new file mode 100644 index 0000000..935a14b --- /dev/null +++ b/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/c_fl_button.h b/c_fl_button.h new file mode 100644 index 0000000..a83e3d8 --- /dev/null +++ b/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/c_fl_double_window.cpp b/c_fl_double_window.cpp new file mode 100644 index 0000000..7a9899c --- /dev/null +++ b/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/c_fl_double_window.h b/c_fl_double_window.h new file mode 100644 index 0000000..eb6784d --- /dev/null +++ b/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/c_fl_group.cpp b/c_fl_group.cpp new file mode 100644 index 0000000..44aeb34 --- /dev/null +++ b/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/c_fl_group.h b/c_fl_group.h new file mode 100644 index 0000000..8fbd671 --- /dev/null +++ b/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/c_fl_input.cpp b/c_fl_input.cpp new file mode 100644 index 0000000..8504e56 --- /dev/null +++ b/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/c_fl_input.h b/c_fl_input.h new file mode 100644 index 0000000..6cec6ec --- /dev/null +++ b/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/c_fl_widget.cpp b/c_fl_widget.cpp new file mode 100644 index 0000000..cf99c41 --- /dev/null +++ b/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/c_fl_widget.h b/c_fl_widget.h new file mode 100644 index 0000000..40d22f3 --- /dev/null +++ b/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/c_fl_window.cpp b/c_fl_window.cpp new file mode 100644 index 0000000..64a1c38 --- /dev/null +++ b/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/c_fl_window.h b/c_fl_window.h new file mode 100644 index 0000000..2d03c4e --- /dev/null +++ b/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/fltk-enum_values.ads b/fltk-enum_values.ads new file mode 100644 index 0000000..068d5c1 --- /dev/null +++ b/fltk-enum_values.ads @@ -0,0 +1,7 @@ + + +private package FLTK.Enum_Values is + + +end FLTK.Enum_Values; + diff --git a/fltk-enums.ads b/fltk-enums.ads new file mode 100644 index 0000000..da4920d --- /dev/null +++ b/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/fltk-widget-box.adb b/fltk-widget-box.adb new file mode 100644 index 0000000..8aa18cb --- /dev/null +++ b/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/fltk-widget-box.ads b/fltk-widget-box.ads new file mode 100644 index 0000000..2ce03e7 --- /dev/null +++ b/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/fltk-widget-button.adb b/fltk-widget-button.adb new file mode 100644 index 0000000..8ec03ce --- /dev/null +++ b/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/fltk-widget-button.ads b/fltk-widget-button.ads new file mode 100644 index 0000000..8212fe3 --- /dev/null +++ b/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/fltk-widget-group-window-double.adb b/fltk-widget-group-window-double.adb new file mode 100644 index 0000000..1e678f3 --- /dev/null +++ b/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/fltk-widget-group-window-double.ads b/fltk-widget-group-window-double.ads new file mode 100644 index 0000000..687b876 --- /dev/null +++ b/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/fltk-widget-group-window.adb b/fltk-widget-group-window.adb new file mode 100644 index 0000000..1007d71 --- /dev/null +++ b/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/fltk-widget-group-window.ads b/fltk-widget-group-window.ads new file mode 100644 index 0000000..6d4a32d --- /dev/null +++ b/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/fltk-widget-group.adb b/fltk-widget-group.adb new file mode 100644 index 0000000..b6db1f9 --- /dev/null +++ b/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/fltk-widget-group.ads b/fltk-widget-group.ads new file mode 100644 index 0000000..689d798 --- /dev/null +++ b/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/fltk-widget-input.adb b/fltk-widget-input.adb new file mode 100644 index 0000000..2428dde --- /dev/null +++ b/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/fltk-widget-input.ads b/fltk-widget-input.ads new file mode 100644 index 0000000..c537aef --- /dev/null +++ b/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/fltk-widget.adb b/fltk-widget.adb new file mode 100644 index 0000000..7f3edd6 --- /dev/null +++ b/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/fltk-widget.ads b/fltk-widget.ads new file mode 100644 index 0000000..1e56c4f --- /dev/null +++ b/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/fltk.adb b/fltk.adb new file mode 100644 index 0000000..674a54a --- /dev/null +++ b/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/fltk.ads b/fltk.ads new file mode 100644 index 0000000..33363df --- /dev/null +++ b/fltk.ads @@ -0,0 +1,10 @@ + + +package FLTK is + + +    function Run return Integer; + + +end FLTK; +  | 
