aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_fl_menu.cpp2
-rw-r--r--src/c_fl_widget.cpp94
-rw-r--r--src/c_fl_widget.h8
-rw-r--r--src/fltk-widgets.adb77
-rw-r--r--src/fltk-widgets.ads14
5 files changed, 170 insertions, 25 deletions
diff --git a/src/c_fl_menu.cpp b/src/c_fl_menu.cpp
index 630e63f..c9fb6d3 100644
--- a/src/c_fl_menu.cpp
+++ b/src/c_fl_menu.cpp
@@ -29,7 +29,7 @@ void My_Menu::draw() {
void My_Menu::real_draw() {
- Fl_Menu_::draw();
+ //Fl_Menu_::draw();
}
diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp
index 30c4de3..4e9f2fb 100644
--- a/src/c_fl_widget.cpp
+++ b/src/c_fl_widget.cpp
@@ -5,115 +5,167 @@
#include "c_fl_widget.h"
+typedef void (hook)(void*);
+typedef hook* hook_p;
+
+
+
+
+class My_Widget : public Fl_Widget {
+ public:
+ using Fl_Widget::Fl_Widget;
+ friend void widget_set_draw_hook(WIDGET w, void * d);
+ friend void fl_widget_draw(WIDGET w);
+ friend WIDGET new_fl_widget(int x, int y, int w, int h, char* label);
+ protected:
+ void draw();
+ void real_draw();
+ hook_p draw_hook;
+};
+
+
+void My_Widget::draw() {
+ (*draw_hook)(this->user_data());
+}
+
+
+void My_Widget::real_draw() {
+ //Fl_Widget::draw();
+}
+
+
+void widget_set_draw_hook(WIDGET w, void * d) {
+ reinterpret_cast<My_Widget*>(w)->draw_hook = reinterpret_cast<hook_p>(d);
+}
+
+
+void fl_widget_draw(WIDGET w) {
+ reinterpret_cast<My_Widget*>(w)->real_draw();
+}
+
+
+
+
+WIDGET new_fl_widget(int x, int y, int w, int h, char* label) {
+ My_Widget *wd = new My_Widget(x, y, w, h, label);
+ return wd;
+}
+
+
+void free_fl_widget(WIDGET w) {
+ delete reinterpret_cast<My_Widget*>(w);
+}
+
+
void * fl_widget_get_user_data(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->user_data();
+ return reinterpret_cast<My_Widget*>(w)->user_data();
}
void fl_widget_set_user_data(WIDGET w, void * d) {
- reinterpret_cast<Fl_Widget*>(w)->user_data(d);
+ reinterpret_cast<My_Widget*>(w)->user_data(d);
}
int fl_widget_get_box(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->box();
+ return reinterpret_cast<My_Widget*>(w)->box();
}
void fl_widget_set_box(WIDGET w, int b) {
- reinterpret_cast<Fl_Widget*>(w)->box(static_cast<Fl_Boxtype>(b));
+ reinterpret_cast<My_Widget*>(w)->box(static_cast<Fl_Boxtype>(b));
}
const char* fl_widget_get_label(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->label();
+ return reinterpret_cast<My_Widget*>(w)->label();
}
void fl_widget_set_label(WIDGET w, const char* t) {
- reinterpret_cast<Fl_Widget*>(w)->copy_label(t);
+ reinterpret_cast<My_Widget*>(w)->copy_label(t);
}
int fl_widget_get_label_font(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->labelfont();
+ return reinterpret_cast<My_Widget*>(w)->labelfont();
}
void fl_widget_set_label_font(WIDGET w, int f) {
- reinterpret_cast<Fl_Widget*>(w)->labelfont(static_cast<Fl_Font>(f));
+ reinterpret_cast<My_Widget*>(w)->labelfont(static_cast<Fl_Font>(f));
}
int fl_widget_get_label_size(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->labelsize();
+ return reinterpret_cast<My_Widget*>(w)->labelsize();
}
void fl_widget_set_label_size(WIDGET w, int s) {
- reinterpret_cast<Fl_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s));
+ reinterpret_cast<My_Widget*>(w)->labelsize(static_cast<Fl_Fontsize>(s));
}
int fl_widget_get_label_type(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->labeltype();
+ return reinterpret_cast<My_Widget*>(w)->labeltype();
}
void fl_widget_set_label_type(WIDGET w, int l) {
- reinterpret_cast<Fl_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l));
+ reinterpret_cast<My_Widget*>(w)->labeltype(static_cast<Fl_Labeltype>(l));
}
void * fl_widget_get_parent(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->parent();
+ return reinterpret_cast<My_Widget*>(w)->parent();
}
void fl_widget_set_callback(WIDGET w, void * cb) {
- reinterpret_cast<Fl_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb));
+ reinterpret_cast<My_Widget*>(w)->callback(reinterpret_cast<Fl_Callback_p>(cb));
}
int fl_widget_get_x(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->x();
+ return reinterpret_cast<My_Widget*>(w)->x();
}
int fl_widget_get_y(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->y();
+ return reinterpret_cast<My_Widget*>(w)->y();
}
int fl_widget_get_w(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->w();
+ return reinterpret_cast<My_Widget*>(w)->w();
}
int fl_widget_get_h(WIDGET w) {
- return reinterpret_cast<Fl_Widget*>(w)->h();
+ return reinterpret_cast<My_Widget*>(w)->h();
}
void fl_widget_size(WIDGET w, int d, int h) {
- reinterpret_cast<Fl_Widget*>(w)->size(d, h);
+ reinterpret_cast<My_Widget*>(w)->size(d, h);
}
void fl_widget_position(WIDGET w, int x, int y) {
- reinterpret_cast<Fl_Widget*>(w)->position(x, y);
+ reinterpret_cast<My_Widget*>(w)->position(x, y);
}
void fl_widget_set_image(WIDGET w, void * img) {
- reinterpret_cast<Fl_Widget*>(w)->image(reinterpret_cast<Fl_Image*>(img));
+ reinterpret_cast<My_Widget*>(w)->image(reinterpret_cast<Fl_Image*>(img));
}
diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h
index 3c20dc2..be83177 100644
--- a/src/c_fl_widget.h
+++ b/src/c_fl_widget.h
@@ -7,6 +7,14 @@
typedef void* WIDGET;
+extern "C" void widget_set_draw_hook(WIDGET w, void * d);
+extern "C" void fl_widget_draw(WIDGET w);
+
+
+extern "C" WIDGET new_fl_widget(int x, int y, int w, int h, char* label);
+extern "C" void free_fl_widget(WIDGET w);
+
+
extern "C" void * fl_widget_get_user_data(WIDGET w);
extern "C" void fl_widget_set_user_data(WIDGET w, void * d);
diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb
index 9ec2350..96d7998 100644
--- a/src/fltk-widgets.adb
+++ b/src/fltk-widgets.adb
@@ -18,6 +18,24 @@ package body FLTK.Widgets is
+ procedure widget_set_draw_hook
+ (W, D : in System.Address);
+ pragma Import (C, widget_set_draw_hook, "widget_set_draw_hook");
+
+ procedure fl_widget_draw
+ (W : in System.Address);
+ pragma Import (C, fl_widget_draw, "fl_widget_draw");
+
+ function new_fl_widget
+ (X, Y, W, H : in Interfaces.C.int;
+ Text : in Interfaces.C.char_array)
+ return System.Address;
+ pragma Import (C, new_fl_widget, "new_fl_widget");
+
+ procedure free_fl_widget
+ (F : in System.Address);
+ pragma Import (C, free_fl_widget, "free_fl_widget");
+
function fl_widget_get_box
(W : in System.Address)
return Interfaces.C.int;
@@ -114,6 +132,65 @@ package body FLTK.Widgets is
+ procedure Draw_Hook (U : in System.Address);
+ pragma Convention (C, Draw_Hook);
+
+ procedure Draw_Hook
+ (U : in System.Address)
+ is
+ Ada_Widget : access Widget'Class :=
+ Widget_Convert.To_Pointer (U);
+ begin
+ Ada_Widget.Draw;
+ end Draw_Hook;
+
+
+
+
+ procedure Draw
+ (This : in out Widget) is
+ begin
+ fl_widget_draw (This.Void_Ptr);
+ end Draw;
+
+
+
+
+ procedure Finalize
+ (This : in out Widget) is
+ begin
+ if This.Void_Ptr /= System.Null_Address then
+ if This in Widget then
+ free_fl_widget (This.Void_Ptr);
+ end if;
+ end if;
+ end Finalize;
+
+
+
+
+ function Create
+ (X, Y, W, H : in Integer;
+ Text : in String)
+ return Widget is
+ begin
+ return This : Widget do
+ This.Void_Ptr := new_fl_widget
+ (Interfaces.C.int (X),
+ Interfaces.C.int (Y),
+ Interfaces.C.int (W),
+ Interfaces.C.int (H),
+ Interfaces.C.To_C (Text));
+ fl_widget_set_user_data
+ (This.Void_Ptr,
+ Widget_Convert.To_Address (This'Unchecked_Access));
+ widget_set_draw_hook (This.Void_Ptr, Draw_Hook'Address);
+ end return;
+ end Create;
+
+
+
+
function Parent
(This : in Widget)
return access FLTK.Widgets.Groups.Group'Class
diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads
index d1c4b89..0ed0d2d 100644
--- a/src/fltk-widgets.ads
+++ b/src/fltk-widgets.ads
@@ -11,7 +11,7 @@ private with Ada.Unchecked_Conversion;
package FLTK.Widgets is
- type Widget is abstract new Wrapper with private;
+ type Widget is new Wrapper with private;
type Widget_Callback is access procedure
@@ -26,7 +26,7 @@ package FLTK.Widgets is
function Create
(X, Y, W, H : in Integer;
Text : in String)
- return Widget is abstract;
+ return Widget;
function Parent
@@ -132,13 +132,21 @@ package FLTK.Widgets is
private
- type Widget is abstract new Wrapper with
+ procedure Draw
+ (This : in out Widget);
+
+
+ type Widget is new Wrapper with
record
Callback : Widget_Callback;
Current_Image : access FLTK.Images.Image'Class;
end record;
+ overriding procedure Finalize
+ (This : in out Widget);
+
+
package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class);
-- package Callback_Convert is new System.Address_To_Access_Conversions (Widget_Callback);
package Callback_Convert is
generated by cgit (git 2.30.0) at 2025-10-31 23:39:55 +0000