diff options
Diffstat (limited to 'body/fltk-widgets-positioners.adb')
| -rw-r--r-- | body/fltk-widgets-positioners.adb | 68 |
1 files changed, 51 insertions, 17 deletions
diff --git a/body/fltk-widgets-positioners.adb b/body/fltk-widgets-positioners.adb index 053d731..29246cd 100644 --- a/body/fltk-widgets-positioners.adb +++ b/body/fltk-widgets-positioners.adb @@ -23,6 +23,8 @@ package body FLTK.Widgets.Positioners is -- Functions From C -- ------------------------ + -- Allocation -- + function new_fl_positioner (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) @@ -38,6 +40,8 @@ package body FLTK.Widgets.Positioners is + -- Targeting -- + function fl_positioner_set_value (P : in Storage.Integer_Address; X, Y : in Interfaces.C.double) @@ -48,6 +52,8 @@ package body FLTK.Widgets.Positioners is + -- X Axis -- + procedure fl_positioner_xbounds (P : in Storage.Integer_Address; L, H : in Interfaces.C.double); @@ -100,6 +106,8 @@ package body FLTK.Widgets.Positioners is + -- Y Axis -- + procedure fl_positioner_ybounds (P : in Storage.Integer_Address; L, H : in Interfaces.C.double); @@ -152,6 +160,8 @@ package body FLTK.Widgets.Positioners is + -- Drawing, Events -- + procedure fl_positioner_draw (P : in Storage.Integer_Address); pragma Import (C, fl_positioner_draw, "fl_positioner_draw"); @@ -264,6 +274,8 @@ package body FLTK.Widgets.Positioners is -- API Subprograms -- ----------------------- + -- Targeting -- + procedure Get_Coords (This : in Positioner; X, Y : out Long_Float) is @@ -277,14 +289,16 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; X, Y : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_value + Result : constant Interfaces.C.int := fl_positioner_set_value (This.Void_Ptr, Interfaces.C.double (X), Interfaces.C.double (Y)); begin pragma Assert (Result in 0 .. 1); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Positioner::value returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Coords; @@ -293,19 +307,23 @@ package body FLTK.Widgets.Positioners is X, Y : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_value + Result : constant Interfaces.C.int := fl_positioner_set_value (This.Void_Ptr, Interfaces.C.double (X), Interfaces.C.double (Y)); begin return Boolean'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Positioner::value returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Coords; + -- X Axis -- + procedure Set_Ecks_Bounds (This : in out Positioner; Low, High : in Long_Float) is @@ -369,13 +387,15 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; Value : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_xvalue + Result : constant Interfaces.C.int := fl_positioner_set_xvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin pragma Assert (Result in 0 .. 1); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Positioner::xvalue returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Ecks; @@ -384,18 +404,22 @@ package body FLTK.Widgets.Positioners is Value : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_xvalue + Result : constant Interfaces.C.int := fl_positioner_set_xvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin return Boolean'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Positioner::xvalue returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Ecks; + -- Y Axis -- + procedure Set_Why_Bounds (This : in out Positioner; Low, High : in Long_Float) is @@ -459,13 +483,15 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; Value : in Long_Float) is - Result : Interfaces.C.int := fl_positioner_set_yvalue + Result : constant Interfaces.C.int := fl_positioner_set_yvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin pragma Assert (Result in 0 .. 1); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_Positioner::yvalue returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Why; @@ -474,18 +500,22 @@ package body FLTK.Widgets.Positioners is Value : in Long_Float) return Boolean is - Result : Interfaces.C.int := fl_positioner_set_yvalue + Result : constant Interfaces.C.int := fl_positioner_set_yvalue (This.Void_Ptr, Interfaces.C.double (Value)); begin return Boolean'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Positioner::yvalue returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Set_Why; + -- Drawing, Events -- + procedure Draw (This : in out Positioner) is begin @@ -519,17 +549,21 @@ package body FLTK.Widgets.Positioners is (This : in out Positioner; Event : in Event_Kind; X, Y, W, H : in Integer) - return Event_Outcome is - begin - return Event_Outcome'Val (fl_positioner_handle2 + return Event_Outcome + is + Result : constant Interfaces.C.int := fl_positioner_handle2 (This.Void_Ptr, Event_Kind'Pos (Event), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), - Interfaces.C.int (H))); + Interfaces.C.int (H)); + begin + return Event_Outcome'Val (Result); exception - when Constraint_Error => raise Internal_FLTK_Error; + when Constraint_Error => raise Internal_FLTK_Error with + "Fl_Positioner::handle returned unexpected int value of " & + Interfaces.C.int'Image (Result); end Handle; |