From 68f7afe50933c1339ac86407e99799d74250d4fd Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Wed, 24 May 2017 23:56:17 +1000 Subject: Several more Widget methods added --- src/c_fl_widget.cpp | 30 ++++++++++++++++ src/c_fl_widget.h | 6 ++++ src/fltk-widgets.adb | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/fltk-widgets.ads | 34 ++++++++++++++++++ src/fltk.ads | 15 +++++++- 5 files changed, 182 insertions(+), 1 deletion(-) diff --git a/src/c_fl_widget.cpp b/src/c_fl_widget.cpp index 7b0d6b2..1f383de 100644 --- a/src/c_fl_widget.cpp +++ b/src/c_fl_widget.cpp @@ -89,6 +89,21 @@ int fl_widget_active_r(WIDGET w) { } +void fl_widget_clear_active(WIDGET w) { + reinterpret_cast(w)->clear_active(); +} + + +unsigned int fl_widget_changed(WIDGET w) { + return reinterpret_cast(w)->changed(); +} + + +void fl_widget_clear_changed(WIDGET w) { + reinterpret_cast(w)->clear_changed(); +} + + void * fl_widget_get_parent(WIDGET w) { @@ -96,6 +111,21 @@ void * fl_widget_get_parent(WIDGET w) { } +int fl_widget_contains(WIDGET w, WIDGET i) { + return reinterpret_cast(w)->contains(reinterpret_cast(i)); +} + + + + +unsigned int fl_widget_get_align(WIDGET w) { + return reinterpret_cast(w)->align(); +} + + +void fl_widget_set_align(WIDGET w, unsigned int a) { + reinterpret_cast(w)->align(a); +} int fl_widget_get_box(WIDGET w) { diff --git a/src/c_fl_widget.h b/src/c_fl_widget.h index 255be16..8d17485 100644 --- a/src/c_fl_widget.h +++ b/src/c_fl_widget.h @@ -23,11 +23,17 @@ extern "C" void fl_widget_activate(WIDGET w); extern "C" void fl_widget_deactivate(WIDGET w); extern "C" int fl_widget_active(WIDGET w); extern "C" int fl_widget_active_r(WIDGET w); +extern "C" void fl_widget_clear_active(WIDGET w); +extern "C" unsigned int fl_widget_changed(WIDGET w); +extern "C" void fl_widget_clear_changed(WIDGET w); extern "C" void * fl_widget_get_parent(WIDGET w); +extern "C" int fl_widget_contains(WIDGET w, WIDGET i); +extern "C" unsigned int fl_widget_get_align(WIDGET w); +extern "C" void fl_widget_set_align(WIDGET w, unsigned int a); extern "C" int fl_widget_get_box(WIDGET w); extern "C" void fl_widget_set_box(WIDGET w, int b); extern "C" const char* fl_widget_get_label(WIDGET w); diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index 629f90e..dfb0c9c 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -7,6 +7,7 @@ with System.Address_To_Access_Conversions; with FLTK.Widgets.Groups; with FLTK.Images; use type Interfaces.C.int; +use type Interfaces.C.unsigned; use type System.Address; @@ -57,11 +58,39 @@ package body FLTK.Widgets is return Interfaces.C.int; pragma Import (C, fl_widget_active_r, "fl_widget_active_r"); + procedure fl_widget_clear_active + (W : in System.Address); + pragma Import (C, fl_widget_clear_active, "fl_widget_clear_active"); + + function fl_widget_changed + (W : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_widget_changed, "fl_widget_changed"); + + procedure fl_widget_clear_changed + (W : in System.Address); + pragma Import (C, fl_widget_clear_changed, "fl_widget_clear_changed"); + function fl_widget_get_parent (W : in System.Address) return System.Address; pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); + function fl_widget_contains + (W, I : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_widget_contains, "fl_widget_contains"); + + function fl_widget_get_align + (W : in System.Address) + return Interfaces.C.unsigned; + pragma Import (C, fl_widget_get_align, "fl_widget_get_align"); + + procedure fl_widget_set_align + (W : in System.Address; + A : in Interfaces.C.unsigned); + pragma Import (C, fl_widget_set_align, "fl_widget_set_align"); + function fl_widget_get_box (W : in System.Address) return Interfaces.C.int; @@ -266,6 +295,34 @@ package body FLTK.Widgets is + procedure Clear_Active + (This : in out Widget) is + begin + fl_widget_clear_active (This.Void_Ptr); + end Clear_Active; + + + + + function Has_Changed + (This : in Widget) + return Boolean is + begin + return fl_widget_changed (This.Void_Ptr) /= 0; + end Has_Changed; + + + + + procedure Clear_Changed + (This : in out Widget) is + begin + fl_widget_clear_changed (This.Void_Ptr); + end Clear_Changed; + + + + function Parent (This : in Widget) return access FLTK.Widgets.Groups.Group'Class @@ -283,6 +340,37 @@ package body FLTK.Widgets is + function Contains + (This : in Widget; + Item : in Widget'Class) + return Boolean is + begin + return fl_widget_contains (This.Void_Ptr, Item.Void_Ptr) /= 0; + end Contains; + + + + + function Get_Alignment + (This : in Widget) + return Alignment is + begin + return Alignment (fl_widget_get_align (This.Void_Ptr)); + end Get_Alignment; + + + + + procedure Set_Alignment + (This : in out Widget; + New_Align : in Alignment) is + begin + fl_widget_set_align (This.Void_Ptr, Interfaces.C.unsigned (New_Align)); + end Set_Alignment; + + + + function Get_Box (This : in Widget) return Box_Kind is @@ -383,6 +471,16 @@ package body FLTK.Widgets is + function Get_Callback + (This : in Widget) + return Widget_Callback is + begin + return This.Callback; + end Get_Callback; + + + + procedure Set_Callback (This : in out Widget; Func : in Widget_Callback) is diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 46e0c4c..f4d0280 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -49,11 +49,40 @@ package FLTK.Widgets is return Boolean; + procedure Clear_Active + (This : in out Widget); + + + function Has_Changed + (This : in Widget) + return Boolean; + + + procedure Clear_Changed + (This : in out Widget); + + function Parent (This : in Widget) return access FLTK.Widgets.Groups.Group'Class; + function Contains + (This : in Widget; + Item : in Widget'Class) + return Boolean; + + + function Get_Alignment + (This : in Widget) + return Alignment; + + + procedure Set_Alignment + (This : in out Widget; + New_Align : in Alignment); + + function Get_Box (This : in Widget) return Box_Kind; @@ -104,6 +133,11 @@ package FLTK.Widgets is Label : in Label_Kind); + function Get_Callback + (This : in Widget) + return Widget_Callback; + + procedure Set_Callback (This : in out Widget; Func : in Widget_Callback); diff --git a/src/fltk.ads b/src/fltk.ads index d825f5e..757eaf7 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -21,7 +21,12 @@ package FLTK is type Color is new Natural; - type Alignment is new Natural; + type Alignment is private; + Align_Center : constant Alignment; + Align_Top : constant Alignment; + Align_Bottom : constant Alignment; + Align_Left : constant Alignment; + Align_Right : constant Alignment; type Shortcut_Key is private; @@ -183,6 +188,14 @@ private (This : in out Wrapper); + type Alignment is new Interfaces.Unsigned_16; + Align_Center : constant Alignment := 0; + Align_Top : constant Alignment := 1; + Align_Bottom : constant Alignment := 2; + Align_Left : constant Alignment := 4; + Align_Right : constant Alignment := 8; + + type Modifier_Key is new Interfaces.Unsigned_8; -- cgit