diff options
109 files changed, 2403 insertions, 2370 deletions
diff --git a/fltkada.gpr b/fltkada.gpr index ad9b81d..ea624f1 100644 --- a/fltkada.gpr +++ b/fltkada.gpr @@ -14,7 +14,7 @@ library project FLTKAda is package Compiler is - for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM99nprt"); + for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt"); for Default_Switches("C++") use ("-Wall","-Wextra","-std=c++11"); end Compiler; diff --git a/src/c_fl.cpp b/src/c_fl.cpp index 237c33a..934b4f2 100644 --- a/src/c_fl.cpp +++ b/src/c_fl.cpp @@ -6,6 +6,13 @@ +size_t c_pointer_size() { + return sizeof(void*); +} + + + + int fl_abi_check(int v) { return Fl::abi_check(v); } @@ -6,6 +6,9 @@ +size_t c_pointer_size(); + + extern "C" int fl_abi_check(int v); extern "C" int fl_abi_version(); extern "C" int fl_api_version(); diff --git a/src/fltk-devices-graphics.adb b/src/fltk-devices-graphics.adb index e267690..7410e84 100644 --- a/src/fltk-devices-graphics.adb +++ b/src/fltk-devices-graphics.adb @@ -2,15 +2,14 @@ with - Interfaces.C, - System; + Interfaces.C; package body FLTK.Devices.Graphics is function fl_graphics_driver_color - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_graphics_driver_color, "fl_graphics_driver_color"); pragma Inline (fl_graphics_driver_color); @@ -19,26 +18,26 @@ package body FLTK.Devices.Graphics is function fl_graphics_driver_descent - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_graphics_driver_descent, "fl_graphics_driver_descent"); pragma Inline (fl_graphics_driver_descent); function fl_graphics_driver_height - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_graphics_driver_height, "fl_graphics_driver_height"); pragma Inline (fl_graphics_driver_height); function fl_graphics_driver_width - (G : in System.Address; + (G : in Storage.Integer_Address; C : in Interfaces.C.unsigned) return Interfaces.C.double; pragma Import (C, fl_graphics_driver_width, "fl_graphics_driver_width"); pragma Inline (fl_graphics_driver_width); function fl_graphics_driver_width2 - (G : in System.Address; + (G : in Storage.Integer_Address; S : in Interfaces.C.char_array; L : in Interfaces.C.int) return Interfaces.C.double; @@ -46,19 +45,19 @@ package body FLTK.Devices.Graphics is pragma Inline (fl_graphics_driver_width2); function fl_graphics_driver_get_font - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_graphics_driver_get_font, "fl_graphics_driver_get_font"); pragma Inline (fl_graphics_driver_get_font); function fl_graphics_driver_size - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_graphics_driver_size, "fl_graphics_driver_size"); pragma Inline (fl_graphics_driver_size); procedure fl_graphics_driver_set_font - (G : in System.Address; + (G : in Storage.Integer_Address; K, S : in Interfaces.C.int); pragma Import (C, fl_graphics_driver_set_font, "fl_graphics_driver_set_font"); pragma Inline (fl_graphics_driver_set_font); @@ -67,7 +66,7 @@ package body FLTK.Devices.Graphics is procedure fl_graphics_driver_draw_scaled - (G, I : in System.Address; + (G, I : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int); pragma Import (C, fl_graphics_driver_draw_scaled, "fl_graphics_driver_draw_scaled"); pragma Inline (fl_graphics_driver_draw_scaled); diff --git a/src/fltk-devices-surfaces-copy.adb b/src/fltk-devices-surfaces-copy.adb index cceb945..56b2335 100644 --- a/src/fltk-devices-surfaces-copy.adb +++ b/src/fltk-devices-surfaces-copy.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Devices.Surfaces.Copy is @@ -15,12 +10,12 @@ package body FLTK.Devices.Surfaces.Copy is function new_fl_copy_surface (W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_copy_surface, "new_fl_copy_surface"); pragma Inline (new_fl_copy_surface); procedure free_fl_copy_surface - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_copy_surface, "free_fl_copy_surface"); pragma Inline (free_fl_copy_surface); @@ -28,13 +23,13 @@ package body FLTK.Devices.Surfaces.Copy is function fl_copy_surface_get_w - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_copy_surface_get_w, "fl_copy_surface_get_w"); pragma Inline (fl_copy_surface_get_w); function fl_copy_surface_get_h - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_copy_surface_get_h, "fl_copy_surface_get_h"); pragma Inline (fl_copy_surface_get_h); @@ -43,13 +38,13 @@ package body FLTK.Devices.Surfaces.Copy is procedure fl_copy_surface_draw - (S, W : in System.Address; + (S, W : in Storage.Integer_Address; OX, OY : in Interfaces.C.int); pragma Import (C, fl_copy_surface_draw, "fl_copy_surface_draw"); pragma Inline (fl_copy_surface_draw); procedure fl_copy_surface_draw_decorated_window - (S, W : in System.Address; + (S, W : in Storage.Integer_Address; OX, OY : in Interfaces.C.int); pragma Import (C, fl_copy_surface_draw_decorated_window, "fl_copy_surface_draw_decorated_window"); @@ -59,7 +54,7 @@ package body FLTK.Devices.Surfaces.Copy is procedure fl_copy_surface_set_current - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_copy_surface_set_current, "fl_copy_surface_set_current"); pragma Inline (fl_copy_surface_set_current); @@ -69,11 +64,11 @@ package body FLTK.Devices.Surfaces.Copy is procedure Finalize (This : in out Copy_Surface) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Copy_Surface'Class then free_fl_copy_surface (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Surface_Device (This)); end Finalize; diff --git a/src/fltk-devices-surfaces-image.adb b/src/fltk-devices-surfaces-image.adb index 570f729..6eb694f 100644 --- a/src/fltk-devices-surfaces-image.adb +++ b/src/fltk-devices-surfaces-image.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Devices.Surfaces.Image is @@ -15,12 +10,12 @@ package body FLTK.Devices.Surfaces.Image is function new_fl_image_surface (W, H, R : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_image_surface, "new_fl_image_surface"); pragma Inline (new_fl_image_surface); procedure free_fl_image_surface - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_image_surface, "free_fl_image_surface"); pragma Inline (free_fl_image_surface); @@ -28,13 +23,13 @@ package body FLTK.Devices.Surfaces.Image is procedure fl_image_surface_draw - (S, I : in System.Address; + (S, I : in Storage.Integer_Address; OX, OY : in Interfaces.C.int); pragma Import (C, fl_image_surface_draw, "fl_image_surface_draw"); pragma Inline (fl_image_surface_draw); procedure fl_image_surface_draw_decorated_window - (S, I : in System.Address; + (S, I : in Storage.Integer_Address; OX, OY : in Interfaces.C.int); pragma Import (C, fl_image_surface_draw_decorated_window, "fl_image_surface_draw_decorated_window"); @@ -44,14 +39,14 @@ package body FLTK.Devices.Surfaces.Image is function fl_image_surface_image - (S : in System.Address) - return System.Address; + (S : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_image_surface_image, "fl_image_surface_image"); pragma Inline (fl_image_surface_image); function fl_image_surface_highres_image - (S : in System.Address) - return System.Address; + (S : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_image_surface_highres_image, "fl_image_surface_highres_image"); pragma Inline (fl_image_surface_highres_image); @@ -59,7 +54,7 @@ package body FLTK.Devices.Surfaces.Image is procedure fl_image_surface_set_current - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_image_surface_set_current, "fl_image_surface_set_current"); pragma Inline (fl_image_surface_set_current); @@ -69,11 +64,11 @@ package body FLTK.Devices.Surfaces.Image is procedure Finalize (This : in out Image_Surface) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Image_Surface'Class then free_fl_image_surface (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Surface_Device (This)); end Finalize; diff --git a/src/fltk-devices-surfaces-paged-printers.adb b/src/fltk-devices-surfaces-paged-printers.adb index bdc34b0..457e858 100644 --- a/src/fltk-devices-surfaces-paged-printers.adb +++ b/src/fltk-devices-surfaces-paged-printers.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Devices.Surfaces.Paged.Printers is function new_fl_printer - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_printer, "new_fl_printer"); pragma Inline (new_fl_printer); procedure free_fl_printer - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_printer, "free_fl_printer"); pragma Inline (free_fl_printer); @@ -28,32 +26,32 @@ package body FLTK.Devices.Surfaces.Paged.Printers is function fl_printer_start_job - (D : in System.Address; + (D : in Storage.Integer_Address; C : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_printer_start_job, "fl_printer_start_job"); pragma Inline (fl_printer_start_job); function fl_printer_start_job2 - (D : in System.Address; + (D : in Storage.Integer_Address; C, F, T : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_printer_start_job2, "fl_printer_start_job2"); pragma Inline (fl_printer_start_job2); procedure fl_printer_end_job - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, fl_printer_end_job, "fl_printer_end_job"); pragma Inline (fl_printer_end_job); function fl_printer_start_page - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_printer_start_page, "fl_printer_start_page"); pragma Inline (fl_printer_start_page); function fl_printer_end_page - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_printer_end_page, "fl_printer_end_page"); pragma Inline (fl_printer_end_page); @@ -62,50 +60,50 @@ package body FLTK.Devices.Surfaces.Paged.Printers is procedure fl_printer_margins - (D : in System.Address; + (D : in Storage.Integer_Address; L, T, R, B : out Interfaces.C.int); pragma Import (C, fl_printer_margins, "fl_printer_margins"); pragma Inline (fl_printer_margins); function fl_printer_printable_rect - (D : in System.Address; + (D : in Storage.Integer_Address; W, H : out Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_printer_printable_rect, "fl_printer_printable_rect"); pragma Inline (fl_printer_printable_rect); procedure fl_printer_get_origin - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : out Interfaces.C.int); pragma Import (C, fl_printer_get_origin, "fl_printer_get_origin"); pragma Inline (fl_printer_get_origin); procedure fl_printer_set_origin - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_printer_set_origin, "fl_printer_set_origin"); pragma Inline (fl_printer_set_origin); procedure fl_printer_rotate - (D : in System.Address; + (D : in Storage.Integer_Address; R : in Interfaces.C.C_float); pragma Import (C, fl_printer_rotate, "fl_printer_rotate"); pragma Inline (fl_printer_rotate); procedure fl_printer_scale - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.C_float); pragma Import (C, fl_printer_scale, "fl_printer_scale"); pragma Inline (fl_printer_scale); procedure fl_printer_translate - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_printer_translate, "fl_printer_translate"); pragma Inline (fl_printer_translate); procedure fl_printer_untranslate - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, fl_printer_untranslate, "fl_printer_untranslate"); pragma Inline (fl_printer_untranslate); @@ -113,13 +111,13 @@ package body FLTK.Devices.Surfaces.Paged.Printers is procedure fl_printer_print_widget - (D, I : in System.Address; + (D, I : in Storage.Integer_Address; DX, DY : in Interfaces.C.int); pragma Import (C, fl_printer_print_widget, "fl_printer_print_widget"); pragma Inline (fl_printer_print_widget); procedure fl_printer_print_window_part - (D, I : in System.Address; + (D, I : in Storage.Integer_Address; X, Y, W, H, DX, DY : in Interfaces.C.int); pragma Import (C, fl_printer_print_window_part, "fl_printer_print_window_part"); pragma Inline (fl_printer_print_window_part); @@ -128,7 +126,7 @@ package body FLTK.Devices.Surfaces.Paged.Printers is procedure fl_printer_set_current - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, fl_printer_set_current, "fl_printer_set_current"); pragma Inline (fl_printer_set_current); @@ -138,11 +136,11 @@ package body FLTK.Devices.Surfaces.Paged.Printers is procedure Finalize (This : in out Printer) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Printer'Class then free_fl_printer (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Paged_Surface (This)); end Finalize; diff --git a/src/fltk-devices-surfaces-paged.adb b/src/fltk-devices-surfaces-paged.adb index c615078..df7dbca 100644 --- a/src/fltk-devices-surfaces-paged.adb +++ b/src/fltk-devices-surfaces-paged.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Devices.Surfaces.Paged is function new_fl_paged_device - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_paged_device, "new_fl_paged_device"); pragma Inline (new_fl_paged_device); procedure free_fl_paged_device - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_paged_device, "free_fl_paged_device"); pragma Inline (free_fl_paged_device); @@ -28,32 +26,32 @@ package body FLTK.Devices.Surfaces.Paged is function fl_paged_device_start_job - (D : in System.Address; + (D : in Storage.Integer_Address; C : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_paged_device_start_job, "fl_paged_device_start_job"); pragma Inline (fl_paged_device_start_job); function fl_paged_device_start_job2 - (D : in System.Address; + (D : in Storage.Integer_Address; C, F, T : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_paged_device_start_job2, "fl_paged_device_start_job2"); pragma Inline (fl_paged_device_start_job2); procedure fl_paged_device_end_job - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, fl_paged_device_end_job, "fl_paged_device_end_job"); pragma Inline (fl_paged_device_end_job); function fl_paged_device_start_page - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_paged_device_start_page, "fl_paged_device_start_page"); pragma Inline (fl_paged_device_start_page); function fl_paged_device_end_page - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_paged_device_end_page, "fl_paged_device_end_page"); pragma Inline (fl_paged_device_end_page); @@ -62,50 +60,50 @@ package body FLTK.Devices.Surfaces.Paged is procedure fl_paged_device_margins - (D : in System.Address; + (D : in Storage.Integer_Address; L, T, R, B : out Interfaces.C.int); pragma Import (C, fl_paged_device_margins, "fl_paged_device_margins"); pragma Inline (fl_paged_device_margins); function fl_paged_device_printable_rect - (D : in System.Address; + (D : in Storage.Integer_Address; W, H : out Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_paged_device_printable_rect, "fl_paged_device_printable_rect"); pragma Inline (fl_paged_device_printable_rect); procedure fl_paged_device_get_origin - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : out Interfaces.C.int); pragma Import (C, fl_paged_device_get_origin, "fl_paged_device_get_origin"); pragma Inline (fl_paged_device_get_origin); procedure fl_paged_device_set_origin - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_paged_device_set_origin, "fl_paged_device_set_origin"); pragma Inline (fl_paged_device_set_origin); procedure fl_paged_device_rotate - (D : in System.Address; + (D : in Storage.Integer_Address; R : in Interfaces.C.C_float); pragma Import (C, fl_paged_device_rotate, "fl_paged_device_rotate"); pragma Inline (fl_paged_device_rotate); procedure fl_paged_device_scale - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.C_float); pragma Import (C, fl_paged_device_scale, "fl_paged_device_scale"); pragma Inline (fl_paged_device_scale); procedure fl_paged_device_translate - (D : in System.Address; + (D : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_paged_device_translate, "fl_paged_device_translate"); pragma Inline (fl_paged_device_translate); procedure fl_paged_device_untranslate - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, fl_paged_device_untranslate, "fl_paged_device_untranslate"); pragma Inline (fl_paged_device_untranslate); @@ -113,19 +111,19 @@ package body FLTK.Devices.Surfaces.Paged is procedure fl_paged_device_print_widget - (D, I : in System.Address; + (D, I : in Storage.Integer_Address; DX, DY : in Interfaces.C.int); pragma Import (C, fl_paged_device_print_widget, "fl_paged_device_print_widget"); pragma Inline (fl_paged_device_print_widget); procedure fl_paged_device_print_window - (D, I : in System.Address; + (D, I : in Storage.Integer_Address; DX, DY : in Interfaces.C.int); pragma Import (C, fl_paged_device_print_window, "fl_paged_device_print_window"); pragma Inline (fl_paged_device_print_window); procedure fl_paged_device_print_window_part - (D, I : in System.Address; + (D, I : in Storage.Integer_Address; X, Y, W, H, DX, DY : in Interfaces.C.int); pragma Import (C, fl_paged_device_print_window_part, "fl_paged_device_print_window_part"); pragma Inline (fl_paged_device_print_window_part); @@ -136,11 +134,11 @@ package body FLTK.Devices.Surfaces.Paged is procedure Finalize (This : in out Paged_Surface) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Paged_Surface'Class then free_fl_paged_device (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Surface_Device (This)); end Finalize; diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb index 400bd87..7a43369 100644 --- a/src/fltk-devices-surfaces.adb +++ b/src/fltk-devices-surfaces.adb @@ -1,25 +1,16 @@ -with - - System; - -use type - - System.Address; - - package body FLTK.Devices.Surfaces is function new_fl_surface - (G : in System.Address) - return System.Address; + (G : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, new_fl_surface, "new_fl_surface"); pragma Inline (new_fl_surface); procedure free_fl_surface - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_surface, "free_fl_surface"); pragma Inline (free_fl_surface); @@ -27,12 +18,12 @@ package body FLTK.Devices.Surfaces is procedure fl_surface_set_current - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_surface_set_current, "fl_surface_set_current"); pragma Inline (fl_surface_set_current); function fl_surface_get_surface - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_surface_get_surface, "fl_surface_get_surface"); pragma Inline (fl_surface_get_surface); @@ -42,13 +33,13 @@ package body FLTK.Devices.Surfaces is procedure Finalize (This : in out Surface_Device) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Surface_Device'Class then if This.Needs_Dealloc then free_fl_surface (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Device (This)); end Finalize; diff --git a/src/fltk-dialogs.adb b/src/fltk-dialogs.adb index 349fd1f..414c1da 100644 --- a/src/fltk-dialogs.adb +++ b/src/fltk-dialogs.adb @@ -2,8 +2,7 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type @@ -105,7 +104,7 @@ package body FLTK.Dialogs is pragma Inline (dialog_fl_message_font); function dialog_fl_message_icon - return System.Address; + return Storage.Integer_Address; pragma Import (C, dialog_fl_message_icon, "dialog_fl_message_icon"); pragma Inline (dialog_fl_message_icon); diff --git a/src/fltk-draw.adb b/src/fltk-draw.adb index df2af30..1459e68 100644 --- a/src/fltk-draw.adb +++ b/src/fltk-draw.adb @@ -3,14 +3,12 @@ with Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.size_t, - System.Address; + Interfaces.C.size_t; package body FLTK.Draw is @@ -23,7 +21,7 @@ package body FLTK.Draw is procedure fl_draw_set_spot (F, S : in Interfaces.C.int; X, Y, W, H : in Interfaces.C.int; - Ptr : in System.Address); + Ptr : in Storage.Integer_Address); pragma Import (C, fl_draw_set_spot, "fl_draw_set_spot"); pragma Inline (fl_draw_set_spot); @@ -265,36 +263,36 @@ package body FLTK.Draw is procedure fl_draw_draw_image - (Buf : in System.Address; + (Buf : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; D, L : in Interfaces.C.int); pragma Import (C, fl_draw_draw_image, "fl_draw_draw_image"); pragma Inline (fl_draw_draw_image); procedure fl_draw_draw_image2 - (Call, User : in System.Address; + (Call, User : in Storage.Integer_Address; X, Y, W, H, D : in Interfaces.C.int); pragma Import (C, fl_draw_draw_image2, "fl_draw_draw_image2"); pragma Inline (fl_draw_draw_image2); procedure fl_draw_draw_image_mono - (Buf : in System.Address; + (Buf : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; D, L : in Interfaces.C.int); pragma Import (C, fl_draw_draw_image_mono, "fl_draw_draw_image_mono"); pragma Inline (fl_draw_draw_image_mono); procedure fl_draw_draw_image_mono2 - (Call, User : in System.Address; + (Call, User : in Storage.Integer_Address; X, Y, W, H, D : in Interfaces.C.int); pragma Import (C, fl_draw_draw_image_mono2, "fl_draw_draw_image_mono2"); pragma Inline (fl_draw_draw_image_mono2); function fl_draw_read_image - (Buf : in System.Address; + (Buf : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; Alpha : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_draw_read_image, "fl_draw_read_image"); pragma Inline (fl_draw_read_image); @@ -303,7 +301,7 @@ package body FLTK.Draw is function fl_draw_add_symbol (Name : in Interfaces.C.char_array; - Drawit : in System.Address; + Drawit : in Storage.Integer_Address; Scalable : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_draw_add_symbol, "fl_draw_add_symbol"); @@ -319,7 +317,7 @@ package body FLTK.Draw is (Str : in Interfaces.C.char_array; X, Y, W, H : in Interfaces.C.int; Ali : in Interfaces.Unsigned_16; - Img : in System.Address; + Img : in Storage.Integer_Address; Sym : in Interfaces.C.int); pragma Import (C, fl_draw_draw_text2, "fl_draw_draw_text2"); pragma Inline (fl_draw_draw_text2); @@ -328,8 +326,8 @@ package body FLTK.Draw is (Str : in Interfaces.C.char_array; X, Y, W, H : in Interfaces.C.int; Ali : in Interfaces.Unsigned_16; - Func : in System.Address; - Img : in System.Address; + Func : in Storage.Integer_Address; + Img : in Storage.Integer_Address; Sym : in Interfaces.C.int); pragma Import (C, fl_draw_draw_text3, "fl_draw_draw_text3"); pragma Inline (fl_draw_draw_text3); @@ -372,7 +370,7 @@ package body FLTK.Draw is procedure fl_draw_scroll (X, Y, W, H : in Interfaces.C.int; DX, DY : in Interfaces.C.int; - Func, Data : in System.Address); + Func, Data : in Storage.Integer_Address); pragma Import (C, fl_draw_scroll, "fl_draw_scroll"); pragma Inline (fl_draw_scroll); @@ -623,7 +621,7 @@ package body FLTK.Draw is Interfaces.C.int (Y), Interfaces.C.int (W), Interfaces.C.int (H), - System.Null_Address); + Null_Pointer); end Set_Spot; @@ -1092,7 +1090,7 @@ package body FLTK.Draw is end if; end if; fl_draw_draw_image - (Data (Data'First)'Address, + (Storage.To_Integer (Data (Data'First)'Address), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1105,12 +1103,12 @@ package body FLTK.Draw is Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Hook - (User : in System.Address; + (User : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; - Buf_Ptr : in System.Address) + Buf_Ptr : in Storage.Integer_Address) is Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Buf_Ptr; + for Data_Buffer'Address use Storage.To_Address (Buf_Ptr); pragma Import (Ada, Data_Buffer); begin Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer); @@ -1123,8 +1121,8 @@ package body FLTK.Draw is begin Image_Func_Ptr := Callback; fl_draw_draw_image2 - (Draw_Image_Hook'Address, - System.Null_Address, + (Storage.To_Integer (Draw_Image_Hook'Address), + Null_Pointer, Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1155,7 +1153,7 @@ package body FLTK.Draw is end if; end if; fl_draw_draw_image_mono - (Data (Data'First)'Address, + (Storage.To_Integer (Data (Data'First)'Address), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1168,12 +1166,12 @@ package body FLTK.Draw is Mono_Image_Func_Ptr : Image_Draw_Function; procedure Draw_Image_Mono_Hook - (User : in System.Address; + (User : in Storage.Integer_Address; X, Y, W : in Interfaces.C.int; - Buf_Ptr : in System.Address) + Buf_Ptr : in Storage.Integer_Address) is Data_Buffer : Color_Component_Array (1 .. Integer (W)); - for Data_Buffer'Address use Buf_Ptr; + for Data_Buffer'Address use Storage.To_Address (Buf_Ptr); pragma Import (Ada, Data_Buffer); begin Mono_Image_Func_Ptr (Integer (X), Integer (Y), Data_Buffer); @@ -1186,8 +1184,8 @@ package body FLTK.Draw is begin Mono_Image_Func_Ptr := Callback; fl_draw_draw_image_mono2 - (Draw_Image_Mono_Hook'Address, - System.Null_Address, + (Storage.To_Integer (Draw_Image_Mono_Hook'Address), + Null_Pointer, Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), @@ -1203,16 +1201,16 @@ package body FLTK.Draw is is My_Len : Integer := (if Alpha = 0 then W * H * 3 else W * H * 4); Result : Color_Component_Array (1 .. My_Len); - Buffer : System.Address; + Buffer : Storage.Integer_Address; begin Buffer := fl_draw_read_image - (Result (Result'First)'Address, + (Storage.To_Integer (Result (Result'First)'Address), Interfaces.C.int (X), Interfaces.C.int (Y), Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.C.int (Alpha)); - if Buffer /= Result (Result'First)'Address then + if Buffer /= Storage.To_Integer (Result (Result'First)'Address) then raise Program_Error; end if; return Result; @@ -1232,7 +1230,7 @@ package body FLTK.Draw is is Ret_Val : Interfaces.C.int := fl_draw_add_symbol (Interfaces.C.To_C (Text), - Callback.all'Address, + Storage.To_Integer (Callback.all'Address), Boolean'Pos (Scalable)); begin if Ret_Val = 0 then @@ -1267,7 +1265,7 @@ package body FLTK.Draw is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.Unsigned_16 (Align), - System.Null_Address, + Null_Pointer, Boolean'Pos (Symbols)); end Draw_Text; @@ -1294,11 +1292,11 @@ package body FLTK.Draw is Text_Func_Ptr : Text_Draw_Function; procedure Draw_Text_Hook - (Ptr : in System.Address; + (Ptr : in Storage.Integer_Address; N, X0, Y0 : in Interfaces.C.int) is Data : String (1 .. Integer (N)); - for Data'Address use Ptr; + for Data'Address use Storage.To_Address (Ptr); pragma Import (Ada, Data); begin Text_Func_Ptr (Integer (X0), Integer (Y0), Data); @@ -1320,8 +1318,8 @@ package body FLTK.Draw is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.Unsigned_16 (Align), - Draw_Text_Hook'Address, - System.Null_Address, + Storage.To_Integer (Draw_Text_Hook'Address), + Null_Pointer, Boolean'Pos (Symbols)); end Draw_Text; @@ -1342,7 +1340,7 @@ package body FLTK.Draw is Interfaces.C.int (W), Interfaces.C.int (H), Interfaces.Unsigned_16 (Align), - Draw_Text_Hook'Address, + Storage.To_Integer (Draw_Text_Hook'Address), Wrapper (Picture).Void_Ptr, Boolean'Pos (Symbols)); end Draw_Text; @@ -1448,8 +1446,8 @@ package body FLTK.Draw is Interfaces.C.int (H), Interfaces.C.int (DX), Interfaces.C.int (DY), - Scroll_Hook'Address, - Callback.all'Address); + Storage.To_Integer (Scroll_Hook'Address), + Storage.To_Integer (Callback.all'Address)); end Scroll; diff --git a/src/fltk-environment.adb b/src/fltk-environment.adb index ae832c0..38de29a 100644 --- a/src/fltk-environment.adb +++ b/src/fltk-environment.adb @@ -2,14 +2,12 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Environment is @@ -17,12 +15,12 @@ package body FLTK.Environment is function new_fl_preferences (P, V, A : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_preferences, "new_fl_preferences"); pragma Inline (new_fl_preferences); procedure free_fl_preferences - (E : in System.Address); + (E : in Storage.Integer_Address); pragma Import (C, free_fl_preferences, "free_fl_preferences"); pragma Inline (free_fl_preferences); @@ -30,27 +28,27 @@ package body FLTK.Environment is function fl_preferences_entries - (E : in System.Address) + (E : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_preferences_entries, "fl_preferences_entries"); pragma Inline (fl_preferences_entries); function fl_preferences_entry - (E : in System.Address; + (E : in Storage.Integer_Address; I : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_preferences_entry, "fl_preferences_entry"); pragma Inline (fl_preferences_entry); function fl_preferences_entryexists - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, fl_preferences_entryexists, "fl_preferences_entryexists"); pragma Inline (fl_preferences_entryexists); function fl_preferences_size - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, fl_preferences_size, "fl_preferences_size"); @@ -60,7 +58,7 @@ package body FLTK.Environment is function fl_preferences_get_int - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : out Interfaces.C.int; D : in Interfaces.C.int) @@ -69,7 +67,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_get_int); function fl_preferences_get_float - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : out Interfaces.C.C_float; D : in Interfaces.C.C_float) @@ -78,7 +76,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_get_float); function fl_preferences_get_double - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : out Interfaces.C.double; D : in Interfaces.C.double) @@ -87,7 +85,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_get_double); function fl_preferences_get_str - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : out Interfaces.C.Strings.chars_ptr; D : in Interfaces.C.char_array) @@ -99,7 +97,7 @@ package body FLTK.Environment is function fl_preferences_set_int - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.int) return Interfaces.C.int; @@ -107,7 +105,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_set_int); function fl_preferences_set_float - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.C_float) return Interfaces.C.int; @@ -115,7 +113,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_set_float); function fl_preferences_set_float_prec - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.C_float; P : in Interfaces.C.int) @@ -124,7 +122,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_set_float_prec); function fl_preferences_set_double - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.double) return Interfaces.C.int; @@ -132,7 +130,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_set_double); function fl_preferences_set_double_prec - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.double; P : in Interfaces.C.int) @@ -141,7 +139,7 @@ package body FLTK.Environment is pragma Inline (fl_preferences_set_double_prec); function fl_preferences_set_str - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array; V : in Interfaces.C.char_array) return Interfaces.C.int; @@ -152,20 +150,20 @@ package body FLTK.Environment is function fl_preferences_deleteentry - (E : in System.Address; + (E : in Storage.Integer_Address; K : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, fl_preferences_deleteentry, "fl_preferences_deleteentry"); pragma Inline (fl_preferences_deleteentry); function fl_preferences_deleteallentries - (E : in System.Address) + (E : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_preferences_deleteallentries, "fl_preferences_deleteallentries"); pragma Inline (fl_preferences_deleteallentries); function fl_preferences_clear - (E : in System.Address) + (E : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_preferences_clear, "fl_preferences_clear"); pragma Inline (fl_preferences_clear); @@ -174,7 +172,7 @@ package body FLTK.Environment is procedure fl_preferences_flush - (E : in System.Address); + (E : in Storage.Integer_Address); pragma Import (C, fl_preferences_flush, "fl_preferences_flush"); pragma Inline (fl_preferences_flush); @@ -184,11 +182,11 @@ package body FLTK.Environment is procedure Finalize (This : in out Preferences) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Preferences'Class then free_fl_preferences (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; end Finalize; diff --git a/src/fltk-event.adb b/src/fltk-event.adb index bbad8ba..5ae79e3 100644 --- a/src/fltk-event.adb +++ b/src/fltk-event.adb @@ -2,33 +2,31 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Event is procedure fl_event_add_handler - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, fl_event_add_handler, "fl_event_add_handler"); pragma Inline (fl_event_add_handler); procedure fl_event_set_event_dispatch - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, fl_event_set_event_dispatch, "fl_event_set_event_dispatch"); pragma Inline (fl_event_set_event_dispatch); -- actually handle_ but can't have an underscore on the end of an identifier function fl_event_handle (E : in Interfaces.C.int; - W : in System.Address) + W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_event_handle, "fl_event_handle"); pragma Inline (fl_event_handle); @@ -37,42 +35,42 @@ package body FLTK.Event is function fl_event_get_grab - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_event_get_grab, "fl_event_get_grab"); pragma Inline (fl_event_get_grab); procedure fl_event_set_grab - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, fl_event_set_grab, "fl_event_set_grab"); pragma Inline (fl_event_set_grab); function fl_event_get_pushed - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_event_get_pushed, "fl_event_get_pushed"); pragma Inline (fl_event_get_pushed); procedure fl_event_set_pushed - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, fl_event_set_pushed, "fl_event_set_pushed"); pragma Inline (fl_event_set_pushed); function fl_event_get_belowmouse - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_event_get_belowmouse, "fl_event_get_belowmouse"); pragma Inline (fl_event_get_belowmouse); procedure fl_event_set_belowmouse - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, fl_event_set_belowmouse, "fl_event_set_belowmouse"); pragma Inline (fl_event_set_belowmouse); function fl_event_get_focus - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_event_get_focus, "fl_event_get_focus"); pragma Inline (fl_event_get_focus); procedure fl_event_set_focus - (To : in System.Address); + (To : in Storage.Integer_Address); pragma Import (C, fl_event_set_focus, "fl_event_set_focus"); pragma Inline (fl_event_set_focus); @@ -263,14 +261,15 @@ package body FLTK.Event is -- function Dispatch_Hook -- (Num : in Interfaces.C.int; - -- Ptr : in System.Address) + -- Ptr : in Storage.Integer_Address) -- return Interfaces.C.int -- is -- Ret_Val : Event_Outcome; -- Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; -- begin - -- if Ptr /= System.Null_Address then - -- Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Ptr)); + -- if Ptr /= Null_Pointer then + -- Actual_Window := Window_Convert.To_Pointer + -- (Storage.To_Address (fl_widget_get_user_data (Ptr))); -- end if; -- if Current_Dispatch = null then -- Ret_Val := Default_Dispatch (Event_Kind'Val (Num), Actual_Window); @@ -327,7 +326,7 @@ package body FLTK.Event is -- begin -- if Win = null then -- return Event_Outcome'Val (fl_event_handle - -- (Event_Kind'Pos (Event), System.Null_Address)); + -- (Event_Kind'Pos (Event), Null_Pointer)); -- else -- return Event_Outcome'Val (fl_event_handle -- (Event_Kind'Pos (Event), @@ -341,7 +340,8 @@ package body FLTK.Event is function Get_Grab return access FLTK.Widgets.Groups.Windows.Window'Class is begin - return Window_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_grab)); + return Window_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_event_get_grab))); end Get_Grab; @@ -354,14 +354,15 @@ package body FLTK.Event is procedure Release_Grab is begin - fl_event_set_grab (System.Null_Address); + fl_event_set_grab (Null_Pointer); end Release_Grab; function Get_Pushed return access FLTK.Widgets.Widget'Class is begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_pushed)); + return Widget_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_event_get_pushed))); end Get_Pushed; @@ -375,7 +376,8 @@ package body FLTK.Event is function Get_Below_Mouse return access FLTK.Widgets.Widget'Class is begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_belowmouse)); + return Widget_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_event_get_belowmouse))); end Get_Below_Mouse; @@ -389,7 +391,8 @@ package body FLTK.Event is function Get_Focus return access FLTK.Widgets.Widget'Class is begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_event_get_focus)); + return Widget_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_event_get_focus))); end Get_Focus; @@ -635,8 +638,8 @@ package body FLTK.Event is begin - fl_event_add_handler (Event_Handler_Hook'Address); - -- fl_event_set_event_dispatch (Dispatch_Hook'Address); + fl_event_add_handler (Storage.To_Integer (Event_Handler_Hook'Address)); + -- fl_event_set_event_dispatch (Storage.To_Integer (Dispatch_Hook'Address)); end FLTK.Event; diff --git a/src/fltk-event.ads b/src/fltk-event.ads index f103091..bcd05bb 100644 --- a/src/fltk-event.ads +++ b/src/fltk-event.ads @@ -196,8 +196,8 @@ private function fl_widget_get_user_data - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); pragma Inline (fl_widget_get_user_data); diff --git a/src/fltk-images-bitmaps-xbm.adb b/src/fltk-images-bitmaps-xbm.adb index d8059ff..a7f632c 100644 --- a/src/fltk-images-bitmaps-xbm.adb +++ b/src/fltk-images-bitmaps-xbm.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Bitmaps.XBM is @@ -15,12 +10,12 @@ package body FLTK.Images.Bitmaps.XBM is function new_fl_xbm_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_xbm_image, "new_fl_xbm_image"); pragma Inline (new_fl_xbm_image); procedure free_fl_xbm_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_xbm_image, "free_fl_xbm_image"); pragma Inline (free_fl_xbm_image); @@ -30,11 +25,11 @@ package body FLTK.Images.Bitmaps.XBM is overriding procedure Finalize (This : in out XBM_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in XBM_Image'Class then free_fl_xbm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Bitmap (This)); end Finalize; diff --git a/src/fltk-images-bitmaps.adb b/src/fltk-images-bitmaps.adb index 3ddfa93..0bea597 100644 --- a/src/fltk-images-bitmaps.adb +++ b/src/fltk-images-bitmaps.adb @@ -2,39 +2,34 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Bitmaps is function new_fl_bitmap - (D : in System.Address; + (D : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_bitmap, "new_fl_bitmap"); pragma Inline (new_fl_bitmap); procedure free_fl_bitmap - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, free_fl_bitmap, "free_fl_bitmap"); pragma Inline (free_fl_bitmap); function fl_bitmap_copy - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_bitmap_copy, "fl_bitmap_copy"); pragma Inline (fl_bitmap_copy); function fl_bitmap_copy2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_bitmap_copy2, "fl_bitmap_copy2"); pragma Inline (fl_bitmap_copy2); @@ -42,7 +37,7 @@ package body FLTK.Images.Bitmaps is procedure fl_bitmap_uncache - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_bitmap_uncache, "fl_bitmap_uncache"); pragma Inline (fl_bitmap_uncache); @@ -50,13 +45,13 @@ package body FLTK.Images.Bitmaps is procedure fl_bitmap_draw2 - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_bitmap_draw2, "fl_bitmap_draw2"); pragma Inline (fl_bitmap_draw2); procedure fl_bitmap_draw - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H, CX, CY : in Interfaces.C.int); pragma Import (C, fl_bitmap_draw, "fl_bitmap_draw"); pragma Inline (fl_bitmap_draw); @@ -67,11 +62,11 @@ package body FLTK.Images.Bitmaps is overriding procedure Finalize (This : in out Bitmap) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Bitmap'Class then free_fl_bitmap (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Image (This)); end Finalize; @@ -92,7 +87,7 @@ package body FLTK.Images.Bitmaps is begin return This : Bitmap do This.Void_Ptr := new_fl_bitmap - (Data (Data'First)'Address, + (Storage.To_Integer (Data (Data'First)'Address), Interfaces.C.int (Width), Interfaces.C.int (Height)); case fl_image_fail (This.Void_Ptr) is diff --git a/src/fltk-images-pixmaps-gif.adb b/src/fltk-images-pixmaps-gif.adb index 546ed3e..0a90d70 100644 --- a/src/fltk-images-pixmaps-gif.adb +++ b/src/fltk-images-pixmaps-gif.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Pixmaps.GIF is @@ -15,12 +10,12 @@ package body FLTK.Images.Pixmaps.GIF is function new_fl_gif_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_gif_image, "new_fl_gif_image"); pragma Inline (new_fl_gif_image); procedure free_fl_gif_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_gif_image, "free_fl_gif_image"); pragma Inline (free_fl_gif_image); @@ -30,11 +25,11 @@ package body FLTK.Images.Pixmaps.GIF is overriding procedure Finalize (This : in out GIF_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in GIF_Image'Class then free_fl_gif_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Pixmap (This)); end Finalize; diff --git a/src/fltk-images-pixmaps-xpm.adb b/src/fltk-images-pixmaps-xpm.adb index 136aee9..0392a36 100644 --- a/src/fltk-images-pixmaps-xpm.adb +++ b/src/fltk-images-pixmaps-xpm.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Pixmaps.XPM is @@ -15,12 +10,12 @@ package body FLTK.Images.Pixmaps.XPM is function new_fl_xpm_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_xpm_image, "new_fl_xpm_image"); pragma Inline (new_fl_xpm_image); procedure free_fl_xpm_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_xpm_image, "free_fl_xpm_image"); pragma Inline (free_fl_xpm_image); @@ -30,11 +25,11 @@ package body FLTK.Images.Pixmaps.XPM is overriding procedure Finalize (This : in out XPM_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in XPM_Image'Class then free_fl_xpm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Pixmap (This)); end Finalize; diff --git a/src/fltk-images-pixmaps.adb b/src/fltk-images-pixmaps.adb index c8db506..a3e0d71 100644 --- a/src/fltk-images-pixmaps.adb +++ b/src/fltk-images-pixmaps.adb @@ -2,32 +2,27 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Pixmaps is procedure free_fl_pixmap - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, free_fl_pixmap, "free_fl_pixmap"); pragma Inline (free_fl_pixmap); function fl_pixmap_copy - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_pixmap_copy, "fl_pixmap_copy"); pragma Inline (fl_pixmap_copy); function fl_pixmap_copy2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_pixmap_copy2, "fl_pixmap_copy2"); pragma Inline (fl_pixmap_copy2); @@ -35,14 +30,14 @@ package body FLTK.Images.Pixmaps is procedure fl_pixmap_color_average - (I : in System.Address; + (I : in Storage.Integer_Address; C : in Interfaces.C.int; B : in Interfaces.C.C_float); pragma Import (C, fl_pixmap_color_average, "fl_pixmap_color_average"); pragma Inline (fl_pixmap_color_average); procedure fl_pixmap_desaturate - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_pixmap_desaturate, "fl_pixmap_desaturate"); pragma Inline (fl_pixmap_desaturate); @@ -50,7 +45,7 @@ package body FLTK.Images.Pixmaps is procedure fl_pixmap_uncache - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_pixmap_uncache, "fl_pixmap_uncache"); pragma Inline (fl_pixmap_uncache); @@ -58,13 +53,13 @@ package body FLTK.Images.Pixmaps is procedure fl_pixmap_draw2 - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_pixmap_draw2, "fl_pixmap_draw2"); pragma Inline (fl_pixmap_draw2); procedure fl_pixmap_draw - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H, CX, CY : in Interfaces.C.int); pragma Import (C, fl_pixmap_draw, "fl_pixmap_draw"); pragma Inline (fl_pixmap_draw); @@ -75,11 +70,11 @@ package body FLTK.Images.Pixmaps is overriding procedure Finalize (This : in out Pixmap) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Pixmap'Class then free_fl_pixmap (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-bmp.adb b/src/fltk-images-rgb-bmp.adb index 6a982d0..13858d8 100644 --- a/src/fltk-images-rgb-bmp.adb +++ b/src/fltk-images-rgb-bmp.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.RGB.BMP is @@ -15,12 +10,12 @@ package body FLTK.Images.RGB.BMP is function new_fl_bmp_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_bmp_image, "new_fl_bmp_image"); pragma Inline (new_fl_bmp_image); procedure free_fl_bmp_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_bmp_image, "free_fl_bmp_image"); pragma Inline (free_fl_bmp_image); @@ -30,11 +25,11 @@ package body FLTK.Images.RGB.BMP is overriding procedure Finalize (This : in out BMP_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in BMP_Image'Class then free_fl_bmp_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb-jpeg.adb b/src/fltk-images-rgb-jpeg.adb index 9d7afe1..b7f98b1 100644 --- a/src/fltk-images-rgb-jpeg.adb +++ b/src/fltk-images-rgb-jpeg.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.RGB.JPEG is @@ -15,19 +10,19 @@ package body FLTK.Images.RGB.JPEG is function new_fl_jpeg_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_jpeg_image, "new_fl_jpeg_image"); pragma Inline (new_fl_jpeg_image); function new_fl_jpeg_image2 (N : in Interfaces.C.char_array; - D : in System.Address) - return System.Address; + D : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, new_fl_jpeg_image2, "new_fl_jpeg_image2"); pragma Inline (new_fl_jpeg_image2); procedure free_fl_jpeg_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_jpeg_image, "free_fl_jpeg_image"); pragma Inline (free_fl_jpeg_image); @@ -37,11 +32,11 @@ package body FLTK.Images.RGB.JPEG is overriding procedure Finalize (This : in out JPEG_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in JPEG_Image'Class then free_fl_jpeg_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (RGB_Image (This)); end Finalize; @@ -79,7 +74,7 @@ package body FLTK.Images.RGB.JPEG is return This : JPEG_Image do This.Void_Ptr := new_fl_jpeg_image2 (Interfaces.C.To_C (Name), - Data (Data'First)'Address); + Storage.To_Integer (Data (Data'First)'Address)); case fl_image_fail (This.Void_Ptr) is when 1 => raise No_Image_Error; when 2 => raise File_Access_Error; diff --git a/src/fltk-images-rgb-png.adb b/src/fltk-images-rgb-png.adb index 6023f82..9ae9984 100644 --- a/src/fltk-images-rgb-png.adb +++ b/src/fltk-images-rgb-png.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.RGB.PNG is @@ -15,20 +10,20 @@ package body FLTK.Images.RGB.PNG is function new_fl_png_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_png_image, "new_fl_png_image"); pragma Inline (new_fl_png_image); function new_fl_png_image2 (N : in Interfaces.C.char_array; - D : in System.Address; + D : in Storage.Integer_Address; S : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_png_image2, "new_fl_png_image2"); pragma Inline (new_fl_png_image2); procedure free_fl_png_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_png_image, "free_fl_png_image"); pragma Inline (free_fl_png_image); @@ -38,11 +33,11 @@ package body FLTK.Images.RGB.PNG is overriding procedure Finalize (This : in out PNG_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in PNG_Image'Class then free_fl_png_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (RGB_Image (This)); end Finalize; @@ -80,7 +75,7 @@ package body FLTK.Images.RGB.PNG is return This : PNG_Image do This.Void_Ptr := new_fl_png_image2 (Interfaces.C.To_C (Name), - Data (Data'First)'Address, + Storage.To_Integer (Data (Data'First)'Address), Data'Length); case fl_image_fail (This.Void_Ptr) is when 1 => raise No_Image_Error; diff --git a/src/fltk-images-rgb-pnm.adb b/src/fltk-images-rgb-pnm.adb index 6b0e515..bc13545 100644 --- a/src/fltk-images-rgb-pnm.adb +++ b/src/fltk-images-rgb-pnm.adb @@ -2,12 +2,7 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.RGB.PNM is @@ -15,12 +10,12 @@ package body FLTK.Images.RGB.PNM is function new_fl_pnm_image (F : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_pnm_image, "new_fl_pnm_image"); pragma Inline (new_fl_pnm_image); procedure free_fl_pnm_image - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_pnm_image, "free_fl_pnm_image"); pragma Inline (free_fl_pnm_image); @@ -30,11 +25,11 @@ package body FLTK.Images.RGB.PNM is overriding procedure Finalize (This : in out PNM_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in PNM_Image'Class then free_fl_pnm_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (RGB_Image (This)); end Finalize; diff --git a/src/fltk-images-rgb.adb b/src/fltk-images-rgb.adb index 4382e93..69e1572 100644 --- a/src/fltk-images-rgb.adb +++ b/src/fltk-images-rgb.adb @@ -2,33 +2,28 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.RGB is function new_fl_rgb_image - (Data : in System.Address; + (Data : in Storage.Integer_Address; W, H, D, L : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_rgb_image, "new_fl_rgb_image"); pragma Inline (new_fl_rgb_image); function new_fl_rgb_image2 - (P : in System.Address; + (P : in Storage.Integer_Address; C : in Interfaces.C.unsigned) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_rgb_image2, "new_fl_rgb_image2"); pragma Inline (new_fl_rgb_image2); procedure free_fl_rgb_image - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, free_fl_rgb_image, "free_fl_rgb_image"); pragma Inline (free_fl_rgb_image); @@ -43,15 +38,15 @@ package body FLTK.Images.RGB is pragma Inline (fl_rgb_image_set_max_size); function fl_rgb_image_copy - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_rgb_image_copy, "fl_rgb_image_copy"); pragma Inline (fl_rgb_image_copy); function fl_rgb_image_copy2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_rgb_image_copy2, "fl_rgb_image_copy2"); pragma Inline (fl_rgb_image_copy2); @@ -59,14 +54,14 @@ package body FLTK.Images.RGB is procedure fl_rgb_image_color_average - (I : in System.Address; + (I : in Storage.Integer_Address; C : in Interfaces.C.int; B : in Interfaces.C.C_float); pragma Import (C, fl_rgb_image_color_average, "fl_rgb_image_color_average"); pragma Inline (fl_rgb_image_color_average); procedure fl_rgb_image_desaturate - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_rgb_image_desaturate, "fl_rgb_image_desaturate"); pragma Inline (fl_rgb_image_desaturate); @@ -74,7 +69,7 @@ package body FLTK.Images.RGB is procedure fl_rgb_image_uncache - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_rgb_image_uncache, "fl_rgb_image_uncache"); pragma Inline (fl_rgb_image_uncache); @@ -82,13 +77,13 @@ package body FLTK.Images.RGB is procedure fl_rgb_image_draw2 - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_rgb_image_draw2, "fl_rgb_image_draw2"); pragma Inline (fl_rgb_image_draw2); procedure fl_rgb_image_draw - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H, CX, CY : in Interfaces.C.int); pragma Import (C, fl_rgb_image_draw, "fl_rgb_image_draw"); pragma Inline (fl_rgb_image_draw); @@ -99,11 +94,11 @@ package body FLTK.Images.RGB is overriding procedure Finalize (This : in out RGB_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in RGB_Image'Class then free_fl_rgb_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Image (This)); end Finalize; @@ -126,7 +121,7 @@ package body FLTK.Images.RGB is begin return This : RGB_Image do This.Void_Ptr := new_fl_rgb_image - (Data (Data'First)'Address, + (Storage.To_Integer (Data (Data'First)'Address), Interfaces.C.int (Width), Interfaces.C.int (Height), Interfaces.C.int (Depth), diff --git a/src/fltk-images-shared.adb b/src/fltk-images-shared.adb index 24bc014..bbd482c 100644 --- a/src/fltk-images-shared.adb +++ b/src/fltk-images-shared.adb @@ -2,14 +2,12 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Images.Shared is @@ -18,38 +16,38 @@ package body FLTK.Images.Shared is function fl_shared_image_get (F : in Interfaces.C.char_array; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_shared_image_get, "fl_shared_image_get"); pragma Inline (fl_shared_image_get); function fl_shared_image_get2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_shared_image_get2, "fl_shared_image_get2"); pragma Inline (fl_shared_image_get2); function fl_shared_image_find (N : in Interfaces.C.char_array; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_shared_image_find, "fl_shared_image_find"); pragma Inline (fl_shared_image_find); procedure fl_shared_image_release - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_shared_image_release, "fl_shared_image_release"); pragma Inline (fl_shared_image_release); function fl_shared_image_copy - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_shared_image_copy, "fl_shared_image_copy"); pragma Inline (fl_shared_image_copy); function fl_shared_image_copy2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_shared_image_copy2, "fl_shared_image_copy2"); pragma Inline (fl_shared_image_copy2); @@ -57,14 +55,14 @@ package body FLTK.Images.Shared is procedure fl_shared_image_color_average - (I : in System.Address; + (I : in Storage.Integer_Address; C : in Interfaces.C.int; B : in Interfaces.C.C_float); pragma Import (C, fl_shared_image_color_average, "fl_shared_image_color_average"); pragma Inline (fl_shared_image_color_average); procedure fl_shared_image_desaturate - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_shared_image_desaturate, "fl_shared_image_desaturate"); pragma Inline (fl_shared_image_desaturate); @@ -77,30 +75,30 @@ package body FLTK.Images.Shared is pragma Inline (fl_shared_image_num_images); function fl_shared_image_name - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_shared_image_name, "fl_shared_image_name"); pragma Inline (fl_shared_image_name); function fl_shared_image_original - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_shared_image_original, "fl_shared_image_original"); pragma Inline (fl_shared_image_original); function fl_shared_image_refcount - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_shared_image_refcount, "fl_shared_image_refcount"); pragma Inline (fl_shared_image_refcount); procedure fl_shared_image_reload - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_shared_image_reload, "fl_shared_image_reload"); pragma Inline (fl_shared_image_reload); procedure fl_shared_image_uncache - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_shared_image_uncache, "fl_shared_image_uncache"); pragma Inline (fl_shared_image_uncache); @@ -113,19 +111,19 @@ package body FLTK.Images.Shared is pragma Inline (fl_shared_image_scaling_algorithm); procedure fl_shared_image_scale - (I : in System.Address; + (I : in Storage.Integer_Address; W, H, P, E : in Interfaces.C.int); pragma Import (C, fl_shared_image_scale, "fl_shared_image_scale"); pragma Inline (fl_shared_image_scale); procedure fl_shared_image_draw - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H, CX, CY : in Interfaces.C.int); pragma Import (C, fl_shared_image_draw, "fl_shared_image_draw"); pragma Inline (fl_shared_image_draw); procedure fl_shared_image_draw2 - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_shared_image_draw2, "fl_shared_image_draw2"); pragma Inline (fl_shared_image_draw2); @@ -136,11 +134,11 @@ package body FLTK.Images.Shared is overriding procedure Finalize (This : in out Shared_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Shared_Image'Class then fl_shared_image_release (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Image (This)); end Finalize; @@ -188,7 +186,7 @@ package body FLTK.Images.Shared is (Interfaces.C.To_C (Name), Interfaces.C.int (W), Interfaces.C.int (H)); - if This.Void_Ptr = System.Null_Address then + if This.Void_Ptr = Null_Pointer then raise No_Image_Error; end if; end return; diff --git a/src/fltk-images-tiled.adb b/src/fltk-images-tiled.adb index fd4b9ed..6e85ce5 100644 --- a/src/fltk-images-tiled.adb +++ b/src/fltk-images-tiled.adb @@ -2,39 +2,34 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Images.Tiled is function new_fl_tiled_image - (T : in System.Address; + (T : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_tiled_image, "new_fl_tiled_image"); pragma Inline (new_fl_tiled_image); procedure free_fl_tiled_image - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, free_fl_tiled_image, "free_fl_tiled_image"); pragma Inline (free_fl_tiled_image); function fl_tiled_image_copy - (T : in System.Address; + (T : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_tiled_image_copy, "fl_tiled_image_copy"); pragma Inline (fl_tiled_image_copy); function fl_tiled_image_copy2 - (T : in System.Address) - return System.Address; + (T : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_tiled_image_copy2, "fl_tiled_image_copy2"); pragma Inline (fl_tiled_image_copy2); @@ -42,8 +37,8 @@ package body FLTK.Images.Tiled is function fl_tiled_image_get_image - (T : in System.Address) - return System.Address; + (T : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_tiled_image_get_image, "fl_tiled_image_get_image"); pragma Inline (fl_tiled_image_get_image); @@ -51,14 +46,14 @@ package body FLTK.Images.Tiled is procedure fl_tiled_image_color_average - (T : in System.Address; + (T : in Storage.Integer_Address; C : in Interfaces.C.int; B : in Interfaces.C.C_float); pragma Import (C, fl_tiled_image_color_average, "fl_tiled_image_color_average"); pragma Inline (fl_tiled_image_color_average); procedure fl_tiled_image_desaturate - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, fl_tiled_image_desaturate, "fl_tiled_image_desaturate"); pragma Inline (fl_tiled_image_desaturate); @@ -66,13 +61,13 @@ package body FLTK.Images.Tiled is procedure fl_tiled_image_draw - (T : in System.Address; + (T : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_tiled_image_draw, "fl_tiled_image_draw"); pragma Inline (fl_tiled_image_draw); procedure fl_tiled_image_draw2 - (T : in System.Address; + (T : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; CX, CY : in Interfaces.C.int); pragma Import (C, fl_tiled_image_draw2, "fl_tiled_image_draw2"); @@ -84,11 +79,11 @@ package body FLTK.Images.Tiled is overriding procedure Finalize (This : in out Tiled_Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Tiled_Image'Class then free_fl_tiled_image (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Image (This)); end Finalize; diff --git a/src/fltk-images.adb b/src/fltk-images.adb index f86071e..13bf2ad 100644 --- a/src/fltk-images.adb +++ b/src/fltk-images.adb @@ -2,13 +2,11 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Images is @@ -16,12 +14,12 @@ package body FLTK.Images is function new_fl_image (W, H, D : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_image, "new_fl_image"); pragma Inline (new_fl_image); procedure free_fl_image - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, free_fl_image, "free_fl_image"); pragma Inline (free_fl_image); @@ -39,15 +37,15 @@ package body FLTK.Images is pragma Inline (fl_image_set_rgb_scaling); function fl_image_copy - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_image_copy, "fl_image_copy"); pragma Inline (fl_image_copy); function fl_image_copy2 - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_image_copy2, "fl_image_copy2"); pragma Inline (fl_image_copy2); @@ -55,14 +53,14 @@ package body FLTK.Images is procedure fl_image_color_average - (I : in System.Address; + (I : in Storage.Integer_Address; C : in Interfaces.C.int; B : in Interfaces.C.C_float); pragma Import (C, fl_image_color_average, "fl_image_color_average"); pragma Inline (fl_image_color_average); procedure fl_image_desaturate - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_image_desaturate, "fl_image_desaturate"); pragma Inline (fl_image_desaturate); @@ -70,12 +68,12 @@ package body FLTK.Images is procedure fl_image_inactive - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_image_inactive, "fl_image_inactive"); pragma Inline (fl_image_inactive); procedure fl_image_uncache - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_image_uncache, "fl_image_uncache"); pragma Inline (fl_image_uncache); @@ -83,31 +81,31 @@ package body FLTK.Images is function fl_image_w - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_w, "fl_image_w"); pragma Inline (fl_image_w); function fl_image_h - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_h, "fl_image_h"); pragma Inline (fl_image_h); function fl_image_d - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_d, "fl_image_d"); pragma Inline (fl_image_d); function fl_image_ld - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_ld, "fl_image_ld"); pragma Inline (fl_image_ld); function fl_image_count - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_count, "fl_image_count"); pragma Inline (fl_image_count); @@ -116,8 +114,8 @@ package body FLTK.Images is function fl_image_data - (I : in System.Address) - return System.Address; + (I : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_image_data, "fl_image_data"); pragma Inline (fl_image_data); @@ -139,19 +137,19 @@ package body FLTK.Images is procedure fl_image_draw - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_image_draw, "fl_image_draw"); pragma Inline (fl_image_draw); procedure fl_image_draw2 - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H, CX, CY : in Interfaces.C.int); pragma Import (C, fl_image_draw2, "fl_image_draw2"); pragma Inline (fl_image_draw2); procedure fl_image_draw_empty - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_image_draw_empty, "fl_image_draw_empty"); pragma Inline (fl_image_draw_empty); @@ -162,13 +160,13 @@ package body FLTK.Images is overriding procedure Finalize (This : in out Image) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Image'Class then if This.Needs_Dealloc then free_fl_image (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; end Finalize; @@ -369,7 +367,7 @@ package body FLTK.Images is return Color_Component is Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); + for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr)); pragma Import (Ada, Pointers); begin return Color_Component @@ -384,7 +382,7 @@ package body FLTK.Images is Value : in Color_Component) is Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); + for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr)); pragma Import (Ada, Pointers); begin fl_image_set_pixel @@ -402,7 +400,7 @@ package body FLTK.Images is return Color_Component_Array is Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); + for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr)); pragma Import (Ada, Pointers); Result : Color_Component_Array := (1 .. Count => 0); begin @@ -431,7 +429,7 @@ package body FLTK.Images is Values : in Color_Component_Array) is Pointers : array (1 .. This.Get_Data_Count) of Interfaces.C.Strings.chars_ptr; - for Pointers'Address use fl_image_data (This.Void_Ptr); + for Pointers'Address use Storage.To_Address (fl_image_data (This.Void_Ptr)); pragma Import (Ada, Pointers); begin for Counter in Integer range 0 .. Values'Length - 1 loop diff --git a/src/fltk-images.ads b/src/fltk-images.ads index 0ee31d5..7cb28ab 100644 --- a/src/fltk-images.ads +++ b/src/fltk-images.ads @@ -224,7 +224,7 @@ private function fl_image_fail - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_image_fail, "fl_image_fail"); diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb index 69a8014..3484a6d 100644 --- a/src/fltk-menu_items.adb +++ b/src/fltk-menu_items.adb @@ -2,13 +2,11 @@ with - System, - Interfaces.C.Strings, - Ada.Unchecked_Conversion; + FLTK.Widget_Callback_Conversions, + Interfaces.C.Strings; use type - System.Address, Interfaces.C.int, Interfaces.C.Strings.chars_ptr; @@ -16,16 +14,21 @@ use type package body FLTK.Menu_Items is + package Callback_Convert renames FLTK.Widget_Callback_Conversions; + + + + function new_fl_menu_item (T : in Interfaces.C.char_array; - C : in System.Address; + C : in Storage.Integer_Address; S, F : in Interfaces.C.unsigned_long) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu_item, "new_fl_menu_item"); pragma Inline (new_fl_menu_item); procedure free_fl_menu_item - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, free_fl_menu_item, "free_fl_menu_item"); pragma Inline (free_fl_menu_item); @@ -33,18 +36,18 @@ package body FLTK.Menu_Items is function fl_menu_item_get_user_data - (MI : in System.Address) - return System.Address; + (MI : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_menu_item_get_user_data, "fl_menu_item_get_user_data"); pragma Inline (fl_menu_item_get_user_data); procedure fl_menu_item_set_user_data - (MI, C : in System.Address); + (MI, C : in Storage.Integer_Address); pragma Import (C, fl_menu_item_set_user_data, "fl_menu_item_set_user_data"); pragma Inline (fl_menu_item_set_user_data); procedure fl_menu_item_do_callback - (MI, W : in System.Address); + (MI, W : in Storage.Integer_Address); pragma Import (C, fl_menu_item_do_callback, "fl_menu_item_do_callback"); pragma Inline (fl_menu_item_do_callback); @@ -52,35 +55,35 @@ package body FLTK.Menu_Items is function fl_menu_item_checkbox - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_checkbox, "fl_menu_item_checkbox"); pragma Inline (fl_menu_item_checkbox); function fl_menu_item_radio - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_radio, "fl_menu_item_radio"); pragma Inline (fl_menu_item_radio); function fl_menu_item_value - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_value, "fl_menu_item_value"); pragma Inline (fl_menu_item_value); procedure fl_menu_item_set - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_set, "fl_menu_item_set"); pragma Inline (fl_menu_item_set); procedure fl_menu_item_clear - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_clear, "fl_menu_item_clear"); pragma Inline (fl_menu_item_clear); procedure fl_menu_item_setonly - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_setonly, "fl_menu_item_setonly"); pragma Inline (fl_menu_item_setonly); @@ -88,61 +91,61 @@ package body FLTK.Menu_Items is function fl_menu_item_get_label - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_menu_item_get_label, "fl_menu_item_get_label"); pragma Inline (fl_menu_item_get_label); procedure fl_menu_item_set_label - (MI : in System.Address; + (MI : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_menu_item_set_label, "fl_menu_item_set_label"); pragma Inline (fl_menu_item_set_label); function fl_menu_item_get_labelcolor - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_menu_item_get_labelcolor, "fl_menu_item_get_labelcolor"); pragma Inline (fl_menu_item_get_labelcolor); procedure fl_menu_item_set_labelcolor - (MI : in System.Address; + (MI : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_menu_item_set_labelcolor, "fl_menu_item_set_labelcolor"); pragma Inline (fl_menu_item_set_labelcolor); function fl_menu_item_get_labelfont - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_get_labelfont, "fl_menu_item_get_labelfont"); pragma Inline (fl_menu_item_get_labelfont); procedure fl_menu_item_set_labelfont - (MI : in System.Address; + (MI : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_menu_item_set_labelfont, "fl_menu_item_set_labelfont"); pragma Inline (fl_menu_item_set_labelfont); function fl_menu_item_get_labelsize - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_get_labelsize, "fl_menu_item_get_labelsize"); pragma Inline (fl_menu_item_get_labelsize); procedure fl_menu_item_set_labelsize - (MI : in System.Address; + (MI : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_menu_item_set_labelsize, "fl_menu_item_set_labelsize"); pragma Inline (fl_menu_item_set_labelsize); function fl_menu_item_get_labeltype - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_get_labeltype, "fl_menu_item_get_labeltype"); pragma Inline (fl_menu_item_get_labeltype); procedure fl_menu_item_set_labeltype - (MI : in System.Address; + (MI : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_menu_item_set_labeltype, "fl_menu_item_set_labeltype"); pragma Inline (fl_menu_item_set_labeltype); @@ -151,25 +154,25 @@ package body FLTK.Menu_Items is function fl_menu_item_get_shortcut - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_get_shortcut, "fl_menu_item_get_shortcut"); pragma Inline (fl_menu_item_get_shortcut); procedure fl_menu_item_set_shortcut - (MI : in System.Address; + (MI : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_menu_item_set_shortcut, "fl_menu_item_set_shortcut"); pragma Inline (fl_menu_item_set_shortcut); function fl_menu_item_get_flags - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.unsigned_long; pragma Import (C, fl_menu_item_get_flags, "fl_menu_item_get_flags"); pragma Inline (fl_menu_item_get_flags); procedure fl_menu_item_set_flags - (MI : in System.Address; + (MI : in Storage.Integer_Address; F : in Interfaces.C.unsigned_long); pragma Import (C, fl_menu_item_set_flags, "fl_menu_item_set_flags"); pragma Inline (fl_menu_item_set_flags); @@ -178,39 +181,39 @@ package body FLTK.Menu_Items is procedure fl_menu_item_activate - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_activate, "fl_menu_item_activate"); pragma Inline (fl_menu_item_activate); procedure fl_menu_item_deactivate - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_deactivate, "fl_menu_item_deactivate"); pragma Inline (fl_menu_item_deactivate); procedure fl_menu_item_show - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_show, "fl_menu_item_show"); pragma Inline (fl_menu_item_show); procedure fl_menu_item_hide - (MI : in System.Address); + (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_hide, "fl_menu_item_hide"); pragma Inline (fl_menu_item_hide); function fl_menu_item_active - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_active, "fl_menu_item_active"); pragma Inline (fl_menu_item_active); function fl_menu_item_visible - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_visible, "fl_menu_item_visible"); pragma Inline (fl_menu_item_visible); function fl_menu_item_activevisible - (MI : in System.Address) + (MI : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_item_activevisible, "fl_menu_item_activevisible"); pragma Inline (fl_menu_item_activevisible); @@ -221,29 +224,19 @@ package body FLTK.Menu_Items is procedure Finalize (This : in out Menu_Item) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Menu_Item'Class then if This.Needs_Dealloc then free_fl_menu_item (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; end Finalize; - package Callback_Convert is - function To_Pointer is new Ada.Unchecked_Conversion - (System.Address, FLTK.Widgets.Widget_Callback); - function To_Address is new Ada.Unchecked_Conversion - (FLTK.Widgets.Widget_Callback, System.Address); - end Callback_Convert; - - - - package body Forge is function Create @@ -273,8 +266,7 @@ package body FLTK.Menu_Items is (Item : in Menu_Item) return FLTK.Widgets.Widget_Callback is begin - return Callback_Convert.To_Pointer - (fl_menu_item_get_user_data (Item.Void_Ptr)); + return Callback_Convert.To_Access (fl_menu_item_get_user_data (Item.Void_Ptr)); end Get_Callback; diff --git a/src/fltk-static.adb b/src/fltk-static.adb index 3ec3938..df531d3 100644 --- a/src/fltk-static.adb +++ b/src/fltk-static.adb @@ -4,7 +4,7 @@ with Interfaces.C.Strings, System.Address_To_Access_Conversions, - Ada.Unchecked_Conversion; + FLTK.Static_Callback_Conversions; use type @@ -15,13 +15,18 @@ use type package body FLTK.Static is + package Conv renames FLTK.Static_Callback_Conversions; + + + + procedure fl_static_add_awake_handler - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_awake_handler, "fl_static_add_awake_handler"); pragma Inline (fl_static_add_awake_handler); procedure fl_static_get_awake_handler - (H, F : out System.Address); + (H, F : out Storage.Integer_Address); pragma Import (C, fl_static_get_awake_handler, "fl_static_get_awake_handler"); pragma Inline (fl_static_get_awake_handler); @@ -29,18 +34,18 @@ package body FLTK.Static is procedure fl_static_add_check - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_check, "fl_static_add_check"); pragma Inline (fl_static_add_check); function fl_static_has_check - (H, F : in System.Address) + (H, F : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_static_has_check, "fl_static_has_check"); pragma Inline (fl_static_has_check); procedure fl_static_remove_check - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_remove_check, "fl_static_remove_check"); pragma Inline (fl_static_remove_check); @@ -49,24 +54,24 @@ package body FLTK.Static is procedure fl_static_add_timeout (S : in Interfaces.C.double; - H, F : in System.Address); + H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_timeout, "fl_static_add_timeout"); pragma Inline (fl_static_add_timeout); function fl_static_has_timeout - (H, F : in System.Address) + (H, F : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_static_has_timeout, "fl_static_has_timeout"); pragma Inline (fl_static_has_timeout); procedure fl_static_remove_timeout - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_remove_timeout, "fl_static_remove_timeout"); pragma Inline (fl_static_remove_timeout); procedure fl_static_repeat_timeout (S : in Interfaces.C.double; - H, F : in System.Address); + H, F : in Storage.Integer_Address); pragma Import (C, fl_static_repeat_timeout, "fl_static_repeat_timeout"); pragma Inline (fl_static_repeat_timeout); @@ -74,7 +79,7 @@ package body FLTK.Static is procedure fl_static_add_clipboard_notify - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_clipboard_notify, "fl_static_add_clipboard_notify"); pragma Inline (fl_static_add_clipboard_notify); @@ -83,13 +88,13 @@ package body FLTK.Static is procedure fl_static_add_fd (D : in Interfaces.C.int; - H, F : in System.Address); + H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_fd, "fl_static_add_fd"); pragma Inline (fl_static_add_fd); procedure fl_static_add_fd2 (D, M : in Interfaces.C.int; - H, F : in System.Address); + H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_fd2, "fl_static_add_fd2"); pragma Inline (fl_static_add_fd2); @@ -107,18 +112,18 @@ package body FLTK.Static is procedure fl_static_add_idle - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_add_idle, "fl_static_add_idle"); pragma Inline (fl_static_add_idle); function fl_static_has_idle - (H, F : in System.Address) + (H, F : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_static_has_idle, "fl_static_has_idle"); pragma Inline (fl_static_has_idle); procedure fl_static_remove_idle - (H, F : in System.Address); + (H, F : in Storage.Integer_Address); pragma Import (C, fl_static_remove_idle, "fl_static_remove_idle"); pragma Inline (fl_static_remove_idle); @@ -180,13 +185,13 @@ package body FLTK.Static is function fl_static_get_font_sizes (F : in Interfaces.C.int; - A : out System.Address) + A : out Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_static_get_font_sizes, "fl_static_get_font_sizes"); pragma Inline (fl_static_get_font_sizes); function fl_static_font_size_array_get - (A : in System.Address; + (A : in Storage.Integer_Address; I : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_static_font_size_array_get, "fl_static_font_size_array_get"); @@ -244,13 +249,13 @@ package body FLTK.Static is pragma Inline (fl_static_copy); procedure fl_static_paste - (R : in System.Address; + (R : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_static_paste, "fl_static_paste"); pragma Inline (fl_static_paste); procedure fl_static_selection - (O : in System.Address; + (O : in Storage.Integer_Address; T : in Interfaces.C.char_array; L : in Interfaces.C.int); pragma Import (C, fl_static_selection, "fl_static_selection"); @@ -286,28 +291,28 @@ package body FLTK.Static is procedure fl_static_default_atclose - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_static_default_atclose, "fl_static_default_atclose"); pragma Inline (fl_static_default_atclose); function fl_static_get_first_window - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_static_get_first_window, "fl_static_get_first_window"); pragma Inline (fl_static_get_first_window); procedure fl_static_set_first_window - (T : in System.Address); + (T : in Storage.Integer_Address); pragma Import (C, fl_static_set_first_window, "fl_static_set_first_window"); pragma Inline (fl_static_set_first_window); function fl_static_next_window - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_static_next_window, "fl_static_next_window"); pragma Inline (fl_static_next_window); function fl_static_modal - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_static_modal, "fl_static_modal"); pragma Inline (fl_static_modal); @@ -315,7 +320,7 @@ package body FLTK.Static is function fl_static_readqueue - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_static_readqueue, "fl_static_readqueue"); pragma Inline (fl_static_readqueue); @@ -374,26 +379,21 @@ package body FLTK.Static is (FLTK.Widgets.Groups.Windows.Window'Class); function fl_widget_get_user_data - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); - package Awake_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Awake_Handler); - function To_Address is new Ada.Unchecked_Conversion (Awake_Handler, System.Address); - end Awake_Convert; - procedure Awake_Hook - (U : in System.Address); + (U : in Storage.Integer_Address); pragma Convention (C, Awake_Hook); procedure Awake_Hook - (U : in System.Address) is + (U : in Storage.Integer_Address) is begin - Awake_Convert.To_Pointer (U).all; + Conv.To_Awake_Access (U).all; end Awake_Hook; @@ -401,36 +401,30 @@ package body FLTK.Static is (Func : in Awake_Handler) is begin fl_static_add_awake_handler - (Awake_Hook'Address, - Awake_Convert.To_Address (Func)); + (Storage.To_Integer (Awake_Hook'Address), Conv.To_Address (Func)); end Add_Awake_Handler; function Get_Awake_Handler return Awake_Handler is - Hook, Func : System.Address; + Hook, Func : Storage.Integer_Address; begin fl_static_get_awake_handler (Hook, Func); - return Awake_Convert.To_Pointer (Func); + return Conv.To_Awake_Access (Func); end Get_Awake_Handler; - package Timeout_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Timeout_Handler); - function To_Address is new Ada.Unchecked_Conversion (Timeout_Handler, System.Address); - end Timeout_Convert; - procedure Timeout_Hook - (U : in System.Address); + (U : in Storage.Integer_Address); pragma Convention (C, Timeout_Hook); procedure Timeout_Hook - (U : in System.Address) is + (U : in Storage.Integer_Address) is begin - Timeout_Convert.To_Pointer (U).all; + Conv.To_Timeout_Access (U).all; end Timeout_Hook; @@ -438,8 +432,7 @@ package body FLTK.Static is (Func : in Timeout_Handler) is begin fl_static_add_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); + (Storage.To_Integer (Timeout_Hook'Address), Conv.To_Address (Func)); end Add_Check; @@ -448,8 +441,8 @@ package body FLTK.Static is return Boolean is begin return fl_static_has_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)) /= 0; + (Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)) /= 0; end Has_Check; @@ -457,8 +450,8 @@ package body FLTK.Static is (Func : in Timeout_Handler) is begin fl_static_remove_check - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); + (Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)); end Remove_Check; @@ -470,8 +463,8 @@ package body FLTK.Static is begin fl_static_add_timeout (Interfaces.C.double (Seconds), - Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); + Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)); end Add_Timeout; @@ -480,8 +473,8 @@ package body FLTK.Static is return Boolean is begin return fl_static_has_timeout - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)) /= 0; + (Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)) /= 0; end Has_Timeout; @@ -489,8 +482,8 @@ package body FLTK.Static is (Func : in Timeout_Handler) is begin fl_static_remove_timeout - (Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); + (Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)); end Remove_Timeout; @@ -500,30 +493,26 @@ package body FLTK.Static is begin fl_static_repeat_timeout (Interfaces.C.double (Seconds), - Timeout_Hook'Address, - Timeout_Convert.To_Address (Func)); + Storage.To_Integer (Timeout_Hook'Address), + Conv.To_Address (Func)); end Repeat_Timeout; - package Clipboard_Convert is - function To_Pointer is new Ada.Unchecked_Conversion - (System.Address, Clipboard_Notify_Handler); - function To_Address is new Ada.Unchecked_Conversion - (Clipboard_Notify_Handler, System.Address); - end Clipboard_Convert; - + -- This is handled on the Ada side because otherwise there would be + -- no way to specify which callback to remove in FLTK once one was + -- added. The hook is passed during package init. Current_Clipboard_Notify : Clipboard_Notify_Handler; procedure Clipboard_Notify_Hook (S : in Interfaces.C.int; - U : in System.Address); + U : in Storage.Integer_Address); pragma Convention (C, Clipboard_Notify_Hook); procedure Clipboard_Notify_Hook (S : in Interfaces.C.int; - U : in System.Address) is + U : in Storage.Integer_Address) is begin if Current_Clipboard_Notify /= null then Current_Clipboard_Notify.all (Buffer_Kind'Val (S)); @@ -547,21 +536,16 @@ package body FLTK.Static is - package FD_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, File_Handler); - function To_Address is new Ada.Unchecked_Conversion (File_Handler, System.Address); - end FD_Convert; - procedure FD_Hook (FD : in Interfaces.C.int; - U : in System.Address); + U : in Storage.Integer_Address); pragma Convention (C, FD_Hook); procedure FD_Hook (FD : in Interfaces.C.int; - U : in System.Address) is + U : in Storage.Integer_Address) is begin - FD_Convert.To_Pointer (U).all (File_Descriptor (FD)); + Conv.To_File_Access (U).all (File_Descriptor (FD)); end FD_Hook; @@ -571,8 +555,8 @@ package body FLTK.Static is begin fl_static_add_fd (Interfaces.C.int (FD), - FD_Hook'Address, - FD_Convert.To_Address (Func)); + Storage.To_Integer (FD_Hook'Address), + Conv.To_Address (Func)); end Add_File_Descriptor; @@ -584,8 +568,8 @@ package body FLTK.Static is fl_static_add_fd2 (Interfaces.C.int (FD), File_Mode_Codes (Mode), - FD_Hook'Address, - FD_Convert.To_Address (Func)); + Storage.To_Integer (FD_Hook'Address), + Conv.To_Address (Func)); end Add_File_Descriptor; @@ -606,19 +590,14 @@ package body FLTK.Static is - package Idle_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Idle_Handler); - function To_Address is new Ada.Unchecked_Conversion (Idle_Handler, System.Address); - end Idle_Convert; - procedure Idle_Hook - (U : in System.Address); + (U : in Storage.Integer_Address); pragma Convention (C, Idle_Hook); procedure Idle_Hook - (U : in System.Address) is + (U : in Storage.Integer_Address) is begin - Idle_Convert.To_Pointer (U).all; + Conv.To_Idle_Access (U).all; end Idle_Hook; @@ -626,8 +605,8 @@ package body FLTK.Static is (Func : in Idle_Handler) is begin fl_static_add_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)); + (Storage.To_Integer (Idle_Hook'Address), + Conv.To_Address (Func)); end Add_Idle; @@ -636,8 +615,8 @@ package body FLTK.Static is return Boolean is begin return fl_static_has_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)) /= 0; + (Storage.To_Integer (Idle_Hook'Address), + Conv.To_Address (Func)) /= 0; end Has_Idle; @@ -645,8 +624,8 @@ package body FLTK.Static is (Func : in Idle_Handler) is begin fl_static_remove_idle - (Idle_Hook'Address, - Idle_Convert.To_Address (Func)); + (Storage.To_Integer (Idle_Hook'Address), + Conv.To_Address (Func)); end Remove_Idle; @@ -747,7 +726,7 @@ package body FLTK.Static is (Kind : in Font_Kind) return Font_Size_Array is - Ptr : System.Address; + Ptr : Storage.Integer_Address; Arr : Font_Size_Array (1 .. Integer (fl_static_get_font_sizes (Font_Kind'Pos (Kind), Ptr))); begin @@ -911,7 +890,7 @@ package body FLTK.Static is return access FLTK.Widgets.Groups.Windows.Window'Class is begin return Window_Convert.To_Pointer - (fl_widget_get_user_data (fl_static_get_first_window)); + (Storage.To_Address (fl_widget_get_user_data (fl_static_get_first_window))); end Get_First_Window; @@ -926,15 +905,16 @@ package body FLTK.Static is (From : in FLTK.Widgets.Groups.Windows.Window'Class) return access FLTK.Widgets.Groups.Windows.Window'Class is begin - return Window_Convert.To_Pointer - (fl_widget_get_user_data (fl_static_next_window (Wrapper (From).Void_Ptr))); + return Window_Convert.To_Pointer (Storage.To_Address + (fl_widget_get_user_data (fl_static_next_window (Wrapper (From).Void_Ptr)))); end Get_Next_Window; function Get_Top_Modal return access FLTK.Widgets.Groups.Windows.Window'Class is begin - return Window_Convert.To_Pointer (fl_widget_get_user_data (fl_static_modal)); + return Window_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_static_modal))); end Get_Top_Modal; @@ -943,7 +923,8 @@ package body FLTK.Static is function Read_Queue return access FLTK.Widgets.Widget'Class is begin - return Widget_Convert.To_Pointer (fl_widget_get_user_data (fl_static_readqueue)); + return Widget_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (fl_static_readqueue))); end Read_Queue; @@ -1014,7 +995,8 @@ package body FLTK.Static is begin - fl_static_add_clipboard_notify (Clipboard_Notify_Hook'Address, System.Null_Address); + fl_static_add_clipboard_notify + (Storage.To_Integer (Clipboard_Notify_Hook'Address), Null_Pointer); end FLTK.Static; diff --git a/src/fltk-static_callback_conversions.adb b/src/fltk-static_callback_conversions.adb new file mode 100644 index 0000000..2448d23 --- /dev/null +++ b/src/fltk-static_callback_conversions.adb @@ -0,0 +1,172 @@ + + +with + + Ada.Unchecked_Conversion, + FLTK.Static; + +use type + + FLTK.Static.Awake_Handler, + FLTK.Static.Timeout_Handler, + FLTK.Static.Idle_Handler, + FLTK.Static.Clipboard_Notify_Handler, + FLTK.Static.File_Handler; + + +package body FLTK.Static_Callback_Conversions is + + + function To_Awake_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Awake_Handler + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Static.Awake_Handler); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_Awake_Access; + + + function To_Address + (Call : in FLTK.Static.Awake_Handler) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Static.Awake_Handler, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + + function To_Timeout_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Timeout_Handler + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Static.Timeout_Handler); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_Timeout_Access; + + + function To_Address + (Call : in FLTK.Static.Timeout_Handler) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Static.Timeout_Handler, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + + function To_Idle_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Idle_Handler + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Static.Idle_Handler); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_Idle_Access; + + + function To_Address + (Call : in FLTK.Static.Idle_Handler) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Static.Idle_Handler, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + + function To_Clipboard_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Clipboard_Notify_Handler + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Static.Clipboard_Notify_Handler); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_Clipboard_Access; + + + function To_Address + (Call : in FLTK.Static.Clipboard_Notify_Handler) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Static.Clipboard_Notify_Handler, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + + function To_File_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.File_Handler + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Static.File_Handler); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_File_Access; + + + function To_Address + (Call : in FLTK.Static.File_Handler) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Static.File_Handler, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + +end FLTK.Static_Callback_Conversions; + + diff --git a/src/fltk-static_callback_conversions.ads b/src/fltk-static_callback_conversions.ads new file mode 100644 index 0000000..2e47f4b --- /dev/null +++ b/src/fltk-static_callback_conversions.ads @@ -0,0 +1,54 @@ + + +limited with + + FLTK.Static; + + +private package FLTK.Static_Callback_Conversions is + + + function To_Awake_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Awake_Handler; + + function To_Address + (Call : in FLTK.Static.Awake_Handler) + return Storage.Integer_Address; + + function To_Timeout_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Timeout_Handler; + + function To_Address + (Call : in FLTK.Static.Timeout_Handler) + return Storage.Integer_Address; + + function To_Idle_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Idle_Handler; + + function To_Address + (Call : in FLTK.Static.Idle_Handler) + return Storage.Integer_Address; + + function To_Clipboard_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.Clipboard_Notify_Handler; + + function To_Address + (Call : in FLTK.Static.Clipboard_Notify_Handler) + return Storage.Integer_Address; + + function To_File_Access + (Addy : in Storage.Integer_Address) + return FLTK.Static.File_Handler; + + function To_Address + (Call : in FLTK.Static.File_Handler) + return Storage.Integer_Address; + + +end FLTK.Static_Callback_Conversions; + + diff --git a/src/fltk-text_buffers.adb b/src/fltk-text_buffers.adb index d41e4fe..11912c3 100644 --- a/src/fltk-text_buffers.adb +++ b/src/fltk-text_buffers.adb @@ -4,8 +4,7 @@ with Interfaces.C.Strings, Ada.Strings.Unbounded, - Ada.Containers, - System; + Ada.Containers; use @@ -13,7 +12,6 @@ use use type - System.Address, Interfaces.C.int, Interfaces.C.Strings.chars_ptr, Ada.Containers.Count_Type; @@ -24,12 +22,12 @@ package body FLTK.Text_Buffers is function new_fl_text_buffer (RS, PGS : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_text_buffer, "new_fl_text_buffer"); pragma Inline (new_fl_text_buffer); procedure free_fl_text_buffer - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, free_fl_text_buffer, "free_fl_text_buffer"); pragma Inline (free_fl_text_buffer); @@ -37,25 +35,25 @@ package body FLTK.Text_Buffers is procedure fl_text_buffer_add_modify_callback - (TB, CB, UD : in System.Address); + (TB, CB, UD : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_add_modify_callback, "fl_text_buffer_add_modify_callback"); pragma Inline (fl_text_buffer_add_modify_callback); procedure fl_text_buffer_add_predelete_callback - (TB, CB, UD : in System.Address); + (TB, CB, UD : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_add_predelete_callback, "fl_text_buffer_add_predelete_callback"); pragma Inline (fl_text_buffer_add_predelete_callback); procedure fl_text_buffer_call_modify_callbacks - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_call_modify_callbacks, "fl_text_buffer_call_modify_callbacks"); pragma Inline (fl_text_buffer_call_modify_callbacks); procedure fl_text_buffer_call_predelete_callbacks - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_call_predelete_callbacks, "fl_text_buffer_call_predelete_callbacks"); pragma Inline (fl_text_buffer_call_predelete_callbacks); @@ -64,7 +62,7 @@ package body FLTK.Text_Buffers is function fl_text_buffer_loadfile - (TB : in System.Address; + (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; B : in Interfaces.C.int) return Interfaces.C.int; @@ -72,7 +70,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_loadfile); function fl_text_buffer_appendfile - (TB : in System.Address; + (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; B : in Interfaces.C.int) return Interfaces.C.int; @@ -80,7 +78,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_appendfile); function fl_text_buffer_insertfile - (TB : in System.Address; + (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; P, B : in Interfaces.C.int) return Interfaces.C.int; @@ -88,7 +86,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_insertfile); function fl_text_buffer_outputfile - (TB : in System.Address; + (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; F, T : in Interfaces.C.int; B : in Interfaces.C.int) @@ -97,7 +95,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_outputfile); function fl_text_buffer_savefile - (TB : in System.Address; + (TB : in Storage.Integer_Address; N : in Interfaces.C.char_array; B : in Interfaces.C.int) return Interfaces.C.int; @@ -108,73 +106,73 @@ package body FLTK.Text_Buffers is procedure fl_text_buffer_insert - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int; I : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_insert, "fl_text_buffer_insert"); pragma Inline (fl_text_buffer_insert); procedure fl_text_buffer_append - (TB : in System.Address; + (TB : in Storage.Integer_Address; I : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_append, "fl_text_buffer_append"); pragma Inline (fl_text_buffer_append); procedure fl_text_buffer_replace - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int; T : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_replace, "fl_text_buffer_replace"); pragma Inline (fl_text_buffer_replace); procedure fl_text_buffer_remove - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int); pragma Import (C, fl_text_buffer_remove, "fl_text_buffer_remove"); pragma Inline (fl_text_buffer_remove); function fl_text_buffer_get_text - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_get_text, "fl_text_buffer_get_text"); pragma Inline (fl_text_buffer_get_text); procedure fl_text_buffer_set_text - (TB : in System.Address; + (TB : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_set_text, "fl_text_buffer_set_text"); pragma Inline (fl_text_buffer_set_text); function fl_text_buffer_byte_at - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.char; pragma Import (C, fl_text_buffer_byte_at, "fl_text_buffer_byte_at"); pragma Inline (fl_text_buffer_byte_at); function fl_text_buffer_char_at - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.unsigned; pragma Import (C, fl_text_buffer_char_at, "fl_text_buffer_char_at"); pragma Inline (fl_text_buffer_char_at); function fl_text_buffer_text_range - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_text_range, "fl_text_buffer_text_range"); pragma Inline (fl_text_buffer_text_range); function fl_text_buffer_next_char - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_next_char, "fl_text_buffer_next_char"); pragma Inline (fl_text_buffer_next_char); function fl_text_buffer_prev_char - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_prev_char, "fl_text_buffer_prev_char"); @@ -184,7 +182,7 @@ package body FLTK.Text_Buffers is function fl_text_buffer_count_displayed_characters - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_count_displayed_characters, @@ -192,26 +190,26 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_count_displayed_characters); function fl_text_buffer_count_lines - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, F : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_count_lines, "fl_text_buffer_count_lines"); pragma Inline (fl_text_buffer_count_lines); function fl_text_buffer_length - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_buffer_length, "fl_text_buffer_length"); pragma Inline (fl_text_buffer_length); function fl_text_buffer_get_tab_distance - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_buffer_get_tab_distance, "fl_text_buffer_get_tab_distance"); pragma Inline (fl_text_buffer_get_tab_distance); procedure fl_text_buffer_set_tab_distance - (TB : in System.Address; + (TB : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_text_buffer_set_tab_distance, "fl_text_buffer_set_tab_distance"); pragma Inline (fl_text_buffer_set_tab_distance); @@ -220,14 +218,14 @@ package body FLTK.Text_Buffers is function fl_text_buffer_selection_position - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, E : out Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_selection_position, "fl_text_buffer_selection_position"); pragma Inline (fl_text_buffer_selection_position); function fl_text_buffer_secondary_selection_position - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, E : out Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_secondary_selection_position, @@ -235,73 +233,73 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_secondary_selection_position); procedure fl_text_buffer_select - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, E : in Interfaces.C.int); pragma Import (C, fl_text_buffer_select, "fl_text_buffer_select"); pragma Inline (fl_text_buffer_select); procedure fl_text_buffer_secondary_select - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, E : in Interfaces.C.int); pragma Import (C, fl_text_buffer_secondary_select, "fl_text_buffer_secondary_select"); pragma Inline (fl_text_buffer_secondary_select); function fl_text_buffer_selected - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_buffer_selected, "fl_text_buffer_selected"); pragma Inline (fl_text_buffer_selected); function fl_text_buffer_secondary_selected - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_buffer_secondary_selected, "fl_text_buffer_secondary_selected"); pragma Inline (fl_text_buffer_secondary_selected); function fl_text_buffer_selection_text - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_selection_text, "fl_text_buffer_selection_text"); pragma Inline (fl_text_buffer_selection_text); function fl_text_buffer_secondary_selection_text - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_secondary_selection_text, "fl_text_buffer_secondary_selection_text"); pragma Inline (fl_text_buffer_secondary_selection_text); procedure fl_text_buffer_replace_selection - (TB : in System.Address; + (TB : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_replace_selection, "fl_text_buffer_replace_selection"); pragma Inline (fl_text_buffer_replace_selection); procedure fl_text_buffer_replace_secondary_selection - (TB : in System.Address; + (TB : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_text_buffer_replace_secondary_selection, "fl_text_buffer_replace_secondary_selection"); pragma Inline (fl_text_buffer_replace_secondary_selection); procedure fl_text_buffer_remove_selection - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_remove_selection, "fl_text_buffer_remove_selection"); pragma Inline (fl_text_buffer_remove_selection); procedure fl_text_buffer_remove_secondary_selection - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_remove_secondary_selection, "fl_text_buffer_remove_secondary_selection"); pragma Inline (fl_text_buffer_remove_secondary_selection); procedure fl_text_buffer_unselect - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_unselect, "fl_text_buffer_unselect"); pragma Inline (fl_text_buffer_unselect); procedure fl_text_buffer_secondary_unselect - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_secondary_unselect, "fl_text_buffer_secondary_unselect"); pragma Inline (fl_text_buffer_secondary_unselect); @@ -309,19 +307,19 @@ package body FLTK.Text_Buffers is procedure fl_text_buffer_highlight - (TB : in System.Address; + (TB : in Storage.Integer_Address; F, T : in Interfaces.C.int); pragma Import (C, fl_text_buffer_highlight, "fl_text_buffer_highlight"); pragma Inline (fl_text_buffer_highlight); function fl_text_buffer_highlight_text - (TB : in System.Address) + (TB : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_highlight_text, "fl_text_buffer_highlight_text"); pragma Inline (fl_text_buffer_highlight_text); procedure fl_text_buffer_unhighlight - (TB : in System.Address); + (TB : in Storage.Integer_Address); pragma Import (C, fl_text_buffer_unhighlight, "fl_text_buffer_unhighlight"); pragma Inline (fl_text_buffer_unhighlight); @@ -329,7 +327,7 @@ package body FLTK.Text_Buffers is function fl_text_buffer_findchar_forward - (TB : in System.Address; + (TB : in Storage.Integer_Address; SP : in Interfaces.C.int; IT : in Interfaces.C.unsigned; FP : out Interfaces.C.int) @@ -338,7 +336,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_findchar_forward); function fl_text_buffer_findchar_backward - (TB : in System.Address; + (TB : in Storage.Integer_Address; SP : in Interfaces.C.int; IT : in Interfaces.C.unsigned; FP : out Interfaces.C.int) @@ -347,7 +345,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_findchar_backward); function fl_text_buffer_search_forward - (TB : in System.Address; + (TB : in Storage.Integer_Address; SP : in Interfaces.C.int; IT : in Interfaces.C.char_array; FP : out Interfaces.C.int; @@ -357,7 +355,7 @@ package body FLTK.Text_Buffers is pragma Inline (fl_text_buffer_search_forward); function fl_text_buffer_search_backward - (TB : in System.Address; + (TB : in Storage.Integer_Address; SP : in Interfaces.C.int; IT : in Interfaces.C.char_array; FP : out Interfaces.C.int; @@ -370,56 +368,56 @@ package body FLTK.Text_Buffers is function fl_text_buffer_word_start - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_word_start, "fl_text_buffer_word_start"); pragma Inline (fl_text_buffer_word_start); function fl_text_buffer_word_end - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_word_end, "fl_text_buffer_word_end"); pragma Inline (fl_text_buffer_word_end); function fl_text_buffer_line_start - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_line_start, "fl_text_buffer_line_start"); pragma Inline (fl_text_buffer_line_start); function fl_text_buffer_line_end - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_line_end, "fl_text_buffer_line_end"); pragma Inline (fl_text_buffer_line_end); function fl_text_buffer_line_text - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_text_buffer_line_text, "fl_text_buffer_line_text"); pragma Inline (fl_text_buffer_line_text); function fl_text_buffer_skip_lines - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, L : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_skip_lines, "fl_text_buffer_skip_lines"); pragma Inline (fl_text_buffer_skip_lines); function fl_text_buffer_rewind_lines - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, L : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_rewind_lines, "fl_text_buffer_rewind_lines"); pragma Inline (fl_text_buffer_rewind_lines); function fl_text_buffer_skip_displayed_characters - (TB : in System.Address; + (TB : in Storage.Integer_Address; S, N : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_skip_displayed_characters, @@ -430,19 +428,19 @@ package body FLTK.Text_Buffers is procedure fl_text_buffer_canundo - (TB : in System.Address; + (TB : in Storage.Integer_Address; F : in Interfaces.C.char); pragma Import (C, fl_text_buffer_canundo, "fl_text_buffer_canundo"); pragma Inline (fl_text_buffer_canundo); procedure fl_text_buffer_copy - (TB, TB2 : in System.Address; + (TB, TB2 : in Storage.Integer_Address; S, F, I : in Interfaces.C.int); pragma Import (C, fl_text_buffer_copy, "fl_text_buffer_copy"); pragma Inline (fl_text_buffer_copy); function fl_text_buffer_utf8_align - (TB : in System.Address; + (TB : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_buffer_utf8_align, "fl_text_buffer_utf8_align"); @@ -455,7 +453,7 @@ package body FLTK.Text_Buffers is (Pos : in Interfaces.C.int; Inserted, Deleted, Restyled : in Interfaces.C.int; Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address) + UD : in Storage.Integer_Address) is Action : Modification; Place : Position := Position (Pos); @@ -463,7 +461,7 @@ package body FLTK.Text_Buffers is Deleted_Text : Unbounded_String := To_Unbounded_String (""); Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); + Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); begin if Ada_Text_Buffer.CB_Active then if Inserted > 0 then @@ -492,13 +490,13 @@ package body FLTK.Text_Buffers is procedure Predelete_Callback_Hook (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address) + UD : in Storage.Integer_Address) is Place : Position := Position (Pos); Length : Natural := Natural (Deleted); Ada_Text_Buffer : access Text_Buffer := - Text_Buffer_Convert.To_Pointer (UD); + Text_Buffer_Convert.To_Pointer (Storage.To_Address (UD)); begin if Ada_Text_Buffer.CB_Active then for CB of Ada_Text_Buffer.Predelete_CBs loop @@ -513,11 +511,11 @@ package body FLTK.Text_Buffers is procedure Finalize (This : in out Text_Buffer) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Text_Buffer'Class then free_fl_text_buffer (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; end Finalize; @@ -542,12 +540,12 @@ package body FLTK.Text_Buffers is fl_text_buffer_add_modify_callback (This.Void_Ptr, - Modify_Callback_Hook'Address, - This'Address); + Storage.To_Integer (Modify_Callback_Hook'Address), + Storage.To_Integer (This'Address)); fl_text_buffer_add_predelete_callback (This.Void_Ptr, - Predelete_Callback_Hook'Address, - This'Address); + Storage.To_Integer (Predelete_Callback_Hook'Address), + Storage.To_Integer (This'Address)); end return; end Create; diff --git a/src/fltk-text_buffers.ads b/src/fltk-text_buffers.ads index 956c03e..1bc8bdb 100644 --- a/src/fltk-text_buffers.ads +++ b/src/fltk-text_buffers.ads @@ -386,12 +386,12 @@ private procedure Modify_Callback_Hook (Pos, Inserted, Deleted, Restyled : in Interfaces.C.int; Text : in Interfaces.C.Strings.chars_ptr; - UD : in System.Address); + UD : in Storage.Integer_Address); pragma Convention (C, Modify_Callback_Hook); procedure Predelete_Callback_Hook (Pos, Deleted : in Interfaces.C.int; - UD : in System.Address); + UD : in Storage.Integer_Address); pragma Convention (C, Predelete_Callback_Hook); diff --git a/src/fltk-tooltips.adb b/src/fltk-tooltips.adb index 720e417..5f899d7 100644 --- a/src/fltk-tooltips.adb +++ b/src/fltk-tooltips.adb @@ -7,20 +7,19 @@ with use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Tooltips is function fl_tooltip_get_current - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_tooltip_get_current, "fl_tooltip_get_current"); pragma Inline (fl_tooltip_get_current); procedure fl_tooltip_set_current - (I : in System.Address); + (I : in Storage.Integer_Address); pragma Import (C, fl_tooltip_set_current, "fl_tooltip_set_current"); pragma Inline (fl_tooltip_set_current); @@ -35,7 +34,7 @@ package body FLTK.Tooltips is pragma Inline (fl_tooltip_enable); procedure fl_tooltip_enter_area - (I : in System.Address; + (I : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; T : in Interfaces.C.char_array); pragma Import (C, fl_tooltip_enter_area, "fl_tooltip_enter_area"); @@ -144,8 +143,8 @@ package body FLTK.Tooltips is function fl_widget_get_user_data - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); pragma Inline (fl_widget_get_user_data); @@ -158,10 +157,11 @@ package body FLTK.Tooltips is function Get_Target return access FLTK.Widgets.Widget'Class is - Widget_Ptr : System.Address := fl_tooltip_get_current; + Widget_Ptr : Storage.Integer_Address := fl_tooltip_get_current; begin - if Widget_Ptr /= System.Null_Address then - return Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + if Widget_Ptr /= Null_Pointer then + return Widget_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); else return null; end if; diff --git a/src/fltk-widget_callback_conversions.adb b/src/fltk-widget_callback_conversions.adb new file mode 100644 index 0000000..a0a4428 --- /dev/null +++ b/src/fltk-widget_callback_conversions.adb @@ -0,0 +1,48 @@ + + +with + + Ada.Unchecked_Conversion, + FLTK.Widgets; + +use type + + FLTK.Widgets.Widget_Callback; + + +package body FLTK.Widget_Callback_Conversions is + + + function To_Access + (Addy : in Storage.Integer_Address) + return FLTK.Widgets.Widget_Callback + is + function Raw is new Ada.Unchecked_Conversion + (Storage.Integer_Address, FLTK.Widgets.Widget_Callback); + begin + if Addy = Null_Pointer then + return null; + else + return Raw (Addy); + end if; + end To_Access; + + + function To_Address + (Call : in FLTK.Widgets.Widget_Callback) + return Storage.Integer_Address + is + function Raw is new Ada.Unchecked_Conversion + (FLTK.Widgets.Widget_Callback, Storage.Integer_Address); + begin + if Call = null then + return Null_Pointer; + else + return Raw (Call); + end if; + end To_Address; + + +end FLTK.Widget_Callback_Conversions; + + diff --git a/src/fltk-widget_callback_conversions.ads b/src/fltk-widget_callback_conversions.ads new file mode 100644 index 0000000..01e7957 --- /dev/null +++ b/src/fltk-widget_callback_conversions.ads @@ -0,0 +1,22 @@ + + +limited with + + FLTK.Widgets; + + +private package FLTK.Widget_Callback_Conversions is + + + function To_Access + (Addy : in Storage.Integer_Address) + return FLTK.Widgets.Widget_Callback; + + function To_Address + (Call : in FLTK.Widgets.Widget_Callback) + return Storage.Integer_Address; + + +end FLTK.Widget_Callback_Conversions; + + diff --git a/src/fltk-widgets-boxes.adb b/src/fltk-widgets-boxes.adb index a5c3087..16d3eb3 100644 --- a/src/fltk-widgets-boxes.adb +++ b/src/fltk-widgets-boxes.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Boxes is procedure box_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, box_set_draw_hook, "box_set_draw_hook"); pragma Inline (box_set_draw_hook); procedure box_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, box_set_handle_hook, "box_set_handle_hook"); pragma Inline (box_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Boxes is function new_fl_box (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_box, "new_fl_box"); pragma Inline (new_fl_box); procedure free_fl_box - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_box, "free_fl_box"); pragma Inline (free_fl_box); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Boxes is procedure fl_box_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_box_draw, "fl_box_draw"); pragma Inline (fl_box_draw); function fl_box_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_box_handle, "fl_box_handle"); @@ -59,13 +54,13 @@ package body FLTK.Widgets.Boxes is procedure Finalize (This : in out Box) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Box'Class then if This.Needs_Dealloc then free_fl_box (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -89,9 +84,9 @@ package body FLTK.Widgets.Boxes is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - box_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - box_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + box_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + box_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-enter.adb b/src/fltk-widgets-buttons-enter.adb index 1753811..2755087 100644 --- a/src/fltk-widgets-buttons-enter.adb +++ b/src/fltk-widgets-buttons-enter.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Enter is procedure return_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, return_button_set_draw_hook, "return_button_set_draw_hook"); pragma Inline (return_button_set_draw_hook); procedure return_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, return_button_set_handle_hook, "return_button_set_handle_hook"); pragma Inline (return_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Enter is function new_fl_return_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_return_button, "new_fl_return_button"); pragma Inline (new_fl_return_button); procedure free_fl_return_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_return_button, "free_fl_return_button"); pragma Inline (free_fl_return_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Enter is procedure fl_return_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_return_button_draw, "fl_return_button_draw"); pragma Inline (fl_return_button_draw); function fl_return_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_return_button_handle, "fl_return_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Enter is procedure Finalize (This : in out Enter_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Enter_Button'Class then free_fl_return_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Enter is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - return_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - return_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + return_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + return_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-check.adb b/src/fltk-widgets-buttons-light-check.adb index 027f9f7..dd6b5c5 100644 --- a/src/fltk-widgets-buttons-light-check.adb +++ b/src/fltk-widgets-buttons-light-check.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Light.Check is procedure check_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, check_button_set_draw_hook, "check_button_set_draw_hook"); pragma Inline (check_button_set_draw_hook); procedure check_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, check_button_set_handle_hook, "check_button_set_handle_hook"); pragma Inline (check_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Light.Check is function new_fl_check_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_check_button, "new_fl_check_button"); pragma Inline (new_fl_check_button); procedure free_fl_check_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_check_button, "free_fl_check_button"); pragma Inline (free_fl_check_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Light.Check is procedure fl_check_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_check_button_draw, "fl_check_button_draw"); pragma Inline (fl_check_button_draw); function fl_check_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_check_button_handle, "fl_check_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Light.Check is procedure Finalize (This : in out Check_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Check_Button'Class then free_fl_check_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Light_Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Light.Check is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - check_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - check_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + check_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + check_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-radio.adb b/src/fltk-widgets-buttons-light-radio.adb index 339e1f2..e35e801 100644 --- a/src/fltk-widgets-buttons-light-radio.adb +++ b/src/fltk-widgets-buttons-light-radio.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Light.Radio is procedure radio_light_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, radio_light_button_set_draw_hook, "radio_light_button_set_draw_hook"); pragma Inline (radio_light_button_set_draw_hook); procedure radio_light_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, radio_light_button_set_handle_hook, "radio_light_button_set_handle_hook"); pragma Inline (radio_light_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Light.Radio is function new_fl_radio_light_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_radio_light_button, "new_fl_radio_light_button"); pragma Inline (new_fl_radio_light_button); procedure free_fl_radio_light_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_radio_light_button, "free_fl_radio_light_button"); pragma Inline (free_fl_radio_light_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Light.Radio is procedure fl_radio_light_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_radio_light_button_draw, "fl_radio_light_button_draw"); pragma Inline (fl_radio_light_button_draw); function fl_radio_light_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_radio_light_button_handle, "fl_radio_light_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Light.Radio is procedure Finalize (This : in out Radio_Light_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Radio_Light_Button'Class then free_fl_radio_light_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Light_Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Light.Radio is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_light_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_light_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + radio_light_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + radio_light_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-round-radio.adb b/src/fltk-widgets-buttons-light-round-radio.adb index c1a9271..77aa7e9 100644 --- a/src/fltk-widgets-buttons-light-round-radio.adb +++ b/src/fltk-widgets-buttons-light-round-radio.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Light.Round.Radio is procedure radio_round_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, radio_round_button_set_draw_hook, "radio_round_button_set_draw_hook"); pragma Inline (radio_round_button_set_draw_hook); procedure radio_round_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, radio_round_button_set_handle_hook, "radio_round_button_set_handle_hook"); pragma Inline (radio_round_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is function new_fl_radio_round_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_radio_round_button, "new_fl_radio_round_button"); pragma Inline (new_fl_radio_round_button); procedure free_fl_radio_round_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_radio_round_button, "free_fl_radio_round_button"); pragma Inline (free_fl_radio_round_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is procedure fl_radio_round_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_radio_round_button_draw, "fl_radio_round_button_draw"); pragma Inline (fl_radio_round_button_draw); function fl_radio_round_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_radio_round_button_handle, "fl_radio_round_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is procedure Finalize (This : in out Radio_Round_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Radio_Round_Button'Class then free_fl_radio_round_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Round_Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Light.Round.Radio is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_round_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_round_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + radio_round_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + radio_round_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light-round.adb b/src/fltk-widgets-buttons-light-round.adb index bceb70e..4e96151 100644 --- a/src/fltk-widgets-buttons-light-round.adb +++ b/src/fltk-widgets-buttons-light-round.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Light.Round is procedure round_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, round_button_set_draw_hook, "round_button_set_draw_hook"); pragma Inline (round_button_set_draw_hook); procedure round_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, round_button_set_handle_hook, "round_button_set_handle_hook"); pragma Inline (round_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Light.Round is function new_fl_round_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_round_button, "new_fl_round_button"); pragma Inline (new_fl_round_button); procedure free_fl_round_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_round_button, "free_fl_round_button"); pragma Inline (free_fl_round_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Light.Round is procedure fl_round_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_round_button_draw, "fl_round_button_draw"); pragma Inline (fl_round_button_draw); function fl_round_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_round_button_handle, "fl_round_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Light.Round is procedure Finalize (This : in out Round_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Round_Button'Class then free_fl_round_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Light_Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Light.Round is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - round_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - round_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + round_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + round_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-light.adb b/src/fltk-widgets-buttons-light.adb index 6290054..adfa9e6 100644 --- a/src/fltk-widgets-buttons-light.adb +++ b/src/fltk-widgets-buttons-light.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Light is procedure light_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, light_button_set_draw_hook, "light_button_set_draw_hook"); pragma Inline (light_button_set_draw_hook); procedure light_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, light_button_set_handle_hook, "light_button_set_handle_hook"); pragma Inline (light_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Light is function new_fl_light_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_light_button, "new_fl_light_button"); pragma Inline (new_fl_light_button); procedure free_fl_light_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_light_button, "free_fl_light_button"); pragma Inline (free_fl_light_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Light is procedure fl_light_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_light_button_draw, "fl_light_button_draw"); pragma Inline (fl_light_button_draw); function fl_light_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_light_button_handle, "fl_light_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Light is procedure Finalize (This : in out Light_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Light_Button'Class then free_fl_light_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Light is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - light_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - light_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + light_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + light_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-radio.adb b/src/fltk-widgets-buttons-radio.adb index 8d8e164..278562b 100644 --- a/src/fltk-widgets-buttons-radio.adb +++ b/src/fltk-widgets-buttons-radio.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Radio is procedure radio_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, radio_button_set_draw_hook, "radio_button_set_draw_hook"); pragma Inline (radio_button_set_draw_hook); procedure radio_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, radio_button_set_handle_hook, "radio_button_set_handle_hook"); pragma Inline (radio_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Radio is function new_fl_radio_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_radio_button, "new_fl_radio_button"); pragma Inline (new_fl_radio_button); procedure free_fl_radio_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_radio_button, "free_fl_radio_button"); pragma Inline (free_fl_radio_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Radio is procedure fl_radio_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_radio_button_draw, "fl_radio_button_draw"); pragma Inline (fl_radio_button_draw); function fl_radio_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_radio_button_handle, "fl_radio_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Radio is procedure Finalize (This : in out Radio_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Radio_Button'Class then free_fl_radio_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Radio is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - radio_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - radio_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + radio_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + radio_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-repeat.adb b/src/fltk-widgets-buttons-repeat.adb index 9b3af65..e34d395 100644 --- a/src/fltk-widgets-buttons-repeat.adb +++ b/src/fltk-widgets-buttons-repeat.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Repeat is procedure repeat_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, repeat_button_set_draw_hook, "repeat_button_set_draw_hook"); pragma Inline (repeat_button_set_draw_hook); procedure repeat_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, repeat_button_set_handle_hook, "repeat_button_set_handle_hook"); pragma Inline (repeat_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Repeat is function new_fl_repeat_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_repeat_button, "new_fl_repeat_button"); pragma Inline (new_fl_repeat_button); procedure free_fl_repeat_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_repeat_button, "free_fl_repeat_button"); pragma Inline (free_fl_repeat_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Repeat is procedure fl_repeat_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_repeat_button_draw, "fl_repeat_button_draw"); pragma Inline (fl_repeat_button_draw); function fl_repeat_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_repeat_button_handle, "fl_repeat_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Repeat is procedure Finalize (This : in out Repeat_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Repeat_Button'Class then free_fl_repeat_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Repeat is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - repeat_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - repeat_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + repeat_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + repeat_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons-toggle.adb b/src/fltk-widgets-buttons-toggle.adb index 21df56b..61418c2 100644 --- a/src/fltk-widgets-buttons-toggle.adb +++ b/src/fltk-widgets-buttons-toggle.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons.Toggle is procedure toggle_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, toggle_button_set_draw_hook, "toggle_button_set_draw_hook"); pragma Inline (toggle_button_set_draw_hook); procedure toggle_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, toggle_button_set_handle_hook, "toggle_button_set_handle_hook"); pragma Inline (toggle_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons.Toggle is function new_fl_toggle_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_toggle_button, "new_fl_toggle_button"); pragma Inline (new_fl_toggle_button); procedure free_fl_toggle_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_toggle_button, "free_fl_toggle_button"); pragma Inline (free_fl_toggle_button); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Buttons.Toggle is procedure fl_toggle_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_toggle_button_draw, "fl_toggle_button_draw"); pragma Inline (fl_toggle_button_draw); function fl_toggle_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_toggle_button_handle, "fl_toggle_button_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Buttons.Toggle is procedure Finalize (This : in out Toggle_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Toggle_Button'Class then free_fl_toggle_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Button (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Buttons.Toggle is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - toggle_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - toggle_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + toggle_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + toggle_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-buttons.adb b/src/fltk-widgets-buttons.adb index fb2735f..f4f1e78 100644 --- a/src/fltk-widgets-buttons.adb +++ b/src/fltk-widgets-buttons.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Buttons is procedure button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, button_set_draw_hook, "button_set_draw_hook"); pragma Inline (button_set_draw_hook); procedure button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, button_set_handle_hook, "button_set_handle_hook"); pragma Inline (button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Buttons is function new_fl_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_button, "new_fl_button"); pragma Inline (new_fl_button); procedure free_fl_button - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_button, "free_fl_button"); pragma Inline (free_fl_button); @@ -42,19 +37,19 @@ package body FLTK.Widgets.Buttons is function fl_button_get_state - (B : in System.Address) + (B : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_button_get_state, "fl_button_get_state"); pragma Inline (fl_button_get_state); procedure fl_button_set_state - (B : in System.Address; + (B : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_button_set_state, "fl_button_set_state"); pragma Inline (fl_button_set_state); procedure fl_button_set_only - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, fl_button_set_only, "fl_button_set_only"); pragma Inline (fl_button_set_only); @@ -62,25 +57,25 @@ package body FLTK.Widgets.Buttons is function fl_button_get_down_box - (B : in System.Address) + (B : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_button_get_down_box, "fl_button_get_down_box"); pragma Inline (fl_button_get_down_box); procedure fl_button_set_down_box - (B : in System.Address; + (B : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_button_set_down_box, "fl_button_set_down_box"); pragma Inline (fl_button_set_down_box); function fl_button_get_shortcut - (B : in System.Address) + (B : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_button_get_shortcut, "fl_button_get_shortcut"); pragma Inline (fl_button_get_shortcut); procedure fl_button_set_shortcut - (B : in System.Address; + (B : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_button_set_shortcut, "fl_button_set_shortcut"); pragma Inline (fl_button_set_shortcut); @@ -89,12 +84,12 @@ package body FLTK.Widgets.Buttons is procedure fl_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_button_draw, "fl_button_draw"); pragma Inline (fl_button_draw); function fl_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_button_handle, "fl_button_handle"); @@ -106,11 +101,11 @@ package body FLTK.Widgets.Buttons is procedure Finalize (This : in out Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Button'Class then free_fl_button (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -134,9 +129,9 @@ package body FLTK.Widgets.Buttons is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + button_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + button_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-charts.adb b/src/fltk-widgets-charts.adb index 573a011..0bb4b2d 100644 --- a/src/fltk-widgets-charts.adb +++ b/src/fltk-widgets-charts.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Charts is procedure chart_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, chart_set_draw_hook, "chart_set_draw_hook"); pragma Inline (chart_set_draw_hook); procedure chart_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, chart_set_handle_hook, "chart_set_handle_hook"); pragma Inline (chart_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Charts is function new_fl_chart (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_chart, "new_fl_chart"); pragma Inline (new_fl_chart); procedure free_fl_chart - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_chart, "free_fl_chart"); pragma Inline (free_fl_chart); @@ -43,7 +41,7 @@ package body FLTK.Widgets.Charts is procedure fl_chart_add - (C : in System.Address; + (C : in Storage.Integer_Address; V : in Interfaces.C.double; L : in Interfaces.C.char_array; P : in Interfaces.C.unsigned); @@ -51,7 +49,7 @@ package body FLTK.Widgets.Charts is pragma Inline (fl_chart_add); procedure fl_chart_insert - (C : in System.Address; + (C : in Storage.Integer_Address; I : in Interfaces.C.int; V : in Interfaces.C.double; L : in Interfaces.C.char_array; @@ -60,7 +58,7 @@ package body FLTK.Widgets.Charts is pragma Inline (fl_chart_insert); procedure fl_chart_replace - (C : in System.Address; + (C : in Storage.Integer_Address; I : in Interfaces.C.int; V : in Interfaces.C.double; L : in Interfaces.C.char_array; @@ -69,7 +67,7 @@ package body FLTK.Widgets.Charts is pragma Inline (fl_chart_replace); procedure fl_chart_clear - (C : in System.Address); + (C : in Storage.Integer_Address); pragma Import (C, fl_chart_clear, "fl_chart_clear"); pragma Inline (fl_chart_clear); @@ -77,43 +75,43 @@ package body FLTK.Widgets.Charts is function fl_chart_get_autosize - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_chart_get_autosize, "fl_chart_get_autosize"); pragma Inline (fl_chart_get_autosize); procedure fl_chart_set_autosize - (C : in System.Address; + (C : in Storage.Integer_Address; A : in Interfaces.C.int); pragma Import (C, fl_chart_set_autosize, "fl_chart_set_autosize"); pragma Inline (fl_chart_set_autosize); procedure fl_chart_get_bounds - (C : in System.Address; + (C : in Storage.Integer_Address; L, U : out Interfaces.C.double); pragma Import (C, fl_chart_get_bounds, "fl_chart_get_bounds"); pragma Inline (fl_chart_get_bounds); procedure fl_chart_set_bounds - (C : in System.Address; + (C : in Storage.Integer_Address; L, U : in Interfaces.C.double); pragma Import (C, fl_chart_set_bounds, "fl_chart_set_bounds"); pragma Inline (fl_chart_set_bounds); function fl_chart_get_maxsize - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_chart_get_maxsize, "fl_chart_get_maxsize"); pragma Inline (fl_chart_get_maxsize); procedure fl_chart_set_maxsize - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_chart_set_maxsize, "fl_chart_set_maxsize"); pragma Inline (fl_chart_set_maxsize); function fl_chart_size - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_chart_size, "fl_chart_size"); pragma Inline (fl_chart_size); @@ -122,37 +120,37 @@ package body FLTK.Widgets.Charts is function fl_chart_get_textcolor - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_chart_get_textcolor, "fl_chart_get_textcolor"); pragma Inline (fl_chart_get_textcolor); procedure fl_chart_set_textcolor - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_chart_set_textcolor, "fl_chart_set_textcolor"); pragma Inline (fl_chart_set_textcolor); function fl_chart_get_textfont - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_chart_get_textfont, "fl_chart_get_textfont"); pragma Inline (fl_chart_get_textfont); procedure fl_chart_set_textfont - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_chart_set_textfont, "fl_chart_set_textfont"); pragma Inline (fl_chart_set_textfont); function fl_chart_get_textsize - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_chart_get_textsize, "fl_chart_get_textsize"); pragma Inline (fl_chart_get_textsize); procedure fl_chart_set_textsize - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_chart_set_textsize, "fl_chart_set_textsize"); pragma Inline (fl_chart_set_textsize); @@ -161,7 +159,7 @@ package body FLTK.Widgets.Charts is procedure fl_chart_size2 - (C : in System.Address; + (C : in Storage.Integer_Address; W, H : in Interfaces.C.int); pragma Import (C, fl_chart_size2, "fl_chart_size2"); pragma Inline (fl_chart_size2); @@ -170,12 +168,12 @@ package body FLTK.Widgets.Charts is procedure fl_chart_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_chart_draw, "fl_chart_draw"); pragma Inline (fl_chart_draw); function fl_chart_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_chart_handle, "fl_chart_handle"); @@ -187,11 +185,11 @@ package body FLTK.Widgets.Charts is procedure Finalize (This : in out Chart) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Chart'Class then free_fl_chart (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -215,9 +213,9 @@ package body FLTK.Widgets.Charts is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - chart_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - chart_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + chart_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + chart_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks-updated-round.adb b/src/fltk-widgets-clocks-updated-round.adb index eb0404a..2b59ddf 100644 --- a/src/fltk-widgets-clocks-updated-round.adb +++ b/src/fltk-widgets-clocks-updated-round.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Clocks.Updated.Round is procedure round_clock_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, round_clock_set_draw_hook, "round_clock_set_draw_hook"); pragma Inline (round_clock_set_draw_hook); procedure round_clock_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, round_clock_set_handle_hook, "round_clock_set_handle_hook"); pragma Inline (round_clock_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Clocks.Updated.Round is function new_fl_round_clock (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_round_clock, "new_fl_round_clock"); pragma Inline (new_fl_round_clock); procedure free_fl_round_clock - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_round_clock, "free_fl_round_clock"); pragma Inline (free_fl_round_clock); @@ -42,18 +37,18 @@ package body FLTK.Widgets.Clocks.Updated.Round is procedure fl_round_clock_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_round_clock_draw, "fl_round_clock_draw"); pragma Inline (fl_round_clock_draw); procedure fl_round_clock_draw2 - (C : in System.Address; + (C : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int); pragma Import (C, fl_round_clock_draw2, "fl_round_clock_draw2"); pragma Inline (fl_round_clock_draw2); function fl_round_clock_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_round_clock_handle, "fl_round_clock_handle"); @@ -65,11 +60,11 @@ package body FLTK.Widgets.Clocks.Updated.Round is procedure Finalize (This : in out Round_Clock) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Round_Clock'Class then free_fl_round_clock (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Updated_Clock (This)); end Finalize; @@ -93,9 +88,11 @@ package body FLTK.Widgets.Clocks.Updated.Round is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - round_clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - round_clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + round_clock_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + round_clock_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks-updated.adb b/src/fltk-widgets-clocks-updated.adb index 0d77222..974545a 100644 --- a/src/fltk-widgets-clocks-updated.adb +++ b/src/fltk-widgets-clocks-updated.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Clocks.Updated is procedure clock_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, clock_set_draw_hook, "clock_set_draw_hook"); pragma Inline (clock_set_draw_hook); procedure clock_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, clock_set_handle_hook, "clock_set_handle_hook"); pragma Inline (clock_set_handle_hook); @@ -29,7 +24,7 @@ package body FLTK.Widgets.Clocks.Updated is function new_fl_clock (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_clock, "new_fl_clock"); pragma Inline (new_fl_clock); @@ -37,12 +32,12 @@ package body FLTK.Widgets.Clocks.Updated is (K : in Interfaces.C.unsigned_char; X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_clock2, "new_fl_clock2"); pragma Inline (new_fl_clock2); procedure free_fl_clock - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_clock, "free_fl_clock"); pragma Inline (free_fl_clock); @@ -50,18 +45,18 @@ package body FLTK.Widgets.Clocks.Updated is procedure fl_clock_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_clock_draw, "fl_clock_draw"); pragma Inline (fl_clock_draw); procedure fl_clock_draw2 - (C : in System.Address; + (C : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int); pragma Import (C, fl_clock_draw2, "fl_clock_draw2"); pragma Inline (fl_clock_draw2); function fl_clock_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_clock_handle, "fl_clock_handle"); @@ -73,11 +68,11 @@ package body FLTK.Widgets.Clocks.Updated is procedure Finalize (This : in out Updated_Clock) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Updated_Clock'Class then free_fl_clock (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Clock (This)); end Finalize; @@ -101,9 +96,9 @@ package body FLTK.Widgets.Clocks.Updated is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + clock_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + clock_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -125,9 +120,9 @@ package body FLTK.Widgets.Clocks.Updated is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + clock_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + clock_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-clocks.adb b/src/fltk-widgets-clocks.adb index cf83757..736fd73 100644 --- a/src/fltk-widgets-clocks.adb +++ b/src/fltk-widgets-clocks.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Clocks is procedure clock_output_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, clock_output_set_draw_hook, "clock_output_set_draw_hook"); pragma Inline (clock_output_set_draw_hook); procedure clock_output_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, clock_output_set_handle_hook, "clock_output_set_handle_hook"); pragma Inline (clock_output_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Clocks is function new_fl_clock_output (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_clock_output, "new_fl_clock_output"); pragma Inline (new_fl_clock_output); procedure free_fl_clock_output - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_clock_output, "free_fl_clock_output"); pragma Inline (free_fl_clock_output); @@ -42,19 +37,19 @@ package body FLTK.Widgets.Clocks is function fl_clock_output_get_hour - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_clock_output_get_hour, "fl_clock_output_get_hour"); pragma Inline (fl_clock_output_get_hour); function fl_clock_output_get_minute - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_clock_output_get_minute, "fl_clock_output_get_minute"); pragma Inline (fl_clock_output_get_minute); function fl_clock_output_get_second - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_clock_output_get_second, "fl_clock_output_get_second"); pragma Inline (fl_clock_output_get_second); @@ -63,19 +58,19 @@ package body FLTK.Widgets.Clocks is function fl_clock_output_get_value - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.unsigned_long; pragma Import (C, fl_clock_output_get_value, "fl_clock_output_get_value"); pragma Inline (fl_clock_output_get_value); procedure fl_clock_output_set_value - (C : in System.Address; + (C : in Storage.Integer_Address; V : in Interfaces.C.unsigned_long); pragma Import (C, fl_clock_output_set_value, "fl_clock_output_set_value"); pragma Inline (fl_clock_output_set_value); procedure fl_clock_output_set_value2 - (C : in System.Address; + (C : in Storage.Integer_Address; H, M, S : in Interfaces.C.int); pragma Import (C, fl_clock_output_set_value2, "fl_clock_output_set_value2"); pragma Inline (fl_clock_output_set_value2); @@ -84,18 +79,18 @@ package body FLTK.Widgets.Clocks is procedure fl_clock_output_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_clock_output_draw, "fl_clock_output_draw"); pragma Inline (fl_clock_output_draw); procedure fl_clock_output_draw2 - (C : in System.Address; + (C : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int); pragma Import (C, fl_clock_output_draw2, "fl_clock_output_draw2"); pragma Inline (fl_clock_output_draw2); function fl_clock_output_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_clock_output_handle, "fl_clock_output_handle"); @@ -107,11 +102,11 @@ package body FLTK.Widgets.Clocks is procedure Finalize (This : in out Clock) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Clock'Class then free_fl_clock_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -135,9 +130,11 @@ package body FLTK.Widgets.Clocks is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - clock_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - clock_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + clock_output_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + clock_output_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-color_choosers.adb b/src/fltk-widgets-groups-color_choosers.adb index 9c3dda2..60c6b1d 100644 --- a/src/fltk-widgets-groups-color_choosers.adb +++ b/src/fltk-widgets-groups-color_choosers.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Groups.Color_Choosers is procedure color_chooser_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, color_chooser_set_draw_hook, "color_chooser_set_draw_hook"); pragma Inline (color_chooser_set_draw_hook); procedure color_chooser_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, color_chooser_set_handle_hook, "color_chooser_set_handle_hook"); pragma Inline (color_chooser_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Groups.Color_Choosers is function new_fl_color_chooser (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_color_chooser, "new_fl_color_chooser"); pragma Inline (new_fl_color_chooser); procedure free_fl_color_chooser - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, free_fl_color_chooser, "free_fl_color_chooser"); pragma Inline (free_fl_color_chooser); @@ -43,25 +41,25 @@ package body FLTK.Widgets.Groups.Color_Choosers is function fl_color_chooser_r - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_r, "fl_color_chooser_r"); pragma Inline (fl_color_chooser_r); function fl_color_chooser_g - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_g, "fl_color_chooser_g"); pragma Inline (fl_color_chooser_g); function fl_color_chooser_b - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_b, "fl_color_chooser_b"); pragma Inline (fl_color_chooser_b); function fl_color_chooser_rgb - (N : in System.Address; + (N : in Storage.Integer_Address; R, G, B : in Interfaces.C.double) return Interfaces.C.int; pragma Import (C, fl_color_chooser_rgb, "fl_color_chooser_rgb"); @@ -71,25 +69,25 @@ package body FLTK.Widgets.Groups.Color_Choosers is function fl_color_chooser_hue - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_hue, "fl_color_chooser_hue"); pragma Inline (fl_color_chooser_hue); function fl_color_chooser_saturation - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_saturation, "fl_color_chooser_saturation"); pragma Inline (fl_color_chooser_saturation); function fl_color_chooser_value - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_color_chooser_value, "fl_color_chooser_value"); pragma Inline (fl_color_chooser_value); function fl_color_chooser_hsv - (N : in System.Address; + (N : in Storage.Integer_Address; H, S, V : in Interfaces.C.double) return Interfaces.C.int; pragma Import (C, fl_color_chooser_hsv, "fl_color_chooser_hsv"); @@ -114,13 +112,13 @@ package body FLTK.Widgets.Groups.Color_Choosers is function fl_color_chooser_get_mode - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_color_chooser_get_mode, "fl_color_chooser_get_mode"); pragma Inline (fl_color_chooser_get_mode); procedure fl_color_chooser_set_mode - (N : in System.Address; + (N : in Storage.Integer_Address; M : in Interfaces.C.int); pragma Import (C, fl_color_chooser_set_mode, "fl_color_chooser_set_mode"); pragma Inline (fl_color_chooser_set_mode); @@ -129,12 +127,12 @@ package body FLTK.Widgets.Groups.Color_Choosers is procedure fl_color_chooser_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_color_chooser_draw, "fl_color_chooser_draw"); pragma Inline (fl_color_chooser_draw); function fl_color_chooser_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_color_chooser_handle, "fl_color_chooser_handle"); @@ -146,12 +144,12 @@ package body FLTK.Widgets.Groups.Color_Choosers is procedure Finalize (This : in out Color_Chooser) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Color_Chooser'Class then This.Clear; free_fl_color_chooser (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -176,9 +174,11 @@ package body FLTK.Widgets.Groups.Color_Choosers is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - color_chooser_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - color_chooser_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + color_chooser_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + color_chooser_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-input_choices.adb b/src/fltk-widgets-groups-input_choices.adb index 2a7db68..92a1afe 100644 --- a/src/fltk-widgets-groups-input_choices.adb +++ b/src/fltk-widgets-groups-input_choices.adb @@ -3,26 +3,24 @@ with Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Groups.Input_Choices is procedure input_choice_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, input_choice_set_draw_hook, "input_choice_set_draw_hook"); pragma Inline (input_choice_set_draw_hook); procedure input_choice_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, input_choice_set_handle_hook, "input_choice_set_handle_hook"); pragma Inline (input_choice_set_handle_hook); @@ -32,12 +30,12 @@ package body FLTK.Widgets.Groups.Input_Choices is function new_fl_input_choice (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_input_choice, "new_fl_input_choice"); pragma Inline (new_fl_input_choice); procedure free_fl_input_choice - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, free_fl_input_choice, "free_fl_input_choice"); pragma Inline (free_fl_input_choice); @@ -45,14 +43,14 @@ package body FLTK.Widgets.Groups.Input_Choices is function fl_input_choice_input - (N : in System.Address) - return System.Address; + (N : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_input_choice_input, "fl_input_choice_input"); pragma Inline (fl_input_choice_input); function fl_input_choice_menubutton - (N : in System.Address) - return System.Address; + (N : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_input_choice_menubutton, "fl_input_choice_menubutton"); pragma Inline (fl_input_choice_menubutton); @@ -60,7 +58,7 @@ package body FLTK.Widgets.Groups.Input_Choices is procedure fl_input_choice_clear - (N : in System.Address); + (N : in Storage.Integer_Address); pragma Import (C, fl_input_choice_clear, "fl_input_choice_clear"); pragma Inline (fl_input_choice_clear); @@ -68,83 +66,83 @@ package body FLTK.Widgets.Groups.Input_Choices is function fl_input_choice_changed - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_choice_changed, "fl_input_choice_changed"); pragma Inline (fl_input_choice_changed); procedure fl_input_choice_clear_changed - (N : in System.Address); + (N : in Storage.Integer_Address); pragma Import (C, fl_input_choice_clear_changed, "fl_input_choice_clear_changed"); pragma Inline (fl_input_choice_clear_changed); procedure fl_input_choice_set_changed - (N : in System.Address); + (N : in Storage.Integer_Address); pragma Import (C, fl_input_choice_set_changed, "fl_input_choice_set_changed"); pragma Inline (fl_input_choice_set_changed); function fl_input_choice_get_down_box - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_choice_get_down_box, "fl_input_choice_get_down_box"); pragma Inline (fl_input_choice_get_down_box); procedure fl_input_choice_set_down_box - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_choice_set_down_box, "fl_input_choice_set_down_box"); pragma Inline (fl_input_choice_set_down_box); function fl_input_choice_get_textcolor - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_input_choice_get_textcolor, "fl_input_choice_get_textcolor"); pragma Inline (fl_input_choice_get_textcolor); procedure fl_input_choice_set_textcolor - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_input_choice_set_textcolor, "fl_input_choice_set_textcolor"); pragma Inline (fl_input_choice_set_textcolor); function fl_input_choice_get_textfont - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_choice_get_textfont, "fl_input_choice_get_textfont"); pragma Inline (fl_input_choice_get_textfont); procedure fl_input_choice_set_textfont - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_choice_set_textfont, "fl_input_choice_set_textfont"); pragma Inline (fl_input_choice_set_textfont); function fl_input_choice_get_textsize - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_choice_get_textsize, "fl_input_choice_get_textsize"); pragma Inline (fl_input_choice_get_textsize); procedure fl_input_choice_set_textsize - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_choice_set_textsize, "fl_input_choice_set_textsize"); pragma Inline (fl_input_choice_set_textsize); function fl_input_choice_get_value - (N : in System.Address) + (N : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_input_choice_get_value, "fl_input_choice_get_value"); pragma Inline (fl_input_choice_get_value); procedure fl_input_choice_set_value - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_input_choice_set_value, "fl_input_choice_set_value"); pragma Inline (fl_input_choice_set_value); procedure fl_input_choice_set_value2 - (N : in System.Address; + (N : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_choice_set_value2, "fl_input_choice_set_value2"); pragma Inline (fl_input_choice_set_value2); @@ -153,12 +151,12 @@ package body FLTK.Widgets.Groups.Input_Choices is procedure fl_input_choice_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_input_choice_draw, "fl_input_choice_draw"); pragma Inline (fl_input_choice_draw); function fl_input_choice_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_choice_handle, "fl_input_choice_handle"); @@ -178,14 +176,14 @@ package body FLTK.Widgets.Groups.Input_Choices is procedure Finalize (This : in out Input_Choice) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Input_Choice'Class then Group (This).Clear; free_fl_input_choice (This.Void_Ptr); Free (This.My_Input); Free (This.My_Menu_Button); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -210,9 +208,11 @@ package body FLTK.Widgets.Groups.Input_Choices is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - input_choice_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - input_choice_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + input_choice_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + input_choice_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); This.My_Input := new INP.Input; diff --git a/src/fltk-widgets-groups-packed.adb b/src/fltk-widgets-groups-packed.adb index 69b6e7c..b35f75f 100644 --- a/src/fltk-widgets-groups-packed.adb +++ b/src/fltk-widgets-groups-packed.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Packed is procedure pack_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, pack_set_draw_hook, "pack_set_draw_hook"); pragma Inline (pack_set_draw_hook); procedure pack_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, pack_set_handle_hook, "pack_set_handle_hook"); pragma Inline (pack_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Groups.Packed is function new_fl_pack (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_pack, "new_fl_pack"); pragma Inline (new_fl_pack); procedure free_fl_pack - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_pack, "free_fl_pack"); pragma Inline (free_fl_pack); @@ -42,13 +37,13 @@ package body FLTK.Widgets.Groups.Packed is function fl_pack_get_spacing - (P : in System.Address) + (P : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_pack_get_spacing, "fl_pack_get_spacing"); pragma Inline (fl_pack_get_spacing); procedure fl_pack_set_spacing - (P : in System.Address; + (P : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_pack_set_spacing, "fl_pack_set_spacing"); pragma Inline (fl_pack_set_spacing); @@ -57,12 +52,12 @@ package body FLTK.Widgets.Groups.Packed is procedure fl_pack_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_pack_draw, "fl_pack_draw"); pragma Inline (fl_pack_draw); function fl_pack_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_pack_handle, "fl_pack_handle"); @@ -74,12 +69,12 @@ package body FLTK.Widgets.Groups.Packed is procedure Finalize (This : in out Packed_Group) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Packed_Group'Class then This.Clear; free_fl_pack (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -104,9 +99,9 @@ package body FLTK.Widgets.Groups.Packed is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - pack_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - pack_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + pack_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + pack_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-scrolls.adb b/src/fltk-widgets-groups-scrolls.adb index 50a2728..833d24b 100644 --- a/src/fltk-widgets-groups-scrolls.adb +++ b/src/fltk-widgets-groups-scrolls.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Scrolls is procedure scroll_set_draw_hook - (S, D : in System.Address); + (S, D : in Storage.Integer_Address); pragma Import (C, scroll_set_draw_hook, "scroll_set_draw_hook"); pragma Inline (scroll_set_draw_hook); procedure scroll_set_handle_hook - (S, H : in System.Address); + (S, H : in Storage.Integer_Address); pragma Import (C, scroll_set_handle_hook, "scroll_set_handle_hook"); pragma Inline (scroll_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Groups.Scrolls is function new_fl_scroll (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_scroll, "new_fl_scroll"); pragma Inline (new_fl_scroll); procedure free_fl_scroll - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_scroll, "free_fl_scroll"); pragma Inline (free_fl_scroll); @@ -42,7 +37,7 @@ package body FLTK.Widgets.Groups.Scrolls is procedure fl_scroll_clear - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_scroll_clear, "fl_scroll_clear"); pragma Inline (fl_scroll_clear); @@ -50,13 +45,13 @@ package body FLTK.Widgets.Groups.Scrolls is procedure fl_scroll_to - (S : in System.Address; + (S : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_scroll_to, "fl_scroll_to"); pragma Inline (fl_scroll_to); procedure fl_scroll_set_type - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_scroll_set_type, "fl_scroll_set_type"); pragma Inline (fl_scroll_set_type); @@ -65,25 +60,25 @@ package body FLTK.Widgets.Groups.Scrolls is function fl_scroll_get_size - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_scroll_get_size, "fl_scroll_get_size"); pragma Inline (fl_scroll_get_size); procedure fl_scroll_set_size - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_scroll_set_size, "fl_scroll_set_size"); pragma Inline (fl_scroll_set_size); function fl_scroll_xposition - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_scroll_xposition, "fl_scroll_xposition"); pragma Inline (fl_scroll_xposition); function fl_scroll_yposition - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_scroll_yposition, "fl_scroll_yposition"); pragma Inline (fl_scroll_yposition); @@ -92,12 +87,12 @@ package body FLTK.Widgets.Groups.Scrolls is procedure fl_scroll_draw - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_scroll_draw, "fl_scroll_draw"); pragma Inline (fl_scroll_draw); function fl_scroll_handle - (S : in System.Address; + (S : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_scroll_handle, "fl_scroll_handle"); @@ -109,12 +104,12 @@ package body FLTK.Widgets.Groups.Scrolls is procedure Finalize (This : in out Scroll) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Scroll'Class then This.Clear; free_fl_scroll (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -139,9 +134,9 @@ package body FLTK.Widgets.Groups.Scrolls is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - scroll_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - scroll_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + scroll_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + scroll_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-spinners.adb b/src/fltk-widgets-groups-spinners.adb index fa12bb3..c24e9ec 100644 --- a/src/fltk-widgets-groups-spinners.adb +++ b/src/fltk-widgets-groups-spinners.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Groups.Spinners is procedure spinner_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, spinner_set_draw_hook, "spinner_set_draw_hook"); pragma Inline (spinner_set_draw_hook); procedure spinner_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, spinner_set_handle_hook, "spinner_set_handle_hook"); pragma Inline (spinner_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Groups.Spinners is function new_fl_spinner (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_spinner, "new_fl_spinner"); pragma Inline (new_fl_spinner); procedure free_fl_spinner - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, free_fl_spinner, "free_fl_spinner"); pragma Inline (free_fl_spinner); @@ -43,61 +41,61 @@ package body FLTK.Widgets.Groups.Spinners is function fl_spinner_get_color - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_spinner_get_color, "fl_spinner_get_color"); pragma Inline (fl_spinner_get_color); procedure fl_spinner_set_color - (S : in System.Address; + (S : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_spinner_set_color, "fl_spinner_set_color"); pragma Inline (fl_spinner_set_color); function fl_spinner_get_selection_color - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_spinner_get_selection_color, "fl_spinner_get_selection_color"); pragma Inline (fl_spinner_get_selection_color); procedure fl_spinner_set_selection_color - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_spinner_set_selection_color, "fl_spinner_set_selection_color"); pragma Inline (fl_spinner_set_selection_color); function fl_spinner_get_textcolor - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_spinner_get_textcolor, "fl_spinner_get_textcolor"); pragma Inline (fl_spinner_get_textcolor); procedure fl_spinner_set_textcolor - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_spinner_set_textcolor, "fl_spinner_set_textcolor"); pragma Inline (fl_spinner_set_textcolor); function fl_spinner_get_textfont - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_spinner_get_textfont, "fl_spinner_get_textfont"); pragma Inline (fl_spinner_get_textfont); procedure fl_spinner_set_textfont - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_spinner_set_textfont, "fl_spinner_set_textfont"); pragma Inline (fl_spinner_set_textfont); function fl_spinner_get_textsize - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_spinner_get_textsize, "fl_spinner_get_textsize"); pragma Inline (fl_spinner_get_textsize); procedure fl_spinner_set_textsize - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_spinner_set_textsize, "fl_spinner_set_textsize"); pragma Inline (fl_spinner_set_textsize); @@ -106,67 +104,67 @@ package body FLTK.Widgets.Groups.Spinners is function fl_spinner_get_minimum - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_spinner_get_minimum, "fl_spinner_get_minimum"); pragma Inline (fl_spinner_get_minimum); procedure fl_spinner_set_minimum - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_spinner_set_minimum, "fl_spinner_set_minimum"); pragma Inline (fl_spinner_set_minimum); function fl_spinner_get_maximum - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_spinner_get_maximum, "fl_spinner_get_maximum"); pragma Inline (fl_spinner_get_maximum); procedure fl_spinner_set_maximum - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_spinner_set_maximum, "fl_spinner_set_maximum"); pragma Inline (fl_spinner_set_maximum); procedure fl_spinner_range - (S : in System.Address; + (S : in Storage.Integer_Address; A, B : in Interfaces.C.double); pragma Import (C, fl_spinner_range, "fl_spinner_range"); pragma Inline (fl_spinner_range); function fl_spinner_get_step - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_spinner_get_step, "fl_spinner_get_step"); pragma Inline (fl_spinner_get_step); procedure fl_spinner_set_step - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_spinner_set_step, "fl_spinner_set_step"); pragma Inline (fl_spinner_set_step); function fl_spinner_get_type - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_spinner_get_type, "fl_spinner_get_type"); pragma Inline (fl_spinner_get_type); procedure fl_spinner_set_type - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_spinner_set_type, "fl_spinner_set_type"); pragma Inline (fl_spinner_set_type); function fl_spinner_get_value - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_spinner_get_value, "fl_spinner_get_value"); pragma Inline (fl_spinner_get_value); procedure fl_spinner_set_value - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_spinner_set_value, "fl_spinner_set_value"); pragma Inline (fl_spinner_set_value); @@ -175,12 +173,12 @@ package body FLTK.Widgets.Groups.Spinners is procedure fl_spinner_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_spinner_draw, "fl_spinner_draw"); pragma Inline (fl_spinner_draw); function fl_spinner_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_spinner_handle, "fl_spinner_handle"); @@ -192,12 +190,12 @@ package body FLTK.Widgets.Groups.Spinners is procedure Finalize (This : in out Spinner) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Spinner'Class then This.Clear; free_fl_spinner (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -222,9 +220,9 @@ package body FLTK.Widgets.Groups.Spinners is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - spinner_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - spinner_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + spinner_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + spinner_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-tabbed.adb b/src/fltk-widgets-groups-tabbed.adb index 76e1b0d..e6f3b60 100644 --- a/src/fltk-widgets-groups-tabbed.adb +++ b/src/fltk-widgets-groups-tabbed.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Tabbed is procedure tabs_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, tabs_set_draw_hook, "tabs_set_draw_hook"); pragma Inline (tabs_set_draw_hook); procedure tabs_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, tabs_set_handle_hook, "tabs_set_handle_hook"); pragma Inline (tabs_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Groups.Tabbed is function new_fl_tabs (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_tabs, "new_fl_tabs"); pragma Inline (new_fl_tabs); procedure free_fl_tabs - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_tabs, "free_fl_tabs"); pragma Inline (free_fl_tabs); @@ -42,7 +37,7 @@ package body FLTK.Widgets.Groups.Tabbed is procedure fl_tabs_client_area - (T : in System.Address; + (T : in Storage.Integer_Address; X, Y, W, H : out Interfaces.C.int; I : in Interfaces.C.int); pragma Import (C, fl_tabs_client_area, "fl_tabs_client_area"); @@ -52,31 +47,31 @@ package body FLTK.Widgets.Groups.Tabbed is function fl_tabs_get_push - (T : in System.Address) - return System.Address; + (T : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_tabs_get_push, "fl_tabs_get_push"); pragma Inline (fl_tabs_get_push); procedure fl_tabs_set_push - (T, I : in System.Address); + (T, I : in Storage.Integer_Address); pragma Import (C, fl_tabs_set_push, "fl_tabs_set_push"); pragma Inline (fl_tabs_set_push); function fl_tabs_get_value - (T : in System.Address) - return System.Address; + (T : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_tabs_get_value, "fl_tabs_get_value"); pragma Inline (fl_tabs_get_value); procedure fl_tabs_set_value - (T, V : in System.Address); + (T, V : in Storage.Integer_Address); pragma Import (C, fl_tabs_set_value, "fl_tabs_set_value"); pragma Inline (fl_tabs_set_value); function fl_tabs_which - (T : in System.Address; + (T : in Storage.Integer_Address; X, Y : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_tabs_which, "fl_tabs_which"); pragma Inline (fl_tabs_which); @@ -84,12 +79,12 @@ package body FLTK.Widgets.Groups.Tabbed is procedure fl_tabs_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_tabs_draw, "fl_tabs_draw"); pragma Inline (fl_tabs_draw); function fl_tabs_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_tabs_handle, "fl_tabs_handle"); @@ -101,12 +96,12 @@ package body FLTK.Widgets.Groups.Tabbed is procedure Finalize (This : in out Tabbed_Group) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Tabbed_Group'Class then This.Clear; free_fl_tabs (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -131,9 +126,9 @@ package body FLTK.Widgets.Groups.Tabbed is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - tabs_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - tabs_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + tabs_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + tabs_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -164,10 +159,10 @@ package body FLTK.Widgets.Groups.Tabbed is (This : in Tabbed_Group) return access Widget'Class is - Widget_Ptr : System.Address := + Widget_Ptr : Storage.Integer_Address := fl_tabs_get_push (This.Void_Ptr); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return Actual_Widget; end Get_Push; @@ -185,10 +180,10 @@ package body FLTK.Widgets.Groups.Tabbed is (This : in Tabbed_Group) return access Widget'Class is - Widget_Ptr : System.Address := + Widget_Ptr : Storage.Integer_Address := fl_tabs_get_value (This.Void_Ptr); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return Actual_Widget; end Get_Visible; @@ -207,10 +202,10 @@ package body FLTK.Widgets.Groups.Tabbed is Event_X, Event_Y : in Integer) return access Widget'Class is - Widget_Ptr : System.Address := + Widget_Ptr : Storage.Integer_Address := fl_tabs_which (This.Void_Ptr, Interfaces.C.int (Event_X), Interfaces.C.int (Event_Y)); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return Actual_Widget; end Get_Which; diff --git a/src/fltk-widgets-groups-text_displays-text_editors.adb b/src/fltk-widgets-groups-text_displays-text_editors.adb index 17776c4..e0d4588 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.adb +++ b/src/fltk-widgets-groups-text_displays-text_editors.adb @@ -3,25 +3,23 @@ with FLTK.Event, - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.unsigned_long, - System.Address; + Interfaces.C.unsigned_long; package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure text_editor_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, text_editor_set_draw_hook, "text_editor_set_draw_hook"); pragma Inline (text_editor_set_draw_hook); procedure text_editor_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, text_editor_set_handle_hook, "text_editor_set_handle_hook"); pragma Inline (text_editor_set_handle_hook); @@ -31,12 +29,12 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function new_fl_text_editor (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_text_editor, "new_fl_text_editor"); pragma Inline (new_fl_text_editor); procedure free_fl_text_editor - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, free_fl_text_editor, "free_fl_text_editor"); pragma Inline (free_fl_text_editor); @@ -44,7 +42,7 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_default - (TE : in System.Address; + (TE : in Storage.Integer_Address; K : in Interfaces.C.int); pragma Import (C, fl_text_editor_default, "fl_text_editor_default"); pragma Inline (fl_text_editor_default); @@ -53,32 +51,32 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_undo - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_undo, "fl_text_editor_undo"); pragma Inline (fl_text_editor_undo); procedure fl_text_editor_cut - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_cut, "fl_text_editor_cut"); pragma Inline (fl_text_editor_cut); procedure fl_text_editor_copy - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_copy, "fl_text_editor_copy"); pragma Inline (fl_text_editor_copy); procedure fl_text_editor_paste - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_paste, "fl_text_editor_paste"); pragma Inline (fl_text_editor_paste); procedure fl_text_editor_delete - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_delete, "fl_text_editor_delete"); pragma Inline (fl_text_editor_delete); procedure fl_text_editor_select_all - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_select_all, "fl_text_editor_select_all"); pragma Inline (fl_text_editor_select_all); @@ -86,22 +84,22 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_backspace - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_backspace, "fl_text_editor_backspace"); pragma Inline (fl_text_editor_backspace); procedure fl_text_editor_insert - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_insert, "fl_text_editor_insert"); pragma Inline (fl_text_editor_insert); procedure fl_text_editor_enter - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_enter, "fl_text_editor_enter"); pragma Inline (fl_text_editor_enter); procedure fl_text_editor_ignore - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ignore, "fl_text_editor_ignore"); pragma Inline (fl_text_editor_ignore); @@ -109,42 +107,42 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_home - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_home, "fl_text_editor_home"); pragma Inline (fl_text_editor_home); procedure fl_text_editor_end - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_end, "fl_text_editor_end"); pragma Inline (fl_text_editor_end); procedure fl_text_editor_page_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_page_down, "fl_text_editor_page_down"); pragma Inline (fl_text_editor_page_down); procedure fl_text_editor_page_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_page_up, "fl_text_editor_page_up"); pragma Inline (fl_text_editor_page_up); procedure fl_text_editor_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_down, "fl_text_editor_down"); pragma Inline (fl_text_editor_down); procedure fl_text_editor_left - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_left, "fl_text_editor_left"); pragma Inline (fl_text_editor_left); procedure fl_text_editor_right - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_right, "fl_text_editor_right"); pragma Inline (fl_text_editor_right); procedure fl_text_editor_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_up, "fl_text_editor_up"); pragma Inline (fl_text_editor_up); @@ -152,42 +150,42 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_shift_home - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_home, "fl_text_editor_shift_home"); pragma Inline (fl_text_editor_shift_home); procedure fl_text_editor_shift_end - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_end, "fl_text_editor_shift_end"); pragma Inline (fl_text_editor_shift_end); procedure fl_text_editor_shift_page_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_page_down, "fl_text_editor_shift_page_down"); pragma Inline (fl_text_editor_shift_page_down); procedure fl_text_editor_shift_page_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_page_up, "fl_text_editor_shift_page_up"); pragma Inline (fl_text_editor_shift_page_up); procedure fl_text_editor_shift_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_down, "fl_text_editor_shift_down"); pragma Inline (fl_text_editor_shift_down); procedure fl_text_editor_shift_left - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_left, "fl_text_editor_shift_left"); pragma Inline (fl_text_editor_shift_left); procedure fl_text_editor_shift_right - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_right, "fl_text_editor_shift_right"); pragma Inline (fl_text_editor_shift_right); procedure fl_text_editor_shift_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_shift_up, "fl_text_editor_shift_up"); pragma Inline (fl_text_editor_shift_up); @@ -195,42 +193,42 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_ctrl_home - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_home, "fl_text_editor_ctrl_home"); pragma Inline (fl_text_editor_ctrl_home); procedure fl_text_editor_ctrl_end - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_end, "fl_text_editor_ctrl_end"); pragma Inline (fl_text_editor_ctrl_end); procedure fl_text_editor_ctrl_page_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_page_down, "fl_text_editor_ctrl_page_down"); pragma Inline (fl_text_editor_ctrl_page_down); procedure fl_text_editor_ctrl_page_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_page_up, "fl_text_editor_ctrl_page_up"); pragma Inline (fl_text_editor_ctrl_page_up); procedure fl_text_editor_ctrl_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_down, "fl_text_editor_ctrl_down"); pragma Inline (fl_text_editor_ctrl_down); procedure fl_text_editor_ctrl_left - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_left, "fl_text_editor_ctrl_left"); pragma Inline (fl_text_editor_ctrl_left); procedure fl_text_editor_ctrl_right - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_right, "fl_text_editor_ctrl_right"); pragma Inline (fl_text_editor_ctrl_right); procedure fl_text_editor_ctrl_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_up, "fl_text_editor_ctrl_up"); pragma Inline (fl_text_editor_ctrl_up); @@ -238,42 +236,42 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_ctrl_shift_home - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_home, "fl_text_editor_ctrl_shift_home"); pragma Inline (fl_text_editor_ctrl_shift_home); procedure fl_text_editor_ctrl_shift_end - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_end, "fl_text_editor_ctrl_shift_end"); pragma Inline (fl_text_editor_ctrl_shift_end); procedure fl_text_editor_ctrl_shift_page_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_page_down, "fl_text_editor_ctrl_shift_page_down"); pragma Inline (fl_text_editor_ctrl_shift_page_down); procedure fl_text_editor_ctrl_shift_page_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_page_up, "fl_text_editor_ctrl_shift_page_up"); pragma Inline (fl_text_editor_ctrl_shift_page_up); procedure fl_text_editor_ctrl_shift_down - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_down, "fl_text_editor_ctrl_shift_down"); pragma Inline (fl_text_editor_ctrl_shift_down); procedure fl_text_editor_ctrl_shift_left - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_left, "fl_text_editor_ctrl_shift_left"); pragma Inline (fl_text_editor_ctrl_shift_left); procedure fl_text_editor_ctrl_shift_right - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_right, "fl_text_editor_ctrl_shift_right"); pragma Inline (fl_text_editor_ctrl_shift_right); procedure fl_text_editor_ctrl_shift_up - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_ctrl_shift_up, "fl_text_editor_ctrl_shift_up"); pragma Inline (fl_text_editor_ctrl_shift_up); @@ -281,27 +279,27 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_add_key_binding - (TE : in System.Address; + (TE : in Storage.Integer_Address; K, S : in Interfaces.C.int; - F : in System.Address); + F : in Storage.Integer_Address); pragma Import (C, fl_text_editor_add_key_binding, "fl_text_editor_add_key_binding"); pragma Inline (fl_text_editor_add_key_binding); -- this particular procedure won't be necessary when FLTK keybindings fixed procedure fl_text_editor_remove_key_binding - (TE : in System.Address; + (TE : in Storage.Integer_Address; K, S : in Interfaces.C.int); pragma Import (C, fl_text_editor_remove_key_binding, "fl_text_editor_remove_key_binding"); pragma Inline (fl_text_editor_remove_key_binding); procedure fl_text_editor_remove_all_key_bindings - (TE : in System.Address); + (TE : in Storage.Integer_Address); pragma Import (C, fl_text_editor_remove_all_key_bindings, "fl_text_editor_remove_all_key_bindings"); pragma Inline (fl_text_editor_remove_all_key_bindings); procedure fl_text_editor_set_default_key_function - (TE, F : in System.Address); + (TE, F : in Storage.Integer_Address); pragma Import (C, fl_text_editor_set_default_key_function, "fl_text_editor_set_default_key_function"); pragma Inline (fl_text_editor_set_default_key_function); @@ -310,13 +308,13 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function fl_text_editor_get_insert_mode - (TE : in System.Address) + (TE : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_editor_get_insert_mode, "fl_text_editor_get_insert_mode"); pragma Inline (fl_text_editor_get_insert_mode); procedure fl_text_editor_set_insert_mode - (TE : in System.Address; + (TE : in Storage.Integer_Address; I : in Interfaces.C.int); pragma Import (C, fl_text_editor_set_insert_mode, "fl_text_editor_set_insert_mode"); pragma Inline (fl_text_editor_set_insert_mode); @@ -325,13 +323,13 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is -- function fl_text_editor_get_tab_nav - -- (TE : in System.Address) + -- (TE : in Storage.Integer_Address) -- return Interfaces.C.int; -- pragma Import (C, fl_text_editor_get_tab_nav, "fl_text_editor_get_tab_nav"); -- pragma Inline (fl_text_editor_get_tab_nav); -- procedure fl_text_editor_set_tab_nav - -- (TE : in System.Address; + -- (TE : in Storage.Integer_Address; -- T : in Interfaces.C.int); -- pragma Import (C, fl_text_editor_set_tab_nav, "fl_text_editor_set_tab_nav"); -- pragma Inline (fl_text_editor_set_tab_nav); @@ -340,12 +338,12 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure fl_text_editor_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_text_editor_draw, "fl_text_editor_draw"); pragma Inline (fl_text_editor_draw); function fl_text_editor_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_editor_handle, "fl_text_editor_handle"); @@ -356,11 +354,11 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is function Key_Func_Hook (K : in Interfaces.C.int; - E : in System.Address) + E : in Storage.Integer_Address) return Interfaces.C.int is Ada_Editor : access Text_Editor'Class := - Editor_Convert.To_Pointer (fl_widget_get_user_data (E)); + Editor_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (E))); Modi : Modifier := FLTK.Event.Last_Modifier; Actual_Key : Keypress := FLTK.Event.Last_Key; -- fuck you FLTK, give me the real code Ada_Key : Key_Combo := To_Ada (To_C (Actual_Key) + To_C (Modi)); @@ -385,12 +383,12 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is procedure Finalize (This : in out Text_Editor) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Text_Editor'Class then This.Clear; free_fl_text_editor (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Text_Display (This)); end Finalize; @@ -449,9 +447,11 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - text_editor_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - text_editor_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + text_editor_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + text_editor_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); -- change things over so key bindings are all handled from the Ada side @@ -477,7 +477,8 @@ package body FLTK.Widgets.Groups.Text_Displays.Text_Editors is -- end loop; fl_text_editor_remove_all_key_bindings (This.Void_Ptr); - fl_text_editor_set_default_key_function (This.Void_Ptr, Key_Func_Hook'Address); + fl_text_editor_set_default_key_function + (This.Void_Ptr, Storage.To_Integer (Key_Func_Hook'Address)); -- this is irritatingly required due to how FLTK handles certain keys -- for B of Default_Key_Bindings loop diff --git a/src/fltk-widgets-groups-text_displays-text_editors.ads b/src/fltk-widgets-groups-text_displays-text_editors.ads index 3d1bdbe..c5cc46b 100644 --- a/src/fltk-widgets-groups-text_displays-text_editors.ads +++ b/src/fltk-widgets-groups-text_displays-text_editors.ads @@ -348,7 +348,7 @@ private function Key_Func_Hook (K : in Interfaces.C.int; - E : in System.Address) + E : in Storage.Integer_Address) return Interfaces.C.int; pragma Convention (C, Key_Func_Hook); diff --git a/src/fltk-widgets-groups-text_displays.adb b/src/fltk-widgets-groups-text_displays.adb index cd76007..59efc55 100644 --- a/src/fltk-widgets-groups-text_displays.adb +++ b/src/fltk-widgets-groups-text_displays.adb @@ -3,25 +3,23 @@ with Interfaces.C, - System, FLTK.Text_Buffers; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Groups.Text_Displays is procedure text_display_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, text_display_set_draw_hook, "text_display_set_draw_hook"); pragma Inline (text_display_set_draw_hook); procedure text_display_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, text_display_set_handle_hook, "text_display_set_handle_hook"); pragma Inline (text_display_set_handle_hook); @@ -31,12 +29,12 @@ package body FLTK.Widgets.Groups.Text_Displays is function new_fl_text_display (X, Y, W, H : in Interfaces.C.int; Label : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_text_display, "new_fl_text_display"); pragma Inline (new_fl_text_display); procedure free_fl_text_display - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, free_fl_text_display, "free_fl_text_display"); pragma Inline (free_fl_text_display); @@ -44,13 +42,13 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_get_buffer - (TD : in System.Address) - return System.Address; + (TD : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_text_display_get_buffer, "fl_text_display_get_buffer"); pragma Inline (fl_text_display_get_buffer); procedure fl_text_display_set_buffer - (TD, TB : in System.Address); + (TD, TB : in Storage.Integer_Address); pragma Import (C, fl_text_display_set_buffer, "fl_text_display_set_buffer"); pragma Inline (fl_text_display_set_buffer); @@ -58,16 +56,16 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure fl_text_display_highlight_data - (TD, TB, ST : in System.Address; + (TD, TB, ST : in Storage.Integer_Address; L : in Interfaces.C.int); pragma Import (C, fl_text_display_highlight_data, "fl_text_display_highlight_data"); pragma Inline (fl_text_display_highlight_data); procedure fl_text_display_highlight_data2 - (TD, TB, ST : in System.Address; + (TD, TB, ST : in Storage.Integer_Address; L : in Interfaces.C.int; C : in Interfaces.C.unsigned; - B, A : in System.Address); + B, A : in Storage.Integer_Address); pragma Import (C, fl_text_display_highlight_data2, "fl_text_display_highlight_data2"); pragma Inline (fl_text_display_highlight_data2); @@ -75,28 +73,28 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_col_to_x - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.double) return Interfaces.C.double; pragma Import (C, fl_text_display_col_to_x, "fl_text_display_col_to_x"); pragma Inline (fl_text_display_col_to_x); function fl_text_display_x_to_col - (TD : in System.Address; + (TD : in Storage.Integer_Address; X : in Interfaces.C.double) return Interfaces.C.double; pragma Import (C, fl_text_display_x_to_col, "fl_text_display_x_to_col"); pragma Inline (fl_text_display_x_to_col); function fl_text_display_in_selection - (TD : in System.Address; + (TD : in Storage.Integer_Address; X, Y : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_in_selection, "fl_text_display_in_selection"); pragma Inline (fl_text_display_in_selection); function fl_text_display_position_to_xy - (TD : in System.Address; + (TD : in Storage.Integer_Address; P : in Interfaces.C.int; X, Y : out Interfaces.C.int) return Interfaces.C.int; @@ -107,30 +105,30 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_get_cursor_color - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_cursor_color, "fl_text_display_get_cursor_color"); pragma Inline (fl_text_display_get_cursor_color); procedure fl_text_display_set_cursor_color - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_cursor_color, "fl_text_display_set_cursor_color"); pragma Inline (fl_text_display_set_cursor_color); procedure fl_text_display_set_cursor_style - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_text_display_set_cursor_style, "fl_text_display_set_cursor_style"); pragma Inline (fl_text_display_set_cursor_style); procedure fl_text_display_hide_cursor - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, fl_text_display_hide_cursor, "fl_text_display_hide_cursor"); pragma Inline (fl_text_display_hide_cursor); procedure fl_text_display_show_cursor - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, fl_text_display_show_cursor, "fl_text_display_show_cursor"); pragma Inline (fl_text_display_show_cursor); @@ -138,37 +136,37 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_get_text_color - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_text_color, "fl_text_display_get_text_color"); pragma Inline (fl_text_display_get_text_color); procedure fl_text_display_set_text_color - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_text_color, "fl_text_display_set_text_color"); pragma Inline (fl_text_display_set_text_color); function fl_text_display_get_text_font - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_text_font, "fl_text_display_get_text_font"); pragma Inline (fl_text_display_get_text_font); procedure fl_text_display_set_text_font - (TD : in System.Address; + (TD : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_text_display_set_text_font, "fl_text_display_set_text_font"); pragma Inline (fl_text_display_set_text_font); function fl_text_display_get_text_size - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_text_size, "fl_text_display_get_text_size"); pragma Inline (fl_text_display_get_text_size); procedure fl_text_display_set_text_size - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_text_display_set_text_size, "fl_text_display_set_text_size"); pragma Inline (fl_text_display_set_text_size); @@ -177,31 +175,31 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure fl_text_display_insert - (TD : in System.Address; + (TD : in Storage.Integer_Address; I : in Interfaces.C.char_array); pragma Import (C, fl_text_display_insert, "fl_text_display_insert"); pragma Inline (fl_text_display_insert); procedure fl_text_display_overstrike - (TD : in System.Address; + (TD : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_text_display_overstrike, "fl_text_display_overstrike"); pragma Inline (fl_text_display_overstrike); function fl_text_display_get_insert_pos - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_insert_pos, "fl_text_display_get_insert_pos"); pragma Inline (fl_text_display_get_insert_pos); procedure fl_text_display_set_insert_pos - (TD : in System.Address; + (TD : in Storage.Integer_Address; P : in Interfaces.C.int); pragma Import (C, fl_text_display_set_insert_pos, "fl_text_display_set_insert_pos"); pragma Inline (fl_text_display_set_insert_pos); procedure fl_text_display_show_insert_pos - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, fl_text_display_show_insert_pos, "fl_text_display_show_insert_pos"); pragma Inline (fl_text_display_show_insert_pos); @@ -209,31 +207,31 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_word_start - (TD : in System.Address; + (TD : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_word_start, "fl_text_display_word_start"); pragma Inline (fl_text_display_word_start); function fl_text_display_word_end - (TD : in System.Address; + (TD : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_word_end, "fl_text_display_word_end"); pragma Inline (fl_text_display_word_end); procedure fl_text_display_next_word - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, fl_text_display_next_word, "fl_text_display_next_word"); pragma Inline (fl_text_display_next_word); procedure fl_text_display_previous_word - (TD : in System.Address); + (TD : in Storage.Integer_Address); pragma Import (C, fl_text_display_previous_word, "fl_text_display_previous_word"); pragma Inline (fl_text_display_previous_word); procedure fl_text_display_wrap_mode - (TD : in System.Address; + (TD : in Storage.Integer_Address; W, M : in Interfaces.C.int); pragma Import (C, fl_text_display_wrap_mode, "fl_text_display_wrap_mode"); pragma Inline (fl_text_display_wrap_mode); @@ -242,35 +240,35 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_line_start - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_line_start, "fl_text_display_line_start"); pragma Inline (fl_text_display_line_start); function fl_text_display_line_end - (TD : in System.Address; + (TD : in Storage.Integer_Address; S, P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_line_end, "fl_text_display_line_end"); pragma Inline (fl_text_display_line_end); function fl_text_display_count_lines - (TD : in System.Address; + (TD : in Storage.Integer_Address; S, F, P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_count_lines, "fl_text_display_count_lines"); pragma Inline (fl_text_display_count_lines); function fl_text_display_skip_lines - (TD : in System.Address; + (TD : in Storage.Integer_Address; S, L, P : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_skip_lines, "fl_text_display_skip_lines"); pragma Inline (fl_text_display_skip_lines); function fl_text_display_rewind_lines - (TD : in System.Address; + (TD : in Storage.Integer_Address; S, L : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_rewind_lines, "fl_text_display_rewind_lines"); @@ -280,84 +278,84 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_get_linenumber_align - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_linenumber_align, "fl_text_display_get_linenumber_align"); pragma Inline (fl_text_display_get_linenumber_align); procedure fl_text_display_set_linenumber_align - (TD : in System.Address; + (TD : in Storage.Integer_Address; A : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_linenumber_align, "fl_text_display_set_linenumber_align"); pragma Inline (fl_text_display_set_linenumber_align); function fl_text_display_get_linenumber_bgcolor - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_linenumber_bgcolor, "fl_text_display_get_linenumber_bgcolor"); pragma Inline (fl_text_display_get_linenumber_bgcolor); procedure fl_text_display_set_linenumber_bgcolor - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_linenumber_bgcolor, "fl_text_display_set_linenumber_bgcolor"); pragma Inline (fl_text_display_set_linenumber_bgcolor); function fl_text_display_get_linenumber_fgcolor - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_linenumber_fgcolor, "fl_text_display_get_linenumber_fgcolor"); pragma Inline (fl_text_display_get_linenumber_fgcolor); procedure fl_text_display_set_linenumber_fgcolor - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_linenumber_fgcolor, "fl_text_display_set_linenumber_fgcolor"); pragma Inline (fl_text_display_set_linenumber_fgcolor); function fl_text_display_get_linenumber_font - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_linenumber_font, "fl_text_display_get_linenumber_font"); pragma Inline (fl_text_display_get_linenumber_font); procedure fl_text_display_set_linenumber_font - (TD : in System.Address; + (TD : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_text_display_set_linenumber_font, "fl_text_display_set_linenumber_font"); pragma Inline (fl_text_display_set_linenumber_font); function fl_text_display_get_linenumber_size - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_linenumber_size, "fl_text_display_get_linenumber_size"); pragma Inline (fl_text_display_get_linenumber_size); procedure fl_text_display_set_linenumber_size - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_text_display_set_linenumber_size, "fl_text_display_set_linenumber_size"); pragma Inline (fl_text_display_set_linenumber_size); function fl_text_display_get_linenumber_width - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_linenumber_width, "fl_text_display_get_linenumber_width"); pragma Inline (fl_text_display_get_linenumber_width); procedure fl_text_display_set_linenumber_width - (TD : in System.Address; + (TD : in Storage.Integer_Address; W : in Interfaces.C.int); pragma Import (C, fl_text_display_set_linenumber_width, "fl_text_display_set_linenumber_width"); @@ -367,25 +365,25 @@ package body FLTK.Widgets.Groups.Text_Displays is function fl_text_display_move_down - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_move_down, "fl_text_display_move_down"); pragma Inline (fl_text_display_move_down); function fl_text_display_move_left - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_move_left, "fl_text_display_move_left"); pragma Inline (fl_text_display_move_left); function fl_text_display_move_right - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_move_right, "fl_text_display_move_right"); pragma Inline (fl_text_display_move_right); function fl_text_display_move_up - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_move_up, "fl_text_display_move_up"); pragma Inline (fl_text_display_move_up); @@ -394,31 +392,31 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure fl_text_display_scroll - (TD : in System.Address; + (TD : in Storage.Integer_Address; L : in Interfaces.C.int); pragma Import (C, fl_text_display_scroll, "fl_text_display_scroll"); pragma Inline (fl_text_display_scroll); function fl_text_display_get_scrollbar_align - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_text_display_get_scrollbar_align, "fl_text_display_get_scrollbar_align"); pragma Inline (fl_text_display_get_scrollbar_align); procedure fl_text_display_set_scrollbar_align - (TD : in System.Address; + (TD : in Storage.Integer_Address; A : in Interfaces.C.unsigned); pragma Import (C, fl_text_display_set_scrollbar_align, "fl_text_display_set_scrollbar_align"); pragma Inline (fl_text_display_set_scrollbar_align); function fl_text_display_get_scrollbar_width - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_text_display_get_scrollbar_width, "fl_text_display_get_scrollbar_width"); pragma Inline (fl_text_display_get_scrollbar_width); procedure fl_text_display_set_scrollbar_width - (TD : in System.Address; + (TD : in Storage.Integer_Address; W : in Interfaces.C.int); pragma Import (C, fl_text_display_set_scrollbar_width, "fl_text_display_set_scrollbar_width"); pragma Inline (fl_text_display_set_scrollbar_width); @@ -427,18 +425,18 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure fl_text_display_redisplay_range - (TD : in System.Address; + (TD : in Storage.Integer_Address; S, F : in Interfaces.C.int); pragma Import (C, fl_text_display_redisplay_range, "fl_text_display_redisplay_range"); pragma Inline (fl_text_display_redisplay_range); procedure fl_text_display_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_text_display_draw, "fl_text_display_draw"); pragma Inline (fl_text_display_draw); function fl_text_display_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_text_display_handle, "fl_text_display_handle"); @@ -449,12 +447,12 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Style_Hook (C : in Interfaces.C.int; - D : in System.Address) + D : in Storage.Integer_Address) is use Styles; -- for maximum stylin' Ada_Widget : access Text_Display'Class := - Text_Display_Convert.To_Pointer (D); + Text_Display_Convert.To_Pointer (Storage.To_Address (D)); begin if Ada_Widget.Style_Callback /= null then Ada_Widget.Style_Callback (Character'Val (C), Text_Display (Ada_Widget.all)); @@ -467,12 +465,12 @@ package body FLTK.Widgets.Groups.Text_Displays is procedure Finalize (This : in out Text_Display) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Text_Display'Class then This.Clear; free_fl_text_display (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -497,9 +495,11 @@ package body FLTK.Widgets.Groups.Text_Displays is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - text_display_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - text_display_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + text_display_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + text_display_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -559,7 +559,7 @@ package body FLTK.Widgets.Groups.Text_Displays is fl_text_display_highlight_data (This.Void_Ptr, Wrapper (Buff).Void_Ptr, - Table'Address, + Storage.To_Integer (Table'Address), Table'Length); end Highlight_Data; @@ -575,11 +575,11 @@ package body FLTK.Widgets.Groups.Text_Displays is fl_text_display_highlight_data2 (This.Void_Ptr, Wrapper (Buff).Void_Ptr, - Table'Address, + Storage.To_Integer (Table'Address), Table'Length, Character'Pos (Character (Unfinished)), - Style_Hook'Address, - This'Address); + Storage.To_Integer (Style_Hook'Address), + Storage.To_Integer (This'Address)); end Highlight_Data; diff --git a/src/fltk-widgets-groups-tiled.adb b/src/fltk-widgets-groups-tiled.adb index 1652afe..293c52b 100644 --- a/src/fltk-widgets-groups-tiled.adb +++ b/src/fltk-widgets-groups-tiled.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Tiled is procedure tile_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, tile_set_draw_hook, "tile_set_draw_hook"); pragma Inline (tile_set_draw_hook); procedure tile_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, tile_set_handle_hook, "tile_set_handle_hook"); pragma Inline (tile_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Groups.Tiled is function new_fl_tile (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_tile, "new_fl_tile"); pragma Inline (new_fl_tile); procedure free_fl_tile - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_tile, "free_fl_tile"); pragma Inline (free_fl_tile); @@ -42,7 +37,7 @@ package body FLTK.Widgets.Groups.Tiled is procedure fl_tile_position - (T : in System.Address; + (T : in Storage.Integer_Address; OX, OY, NX, NY : in Interfaces.C.int); pragma Import (C, fl_tile_position, "fl_tile_position"); pragma Inline (fl_tile_position); @@ -51,12 +46,12 @@ package body FLTK.Widgets.Groups.Tiled is procedure fl_tile_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_tile_draw, "fl_tile_draw"); pragma Inline (fl_tile_draw); function fl_tile_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_tile_handle, "fl_tile_handle"); @@ -68,12 +63,12 @@ package body FLTK.Widgets.Groups.Tiled is procedure Finalize (This : in out Tiled_Group) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Tiled_Group'Class then This.Clear; free_fl_tile (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -98,9 +93,9 @@ package body FLTK.Widgets.Groups.Tiled is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - tile_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - tile_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + tile_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + tile_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-double-overlay.adb b/src/fltk-widgets-groups-windows-double-overlay.adb index e61782a..86c6d14 100644 --- a/src/fltk-widgets-groups-windows-double-overlay.adb +++ b/src/fltk-widgets-groups-windows-double-overlay.adb @@ -7,26 +7,25 @@ with use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure overlay_window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, overlay_window_set_draw_hook, "overlay_window_set_draw_hook"); pragma Inline (overlay_window_set_draw_hook); procedure overlay_window_set_draw_overlay_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, overlay_window_set_draw_overlay_hook, "overlay_window_set_draw_overlay_hook"); pragma Inline (overlay_window_set_draw_overlay_hook); procedure overlay_window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, overlay_window_set_handle_hook, "overlay_window_set_handle_hook"); pragma Inline (overlay_window_set_handle_hook); @@ -36,19 +35,19 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is function new_fl_overlay_window (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_overlay_window, "new_fl_overlay_window"); pragma Inline (new_fl_overlay_window); function new_fl_overlay_window2 (W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_overlay_window2, "new_fl_overlay_window2"); pragma Inline (new_fl_overlay_window2); procedure free_fl_overlay_window - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_overlay_window, "free_fl_overlay_window"); pragma Inline (free_fl_overlay_window); @@ -56,17 +55,17 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure fl_overlay_window_show - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_overlay_window_show, "fl_overlay_window_show"); pragma Inline (fl_overlay_window_show); procedure fl_overlay_window_hide - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_overlay_window_hide, "fl_overlay_window_hide"); pragma Inline (fl_overlay_window_hide); procedure fl_overlay_window_flush - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_overlay_window_flush, "fl_overlay_window_flush"); pragma Inline (fl_overlay_window_flush); @@ -74,7 +73,7 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is function fl_overlay_window_can_do_overlay - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_overlay_window_can_do_overlay, "fl_overlay_window_can_do_overlay"); pragma Inline (fl_overlay_window_can_do_overlay); @@ -83,17 +82,17 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure fl_overlay_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_overlay_window_draw, "fl_overlay_window_draw"); pragma Inline (fl_overlay_window_draw); procedure fl_overlay_window_redraw_overlay - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_overlay_window_redraw_overlay, "fl_overlay_window_redraw_overlay"); pragma Inline (fl_overlay_window_redraw_overlay); function fl_overlay_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_overlay_window_handle, "fl_overlay_window_handle"); @@ -106,10 +105,10 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure Draw_Overlay_Hook - (U : in System.Address) + (U : in Storage.Integer_Address) is Overlay_Widget : access Overlay_Window'Class := - Over_Convert.To_Pointer (U); + Over_Convert.To_Pointer (Storage.To_Address (U)); begin Overlay_Widget.Draw_Overlay; end Draw_Overlay_Hook; @@ -120,12 +119,12 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is procedure Finalize (This : in out Overlay_Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Overlay_Window'Class then This.Clear; free_fl_overlay_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Double_Window (This)); end Finalize; @@ -154,10 +153,13 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - overlay_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - overlay_window_set_draw_overlay_hook (This.Void_Ptr, Draw_Overlay_Hook'Address); - overlay_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + overlay_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + overlay_window_set_draw_overlay_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Overlay_Hook'Address)); + overlay_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -176,10 +178,13 @@ package body FLTK.Widgets.Groups.Windows.Double.Overlay is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - overlay_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - overlay_window_set_draw_overlay_hook (This.Void_Ptr, Draw_Overlay_Hook'Address); - overlay_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + overlay_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + overlay_window_set_draw_overlay_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Overlay_Hook'Address)); + overlay_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-double.adb b/src/fltk-widgets-groups-windows-double.adb index cc920d9..70f05fe 100644 --- a/src/fltk-widgets-groups-windows-double.adb +++ b/src/fltk-widgets-groups-windows-double.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Windows.Double is procedure double_window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, double_window_set_draw_hook, "double_window_set_draw_hook"); pragma Inline (double_window_set_draw_hook); procedure double_window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, double_window_set_handle_hook, "double_window_set_handle_hook"); pragma Inline (double_window_set_handle_hook); @@ -29,19 +24,19 @@ package body FLTK.Widgets.Groups.Windows.Double is function new_fl_double_window (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_double_window, "new_fl_double_window"); pragma Inline (new_fl_double_window); function new_fl_double_window2 (X, Y : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_double_window2, "new_fl_double_window2"); pragma Inline (new_fl_double_window2); procedure free_fl_double_window - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, free_fl_double_window, "free_fl_double_window"); pragma Inline (free_fl_double_window); @@ -49,17 +44,17 @@ package body FLTK.Widgets.Groups.Windows.Double is procedure fl_double_window_show - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_double_window_show, "fl_double_window_show"); pragma Inline (fl_double_window_show); procedure fl_double_window_hide - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_double_window_hide, "fl_double_window_hide"); pragma Inline (fl_double_window_hide); procedure fl_double_window_flush - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_double_window_flush, "fl_double_window_flush"); pragma Inline (fl_double_window_flush); @@ -67,12 +62,12 @@ package body FLTK.Widgets.Groups.Windows.Double is procedure fl_double_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_double_window_draw, "fl_double_window_draw"); pragma Inline (fl_double_window_draw); function fl_double_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_double_window_handle, "fl_double_window_handle"); @@ -84,12 +79,12 @@ package body FLTK.Widgets.Groups.Windows.Double is procedure Finalize (This : in out Double_Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Double_Window'Class then This.Clear; free_fl_double_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Window (This)); end Finalize; @@ -114,9 +109,11 @@ package body FLTK.Widgets.Groups.Windows.Double is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - double_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - double_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + double_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + double_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -135,9 +132,11 @@ package body FLTK.Widgets.Groups.Windows.Double is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - double_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - double_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + double_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + double_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-opengl.adb b/src/fltk-widgets-groups-windows-opengl.adb index c877497..3c46b15 100644 --- a/src/fltk-widgets-groups-windows-opengl.adb +++ b/src/fltk-widgets-groups-windows-opengl.adb @@ -9,20 +9,19 @@ use type Interfaces.C.int, Interfaces.C.signed_char, - Interfaces.C.unsigned, - System.Address; + Interfaces.C.unsigned; package body FLTK.Widgets.Groups.Windows.OpenGL is procedure gl_window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, gl_window_set_draw_hook, "gl_window_set_draw_hook"); pragma Inline (gl_window_set_draw_hook); procedure gl_window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, gl_window_set_handle_hook, "gl_window_set_handle_hook"); pragma Inline (gl_window_set_handle_hook); @@ -32,19 +31,19 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is function new_fl_gl_window (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_gl_window, "new_fl_gl_window"); pragma Inline (new_fl_gl_window); function new_fl_gl_window2 (W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_gl_window2, "new_fl_gl_window2"); pragma Inline (new_fl_gl_window2); procedure free_fl_gl_window - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_gl_window, "free_fl_gl_window"); pragma Inline (free_fl_gl_window); @@ -52,22 +51,22 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is procedure fl_gl_window_show - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_show, "fl_gl_window_show"); pragma Inline (fl_gl_window_show); procedure fl_gl_window_hide - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_hide, "fl_gl_window_hide"); pragma Inline (fl_gl_window_hide); procedure fl_gl_window_hide_overlay - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_hide_overlay, "fl_gl_window_hide_overlay"); pragma Inline (fl_gl_window_hide_overlay); procedure fl_gl_window_flush - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_flush, "fl_gl_window_flush"); pragma Inline (fl_gl_window_flush); @@ -75,19 +74,19 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is function fl_gl_window_pixel_h - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_gl_window_pixel_h, "fl_gl_window_pixel_h"); pragma Inline (fl_gl_window_pixel_h); function fl_gl_window_pixel_w - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_gl_window_pixel_w, "fl_gl_window_pixel_w"); pragma Inline (fl_gl_window_pixel_w); function fl_gl_window_pixels_per_unit - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.C_float; pragma Import (C, fl_gl_window_pixels_per_unit, "fl_gl_window_pixels_per_unit"); pragma Inline (fl_gl_window_pixels_per_unit); @@ -96,13 +95,13 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is function fl_gl_window_get_mode - (S : in System.Address) + (S : in Storage.Integer_Address) return Mode_Mask; pragma Import (C, fl_gl_window_get_mode, "fl_gl_window_get_mode"); pragma Inline (fl_gl_window_get_mode); procedure fl_gl_window_set_mode - (S : in System.Address; + (S : in Storage.Integer_Address; M : in Mode_Mask); pragma Import (C, fl_gl_window_set_mode, "fl_gl_window_set_mode"); pragma Inline (fl_gl_window_set_mode); @@ -114,13 +113,13 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is pragma Inline (fl_gl_window_static_can_do); function fl_gl_window_can_do - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_gl_window_can_do, "fl_gl_window_can_do"); pragma Inline (fl_gl_window_can_do); function fl_gl_window_can_do_overlay - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_gl_window_can_do_overlay, "fl_gl_window_can_do_overlay"); pragma Inline (fl_gl_window_can_do_overlay); @@ -129,48 +128,48 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is function fl_gl_window_get_context - (S : in System.Address) - return System.Address; + (S : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_gl_window_get_context, "fl_gl_window_get_context"); pragma Inline (fl_gl_window_get_context); procedure fl_gl_window_set_context - (S, P : in System.Address; + (S, P : in Storage.Integer_Address; D : in Interfaces.C.int); pragma Import (C, fl_gl_window_set_context, "fl_gl_window_set_context"); pragma Inline (fl_gl_window_set_context); function fl_gl_window_context_valid - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.signed_char; pragma Import (C, fl_gl_window_context_valid, "fl_gl_window_context_valid"); pragma Inline (fl_gl_window_context_valid); procedure fl_gl_window_set_context_valid - (S : in System.Address; + (S : in Storage.Integer_Address; V : in Interfaces.C.signed_char); pragma Import (C, fl_gl_window_set_context_valid, "fl_gl_window_set_context_valid"); pragma Inline (fl_gl_window_set_context_valid); function fl_gl_window_valid - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.signed_char; pragma Import (C, fl_gl_window_valid, "fl_gl_window_valid"); pragma Inline (fl_gl_window_valid); procedure fl_gl_window_set_valid - (S : in System.Address; + (S : in Storage.Integer_Address; V : in Interfaces.C.signed_char); pragma Import (C, fl_gl_window_set_valid, "fl_gl_window_set_valid"); pragma Inline (fl_gl_window_set_valid); procedure fl_gl_window_make_current - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_make_current, "fl_gl_window_make_current"); pragma Inline (fl_gl_window_make_current); procedure fl_gl_window_make_overlay_current - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_gl_window_make_overlay_current, "fl_gl_window_make_overlay_current"); pragma Inline (fl_gl_window_make_overlay_current); @@ -178,27 +177,27 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is procedure fl_gl_window_ortho - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_gl_window_ortho, "fl_gl_window_ortho"); pragma Inline (fl_gl_window_ortho); procedure fl_gl_window_redraw_overlay - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_gl_window_redraw_overlay, "fl_gl_window_redraw_overlay"); pragma Inline (fl_gl_window_redraw_overlay); procedure fl_gl_window_swap_buffers - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_gl_window_swap_buffers, "fl_gl_window_swap_buffers"); pragma Inline (fl_gl_window_swap_buffers); procedure fl_gl_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_gl_window_draw, "fl_gl_window_draw"); pragma Inline (fl_gl_window_draw); function fl_gl_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_gl_window_handle, "fl_gl_window_handle"); @@ -210,12 +209,12 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is procedure Finalize (This : in out GL_Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in GL_Window'Class then This.Clear; free_fl_gl_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Window (This)); end Finalize; @@ -244,9 +243,9 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - gl_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - gl_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + gl_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + gl_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -265,9 +264,9 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - gl_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - gl_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + gl_window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + gl_window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -395,7 +394,7 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is (This : in GL_Window) return System.Address is begin - return fl_gl_window_get_context (This.Void_Ptr); + return Storage.To_Address (fl_gl_window_get_context (This.Void_Ptr)); end Get_Context; @@ -404,7 +403,8 @@ package body FLTK.Widgets.Groups.Windows.OpenGL is Struct : in System.Address; Destroy : in Boolean := False) is begin - fl_gl_window_set_context (This.Void_Ptr, Struct, Boolean'Pos (Destroy)); + fl_gl_window_set_context + (This.Void_Ptr, Storage.To_Integer (Struct), Boolean'Pos (Destroy)); end Set_Context; diff --git a/src/fltk-widgets-groups-windows-single-menu.adb b/src/fltk-widgets-groups-windows-single-menu.adb index d26b33f..8d562b2 100644 --- a/src/fltk-widgets-groups-windows-single-menu.adb +++ b/src/fltk-widgets-groups-windows-single-menu.adb @@ -2,12 +2,10 @@ with - Interfaces.C, - System; + Interfaces.C; use type - System.Address, Interfaces.C.unsigned; @@ -15,12 +13,12 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure menu_window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, menu_window_set_draw_hook, "menu_window_set_draw_hook"); pragma Inline (menu_window_set_draw_hook); procedure menu_window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, menu_window_set_handle_hook, "menu_window_set_handle_hook"); pragma Inline (menu_window_set_handle_hook); @@ -30,19 +28,19 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is function new_fl_menu_window (X, Y, W, H : in Interfaces.C.int; Label : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu_window, "new_fl_menu_window"); pragma Inline (new_fl_menu_window); function new_fl_menu_window2 (W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu_window2, "new_fl_menu_window2"); pragma Inline (new_fl_menu_window2); procedure free_fl_menu_window - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, free_fl_menu_window, "free_fl_menu_window"); pragma Inline (free_fl_menu_window); @@ -50,17 +48,17 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure fl_menu_window_show - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_window_show, "fl_menu_window_show"); pragma Inline (fl_menu_window_show); procedure fl_menu_window_hide - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_window_hide, "fl_menu_window_hide"); pragma Inline (fl_menu_window_hide); procedure fl_menu_window_flush - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_window_flush, "fl_menu_window_flush"); pragma Inline (fl_menu_window_flush); @@ -68,17 +66,17 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure fl_menu_window_set_overlay - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_window_set_overlay, "fl_menu_window_set_overlay"); pragma Inline (fl_menu_window_set_overlay); procedure fl_menu_window_clear_overlay - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_window_clear_overlay, "fl_menu_window_clear_overlay"); pragma Inline (fl_menu_window_clear_overlay); function fl_menu_window_overlay - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_menu_window_overlay, "fl_menu_window_overlay"); pragma Inline (fl_menu_window_overlay); @@ -87,12 +85,12 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure fl_menu_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_menu_window_draw, "fl_menu_window_draw"); pragma Inline (fl_menu_window_draw); function fl_menu_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_window_handle, "fl_menu_window_handle"); @@ -104,12 +102,12 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is procedure Finalize (This : in out Menu_Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Menu_Window'Class then This.Clear; free_fl_menu_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Single_Window (This)); end Finalize; @@ -134,9 +132,11 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + menu_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + menu_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -155,9 +155,11 @@ package body FLTK.Widgets.Groups.Windows.Single.Menu is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + menu_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + menu_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows-single.adb b/src/fltk-widgets-groups-windows-single.adb index 2bc5608..2930933 100644 --- a/src/fltk-widgets-groups-windows-single.adb +++ b/src/fltk-widgets-groups-windows-single.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Windows.Single is procedure single_window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, single_window_set_draw_hook, "single_window_set_draw_hook"); pragma Inline (single_window_set_draw_hook); procedure single_window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, single_window_set_handle_hook, "single_window_set_handle_hook"); pragma Inline (single_window_set_handle_hook); @@ -29,19 +24,19 @@ package body FLTK.Widgets.Groups.Windows.Single is function new_fl_single_window (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_single_window, "new_fl_single_window"); pragma Inline (new_fl_single_window); function new_fl_single_window2 (W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_single_window2, "new_fl_single_window2"); pragma Inline (new_fl_single_window2); procedure free_fl_single_window - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_single_window, "free_fl_single_window"); pragma Inline (free_fl_single_window); @@ -49,12 +44,12 @@ package body FLTK.Widgets.Groups.Windows.Single is procedure fl_single_window_show - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_single_window_show, "fl_single_window_show"); pragma Inline (fl_single_window_show); procedure fl_single_window_flush - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, fl_single_window_flush, "fl_single_window_flush"); pragma Inline (fl_single_window_flush); @@ -62,12 +57,12 @@ package body FLTK.Widgets.Groups.Windows.Single is procedure fl_single_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_single_window_draw, "fl_single_window_draw"); pragma Inline (fl_single_window_draw); function fl_single_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_single_window_handle, "fl_single_window_handle"); @@ -79,12 +74,12 @@ package body FLTK.Widgets.Groups.Windows.Single is procedure Finalize (This : in out Single_Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Single_Window'Class then This.Clear; free_fl_single_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Window (This)); end Finalize; @@ -109,9 +104,11 @@ package body FLTK.Widgets.Groups.Windows.Single is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - single_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - single_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + single_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + single_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -130,9 +127,11 @@ package body FLTK.Widgets.Groups.Windows.Single is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - single_window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - single_window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + single_window_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + single_window_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-windows.adb b/src/fltk-widgets-groups-windows.adb index 68b2301..5d74bba 100644 --- a/src/fltk-widgets-groups-windows.adb +++ b/src/fltk-widgets-groups-windows.adb @@ -3,27 +3,25 @@ with Interfaces.C.Strings, - System, FLTK.Images.RGB; use type Interfaces.C.int, Interfaces.C.unsigned, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Groups.Windows is procedure window_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, window_set_draw_hook, "window_set_draw_hook"); pragma Inline (window_set_draw_hook); procedure window_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, window_set_handle_hook, "window_set_handle_hook"); pragma Inline (window_set_handle_hook); @@ -33,19 +31,19 @@ package body FLTK.Widgets.Groups.Windows is function new_fl_window (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_window, "new_fl_window"); pragma Inline (new_fl_window); function new_fl_window2 (W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_window2, "new_fl_window2"); pragma Inline (new_fl_window2); procedure free_fl_window - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, free_fl_window, "free_fl_window"); pragma Inline (free_fl_window); @@ -53,38 +51,38 @@ package body FLTK.Widgets.Groups.Windows is procedure fl_window_show - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_show, "fl_window_show"); pragma Inline (fl_window_show); procedure fl_window_hide - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_hide, "fl_window_hide"); pragma Inline (fl_window_hide); function fl_window_shown - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_window_shown, "fl_window_shown"); pragma Inline (fl_window_shown); procedure fl_window_wait_for_expose - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_wait_for_expose, "fl_window_wait_for_expose"); pragma Inline (fl_window_wait_for_expose); procedure fl_window_iconize - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_iconize, "fl_window_iconize"); pragma Inline (fl_window_iconize); procedure fl_window_make_current - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_make_current, "fl_window_make_current"); pragma Inline (fl_window_make_current); procedure fl_window_free_position - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_free_position, "fl_window_free_position"); pragma Inline (fl_window_free_position); @@ -92,29 +90,29 @@ package body FLTK.Widgets.Groups.Windows is function fl_window_fullscreen_active - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_window_fullscreen_active, "fl_window_fullscreen_active"); pragma Inline (fl_window_fullscreen_active); procedure fl_window_fullscreen - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_fullscreen, "fl_window_fullscreen"); pragma Inline (fl_window_fullscreen); procedure fl_window_fullscreen_off - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_fullscreen_off, "fl_window_fullscreen_off"); pragma Inline (fl_window_fullscreen_off); procedure fl_window_fullscreen_off2 - (N : in System.Address; + (N : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int); pragma Import (C, fl_window_fullscreen_off2, "fl_window_fullscreen_off2"); pragma Inline (fl_window_fullscreen_off2); procedure fl_window_fullscreen_screens - (W : in System.Address; + (W : in Storage.Integer_Address; T, B, L, R : in Interfaces.C.int); pragma Import (C, fl_window_fullscreen_screens, "fl_window_fullscreen_screens"); pragma Inline (fl_window_fullscreen_screens); @@ -123,41 +121,41 @@ package body FLTK.Widgets.Groups.Windows is procedure fl_window_set_icon - (W, P : in System.Address); + (W, P : in Storage.Integer_Address); pragma Import (C, fl_window_set_icon, "fl_window_set_icon"); pragma Inline (fl_window_set_icon); procedure fl_window_default_icon - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, fl_window_default_icon, "fl_window_default_icon"); pragma Inline (fl_window_default_icon); function fl_window_get_iconlabel - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_window_get_iconlabel, "fl_window_get_iconlabel"); pragma Inline (fl_window_get_iconlabel); procedure fl_window_set_iconlabel - (W : in System.Address; + (W : in Storage.Integer_Address; S : in Interfaces.C.char_array); pragma Import (C, fl_window_set_iconlabel, "fl_window_set_iconlabel"); pragma Inline (fl_window_set_iconlabel); procedure fl_window_set_cursor - (W : in System.Address; + (W : in Storage.Integer_Address; C : in Interfaces.C.int); pragma Import (C, fl_window_set_cursor, "fl_window_set_cursor"); pragma Inline (fl_window_set_cursor); procedure fl_window_set_cursor2 - (W, P : in System.Address; + (W, P : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_window_set_cursor2, "fl_window_set_cursor2"); pragma Inline (fl_window_set_cursor2); procedure fl_window_set_default_cursor - (W : in System.Address; + (W : in Storage.Integer_Address; C : in Interfaces.C.int); pragma Import (C, fl_window_set_default_cursor, "fl_window_set_default_cursor"); pragma Inline (fl_window_set_default_cursor); @@ -166,52 +164,52 @@ package body FLTK.Widgets.Groups.Windows is function fl_window_get_border - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_window_get_border, "fl_window_get_border"); pragma Inline (fl_window_get_border); procedure fl_window_set_border - (W : in System.Address; + (W : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_window_set_border, "fl_window_set_border"); pragma Inline (fl_window_set_border); function fl_window_get_override - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_window_get_override, "fl_window_get_override"); pragma Inline (fl_window_get_override); procedure fl_window_set_override - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_set_override, "fl_window_set_override"); pragma Inline (fl_window_set_override); function fl_window_modal - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_window_modal, "fl_window_modal"); pragma Inline (fl_window_modal); function fl_window_non_modal - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_window_non_modal, "fl_window_non_modal"); pragma Inline (fl_window_non_modal); procedure fl_window_clear_modal_states - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_clear_modal_states, "fl_window_clear_modal_states"); pragma Inline (fl_window_clear_modal_states); procedure fl_window_set_modal - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_set_modal, "fl_window_set_modal"); pragma Inline (fl_window_set_modal); procedure fl_window_set_non_modal - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_set_non_modal, "fl_window_set_non_modal"); pragma Inline (fl_window_set_non_modal); @@ -219,37 +217,37 @@ package body FLTK.Widgets.Groups.Windows is function fl_window_get_label - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_window_get_label, "fl_window_get_label"); pragma Inline (fl_window_get_label); procedure fl_window_set_label - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_window_set_label, "fl_window_set_label"); pragma Inline (fl_window_set_label); procedure fl_window_hotspot - (W : in System.Address; + (W : in Storage.Integer_Address; X, Y, S : in Interfaces.C.int); pragma Import (C, fl_window_hotspot, "fl_window_hotspot"); pragma Inline (fl_window_hotspot); procedure fl_window_hotspot2 - (W, I : in System.Address; + (W, I : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_window_hotspot2, "fl_window_hotspot2"); pragma Inline (fl_window_hotspot2); procedure fl_window_size_range - (W : in System.Address; + (W : in Storage.Integer_Address; LW, LH, HW, HH, DW, DH, A : in Interfaces.C.int); pragma Import (C, fl_window_size_range, "fl_window_size_range"); pragma Inline (fl_window_size_range); procedure fl_window_shape - (W, P : in System.Address); + (W, P : in Storage.Integer_Address); pragma Import (C, fl_window_shape, "fl_window_shape"); pragma Inline (fl_window_shape); @@ -257,25 +255,25 @@ package body FLTK.Widgets.Groups.Windows is function fl_window_get_x_root - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_window_get_x_root, "fl_window_get_x_root"); pragma Inline (fl_window_get_x_root); function fl_window_get_y_root - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_window_get_y_root, "fl_window_get_y_root"); pragma Inline (fl_window_get_y_root); function fl_window_get_decorated_w - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_window_get_decorated_w, "fl_window_get_decorated_w"); pragma Inline (fl_window_get_decorated_w); function fl_window_get_decorated_h - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_window_get_decorated_h, "fl_window_get_decorated_h"); pragma Inline (fl_window_get_decorated_h); @@ -284,12 +282,12 @@ package body FLTK.Widgets.Groups.Windows is procedure fl_window_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_window_draw, "fl_window_draw"); pragma Inline (fl_window_draw); function fl_window_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_window_handle, "fl_window_handle"); @@ -301,12 +299,12 @@ package body FLTK.Widgets.Groups.Windows is procedure Finalize (This : in out Window) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Window'Class then This.Clear; free_fl_window (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -331,9 +329,9 @@ package body FLTK.Widgets.Groups.Windows is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -352,9 +350,9 @@ package body FLTK.Widgets.Groups.Windows is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - window_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - window_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + window_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + window_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-groups-wizards.adb b/src/fltk-widgets-groups-wizards.adb index f7ab3ed..ad89cbf 100644 --- a/src/fltk-widgets-groups-wizards.adb +++ b/src/fltk-widgets-groups-wizards.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Groups.Wizards is procedure wizard_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, wizard_set_draw_hook, "wizard_set_draw_hook"); pragma Inline (wizard_set_draw_hook); procedure wizard_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, wizard_set_handle_hook, "wizard_set_handle_hook"); pragma Inline (wizard_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Groups.Wizards is function new_fl_wizard (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_wizard, "new_fl_wizard"); pragma Inline (new_fl_wizard); procedure free_fl_wizard - (S : in System.Address); + (S : in Storage.Integer_Address); pragma Import (C, free_fl_wizard, "free_fl_wizard"); pragma Inline (free_fl_wizard); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Groups.Wizards is procedure fl_wizard_next - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_wizard_next, "fl_wizard_next"); pragma Inline (fl_wizard_next); procedure fl_wizard_prev - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_wizard_prev, "fl_wizard_prev"); pragma Inline (fl_wizard_prev); @@ -55,13 +50,13 @@ package body FLTK.Widgets.Groups.Wizards is function fl_wizard_get_visible - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_wizard_get_visible, "fl_wizard_get_visible"); pragma Inline (fl_wizard_get_visible); procedure fl_wizard_set_visible - (W, I : in System.Address); + (W, I : in Storage.Integer_Address); pragma Import (C, fl_wizard_set_visible, "fl_wizard_set_visible"); pragma Inline (fl_wizard_set_visible); @@ -69,12 +64,12 @@ package body FLTK.Widgets.Groups.Wizards is procedure fl_wizard_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_wizard_draw, "fl_wizard_draw"); pragma Inline (fl_wizard_draw); function fl_wizard_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_wizard_handle, "fl_wizard_handle"); @@ -86,12 +81,12 @@ package body FLTK.Widgets.Groups.Wizards is procedure Finalize (This : in out Wizard) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Wizard'Class then This.Clear; free_fl_wizard (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Group (This)); end Finalize; @@ -116,9 +111,9 @@ package body FLTK.Widgets.Groups.Wizards is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - wizard_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - wizard_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + wizard_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + wizard_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -148,10 +143,10 @@ package body FLTK.Widgets.Groups.Wizards is (This : in Wizard) return access Widget'Class is - Widget_Ptr : System.Address := + Widget_Ptr : Storage.Integer_Address := fl_wizard_get_visible (This.Void_Ptr); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return Actual_Widget; end Get_Visible; diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 08c61ab..c7f17e3 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -2,25 +2,23 @@ with - Interfaces.C, - System; + Interfaces.C; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Groups is procedure group_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, group_set_draw_hook, "group_set_draw_hook"); pragma Inline (group_set_draw_hook); procedure group_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, group_set_handle_hook, "group_set_handle_hook"); pragma Inline (group_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Groups is function new_fl_group (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_group, "new_fl_group"); pragma Inline (new_fl_group); procedure free_fl_group - (G : in System.Address); + (G : in Storage.Integer_Address); pragma Import (C, free_fl_group, "free_fl_group"); pragma Inline (free_fl_group); @@ -43,28 +41,28 @@ package body FLTK.Widgets.Groups is procedure fl_group_add - (G, W : in System.Address); + (G, W : in Storage.Integer_Address); pragma Import (C, fl_group_add, "fl_group_add"); pragma Inline (fl_group_add); procedure fl_group_insert - (G, W : in System.Address; + (G, W : in Storage.Integer_Address; P : in Interfaces.C.int); pragma Import (C, fl_group_insert, "fl_group_insert"); pragma Inline (fl_group_insert); procedure fl_group_insert2 - (G, W, B : in System.Address); + (G, W, B : in Storage.Integer_Address); pragma Import (C, fl_group_insert2, "fl_group_insert2"); pragma Inline (fl_group_insert2); procedure fl_group_remove - (G, W : in System.Address); + (G, W : in Storage.Integer_Address); pragma Import (C, fl_group_remove, "fl_group_remove"); pragma Inline (fl_group_remove); procedure fl_group_remove2 - (G : in System.Address; + (G : in Storage.Integer_Address; P : in Interfaces.C.int); pragma Import (C, fl_group_remove2, "fl_group_remove2"); pragma Inline (fl_group_remove2); @@ -73,20 +71,20 @@ package body FLTK.Widgets.Groups is function fl_group_child - (G : in System.Address; + (G : in Storage.Integer_Address; I : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_group_child, "fl_group_child"); pragma Inline (fl_group_child); function fl_group_find - (G, W : in System.Address) + (G, W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_group_find, "fl_group_find"); pragma Inline (fl_group_find); function fl_group_children - (G : in System.Address) + (G : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_group_children, "fl_group_children"); pragma Inline (fl_group_children); @@ -95,13 +93,13 @@ package body FLTK.Widgets.Groups is -- function fl_group_get_clip_children - -- (G : in System.Address) + -- (G : in Storage.Integer_Address) -- return Interfaces.C.unsigned; -- pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children"); -- pragma Inline (fl_group_get_clip_children); -- procedure fl_group_set_clip_children - -- (G : in System.Address; + -- (G : in Storage.Integer_Address; -- C : in Interfaces.C.unsigned); -- pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); -- pragma Inline (fl_group_set_clip_children); @@ -110,18 +108,18 @@ package body FLTK.Widgets.Groups is function fl_group_get_resizable - (G : in System.Address) - return System.Address; + (G : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_group_get_resizable, "fl_group_get_resizable"); pragma Inline (fl_group_get_resizable); procedure fl_group_set_resizable - (G, W : in System.Address); + (G, W : in Storage.Integer_Address); pragma Import (C, fl_group_set_resizable, "fl_group_set_resizable"); pragma Inline (fl_group_set_resizable); procedure fl_group_init_sizes - (G : in System.Address); + (G : in Storage.Integer_Address); pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes"); pragma Inline (fl_group_init_sizes); @@ -129,12 +127,12 @@ package body FLTK.Widgets.Groups is function fl_group_get_current - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_group_get_current, "fl_group_get_current"); pragma Inline (fl_group_get_current); procedure fl_group_set_current - (G : in System.Address); + (G : in Storage.Integer_Address); pragma Import (C, fl_group_set_current, "fl_group_set_current"); pragma Inline (fl_group_set_current); @@ -142,12 +140,12 @@ package body FLTK.Widgets.Groups is procedure fl_group_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_group_draw, "fl_group_draw"); pragma Inline (fl_group_draw); function fl_group_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_group_handle, "fl_group_handle"); @@ -159,12 +157,12 @@ package body FLTK.Widgets.Groups is procedure Finalize (This : in out Group) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Group'Class then This.Clear; free_fl_group (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -189,9 +187,9 @@ package body FLTK.Widgets.Groups is fl_group_end (This.Void_Ptr); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - group_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - group_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + group_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + group_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -282,10 +280,10 @@ package body FLTK.Widgets.Groups is Place : in Index) return Widget_Reference is - Widget_Ptr : System.Address := - fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); + Widget_Ptr : Storage.Integer_Address := + fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return (Data => Actual_Widget); end Child; @@ -405,10 +403,10 @@ package body FLTK.Widgets.Groups is (This : in Group) return access Widget'Class is - Widget_Ptr : System.Address := - fl_group_get_resizable (This.Void_Ptr); + Widget_Ptr : Storage.Integer_Address := + fl_group_get_resizable (This.Void_Ptr); Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); begin return Actual_Widget; end Get_Resizable; @@ -434,11 +432,11 @@ package body FLTK.Widgets.Groups is function Get_Current return access Group'Class is - Group_Ptr : System.Address := fl_group_get_current; + Group_Ptr : Storage.Integer_Address := fl_group_get_current; Actual_Group : access Group'Class; begin - if Group_Ptr /= System.Null_Address then - Actual_Group := Group_Convert.To_Pointer (Group_Ptr); + if Group_Ptr /= Null_Pointer then + Actual_Group := Group_Convert.To_Pointer (Storage.To_Address (Group_Ptr)); end if; return Actual_Group; end Get_Current; diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 1c2c30a..0d55238 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -169,7 +169,7 @@ private procedure fl_group_end - (G : in System.Address); + (G : in Storage.Integer_Address); pragma Import (C, fl_group_end, "fl_group_end"); diff --git a/src/fltk-widgets-inputs-file.adb b/src/fltk-widgets-inputs-file.adb index f69cb9b..9ba9c5e 100644 --- a/src/fltk-widgets-inputs-file.adb +++ b/src/fltk-widgets-inputs-file.adb @@ -2,25 +2,23 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Inputs.File is procedure file_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, file_input_set_draw_hook, "file_input_set_draw_hook"); pragma Inline (file_input_set_draw_hook); procedure file_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, file_input_set_handle_hook, "file_input_set_handle_hook"); pragma Inline (file_input_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Inputs.File is function new_fl_file_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_file_input, "new_fl_file_input"); pragma Inline (new_fl_file_input); procedure free_fl_file_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_file_input, "free_fl_file_input"); pragma Inline (free_fl_file_input); @@ -43,25 +41,25 @@ package body FLTK.Widgets.Inputs.File is function fl_file_input_get_down_box - (F : in System.Address) + (F : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_file_input_get_down_box, "fl_file_input_get_down_box"); pragma Inline (fl_file_input_get_down_box); procedure fl_file_input_set_down_box - (F : in System.Address; + (F : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_file_input_set_down_box, "fl_file_input_set_down_box"); pragma Inline (fl_file_input_set_down_box); function fl_file_input_get_errorcolor - (F : in System.Address) + (F : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_file_input_get_errorcolor, "fl_file_input_get_errorcolor"); pragma Inline (fl_file_input_get_errorcolor); procedure fl_file_input_set_errorcolor - (F : in System.Address; + (F : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_file_input_set_errorcolor, "fl_file_input_set_errorcolor"); pragma Inline (fl_file_input_set_errorcolor); @@ -70,13 +68,13 @@ package body FLTK.Widgets.Inputs.File is function fl_file_input_get_value - (F : in System.Address) + (F : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_file_input_get_value, "fl_file_input_get_value"); pragma Inline (fl_file_input_get_value); procedure fl_file_input_set_value - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.char_array; L : in Interfaces.C.int); pragma Import (C, fl_file_input_set_value, "fl_file_input_set_value"); @@ -86,12 +84,12 @@ package body FLTK.Widgets.Inputs.File is procedure fl_file_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_file_input_draw, "fl_file_input_draw"); pragma Inline (fl_file_input_draw); function fl_file_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_file_input_handle, "fl_file_input_handle"); @@ -103,11 +101,11 @@ package body FLTK.Widgets.Inputs.File is procedure Finalize (This : in out File_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in File_Input'Class then free_fl_file_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -131,9 +129,11 @@ package body FLTK.Widgets.Inputs.File is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - file_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - file_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + file_input_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + file_input_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-float.adb b/src/fltk-widgets-inputs-float.adb index b278b14..3622ecc 100644 --- a/src/fltk-widgets-inputs-float.adb +++ b/src/fltk-widgets-inputs-float.adb @@ -2,25 +2,23 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Inputs.Float is procedure float_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, float_input_set_draw_hook, "float_input_set_draw_hook"); pragma Inline (float_input_set_draw_hook); procedure float_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, float_input_set_handle_hook, "float_input_set_handle_hook"); pragma Inline (float_input_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Inputs.Float is function new_fl_float_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_float_input, "new_fl_float_input"); pragma Inline (new_fl_float_input); procedure free_fl_float_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_float_input, "free_fl_float_input"); pragma Inline (free_fl_float_input); @@ -43,12 +41,12 @@ package body FLTK.Widgets.Inputs.Float is procedure fl_float_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_float_input_draw, "fl_float_input_draw"); pragma Inline (fl_float_input_draw); function fl_float_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_float_input_handle, "fl_float_input_handle"); @@ -60,11 +58,11 @@ package body FLTK.Widgets.Inputs.Float is procedure Finalize (This : in out Float_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Float_Input'Class then free_fl_float_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -88,9 +86,11 @@ package body FLTK.Widgets.Inputs.Float is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - float_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - float_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + float_input_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + float_input_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-integer.adb b/src/fltk-widgets-inputs-integer.adb index bc794e4..a7e42f7 100644 --- a/src/fltk-widgets-inputs-integer.adb +++ b/src/fltk-widgets-inputs-integer.adb @@ -2,25 +2,23 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Inputs.Integer is procedure int_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, int_input_set_draw_hook, "int_input_set_draw_hook"); pragma Inline (int_input_set_draw_hook); procedure int_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, int_input_set_handle_hook, "int_input_set_handle_hook"); pragma Inline (int_input_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Inputs.Integer is function new_fl_int_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_int_input, "new_fl_int_input"); pragma Inline (new_fl_int_input); procedure free_fl_int_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_int_input, "free_fl_int_input"); pragma Inline (free_fl_int_input); @@ -43,12 +41,12 @@ package body FLTK.Widgets.Inputs.Integer is procedure fl_int_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_int_input_draw, "fl_int_input_draw"); pragma Inline (fl_int_input_draw); function fl_int_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_int_input_handle, "fl_int_input_handle"); @@ -60,11 +58,11 @@ package body FLTK.Widgets.Inputs.Integer is procedure Finalize (This : in out Integer_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Integer_Input'Class then free_fl_int_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -88,9 +86,9 @@ package body FLTK.Widgets.Inputs.Integer is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - int_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - int_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + int_input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + int_input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-multiline.adb b/src/fltk-widgets-inputs-multiline.adb index a319ab4..6fcd28a 100644 --- a/src/fltk-widgets-inputs-multiline.adb +++ b/src/fltk-widgets-inputs-multiline.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Inputs.Multiline is procedure multiline_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, multiline_input_set_draw_hook, "multiline_input_set_draw_hook"); pragma Inline (multiline_input_set_draw_hook); procedure multiline_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, multiline_input_set_handle_hook, "multiline_input_set_handle_hook"); pragma Inline (multiline_input_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Inputs.Multiline is function new_fl_multiline_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_multiline_input, "new_fl_multiline_input"); pragma Inline (new_fl_multiline_input); procedure free_fl_multiline_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_multiline_input, "free_fl_multiline_input"); pragma Inline (free_fl_multiline_input); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Inputs.Multiline is procedure fl_multiline_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_multiline_input_draw, "fl_multiline_input_draw"); pragma Inline (fl_multiline_input_draw); function fl_multiline_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_multiline_input_handle, "fl_multiline_input_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Inputs.Multiline is procedure Finalize (This : in out Multiline_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Multiline_Input'Class then free_fl_multiline_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Inputs.Multiline is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - multiline_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - multiline_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + multiline_input_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + multiline_input_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-outputs-multiline.adb b/src/fltk-widgets-inputs-outputs-multiline.adb index 7f95fcc..4660929 100644 --- a/src/fltk-widgets-inputs-outputs-multiline.adb +++ b/src/fltk-widgets-inputs-outputs-multiline.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Inputs.Outputs.Multiline is procedure multiline_output_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, multiline_output_set_draw_hook, "multiline_output_set_draw_hook"); pragma Inline (multiline_output_set_draw_hook); procedure multiline_output_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, multiline_output_set_handle_hook, "multiline_output_set_handle_hook"); pragma Inline (multiline_output_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is function new_fl_multiline_output (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_multiline_output, "new_fl_multiline_output"); pragma Inline (new_fl_multiline_output); procedure free_fl_multiline_output - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_multiline_output, "free_fl_multiline_output"); pragma Inline (free_fl_multiline_output); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is procedure fl_multiline_output_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_multiline_output_draw, "fl_multiline_output_draw"); pragma Inline (fl_multiline_output_draw); function fl_multiline_output_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_multiline_output_handle, "fl_multiline_output_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is procedure Finalize (This : in out Multiline_Output) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Multiline_Output'Class then free_fl_multiline_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Output (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Inputs.Outputs.Multiline is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - multiline_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - multiline_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + multiline_output_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + multiline_output_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-outputs.adb b/src/fltk-widgets-inputs-outputs.adb index e70db5c..238e3b8 100644 --- a/src/fltk-widgets-inputs-outputs.adb +++ b/src/fltk-widgets-inputs-outputs.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Inputs.Outputs is procedure output_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, output_set_draw_hook, "output_set_draw_hook"); pragma Inline (output_set_draw_hook); procedure output_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, output_set_handle_hook, "output_set_handle_hook"); pragma Inline (output_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Inputs.Outputs is function new_fl_output (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_output, "new_fl_output"); pragma Inline (new_fl_output); procedure free_fl_output - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_output, "free_fl_output"); pragma Inline (free_fl_output); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Inputs.Outputs is procedure fl_output_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_output_draw, "fl_output_draw"); pragma Inline (fl_output_draw); function fl_output_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_output_handle, "fl_output_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Inputs.Outputs is procedure Finalize (This : in out Output) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Output'Class then free_fl_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -87,9 +82,9 @@ package body FLTK.Widgets.Inputs.Outputs is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + output_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + output_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs-secret.adb b/src/fltk-widgets-inputs-secret.adb index d5a68b4..8967a0a 100644 --- a/src/fltk-widgets-inputs-secret.adb +++ b/src/fltk-widgets-inputs-secret.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Inputs.Secret is procedure secret_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, secret_input_set_draw_hook, "secret_input_set_draw_hook"); pragma Inline (secret_input_set_draw_hook); procedure secret_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, secret_input_set_handle_hook, "secret_input_set_handle_hook"); pragma Inline (secret_input_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Inputs.Secret is function new_fl_secret_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_secret_input, "new_fl_secret_input"); pragma Inline (new_fl_secret_input); procedure free_fl_secret_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_secret_input, "free_fl_secret_input"); pragma Inline (free_fl_secret_input); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Inputs.Secret is procedure fl_secret_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_secret_input_draw, "fl_secret_input_draw"); pragma Inline (fl_secret_input_draw); function fl_secret_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_secret_input_handle, "fl_secret_input_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Inputs.Secret is procedure Finalize (This : in out Secret_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Secret_Input'Class then free_fl_secret_input (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Input (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Inputs.Secret is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - secret_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - secret_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + secret_input_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + secret_input_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs.adb b/src/fltk-widgets-inputs.adb index 30334b8..82c14aa 100644 --- a/src/fltk-widgets-inputs.adb +++ b/src/fltk-widgets-inputs.adb @@ -2,26 +2,24 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type Interfaces.C.int, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets.Inputs is procedure input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, input_set_draw_hook, "input_set_draw_hook"); pragma Inline (input_set_draw_hook); procedure input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, input_set_handle_hook, "input_set_handle_hook"); pragma Inline (input_set_handle_hook); @@ -31,12 +29,12 @@ package body FLTK.Widgets.Inputs is function new_fl_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_input, "new_fl_input"); pragma Inline (new_fl_input); procedure free_fl_input - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_input, "free_fl_input"); pragma Inline (free_fl_input); @@ -44,39 +42,39 @@ package body FLTK.Widgets.Inputs is function fl_input_copy - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_copy, "fl_input_copy"); pragma Inline (fl_input_copy); function fl_input_cut - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_cut, "fl_input_cut"); pragma Inline (fl_input_cut); function fl_input_cut2 - (I : in System.Address; + (I : in Storage.Integer_Address; B : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_cut2, "fl_input_cut2"); pragma Inline (fl_input_cut2); function fl_input_cut3 - (I : in System.Address; + (I : in Storage.Integer_Address; A, B : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_cut3, "fl_input_cut3"); pragma Inline (fl_input_cut3); function fl_input_copy_cuts - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_copy_cuts, "fl_input_copy_cuts"); pragma Inline (fl_input_copy_cuts); function fl_input_undo - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_undo, "fl_input_undo"); pragma Inline (fl_input_undo); @@ -85,37 +83,37 @@ package body FLTK.Widgets.Inputs is function fl_input_get_readonly - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_readonly, "fl_input_get_readonly"); pragma Inline (fl_input_get_readonly); procedure fl_input_set_readonly - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_readonly, "fl_input_set_readonly"); pragma Inline (fl_input_set_readonly); function fl_input_get_tab_nav - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_tab_nav, "fl_input_get_tab_nav"); pragma Inline (fl_input_get_tab_nav); procedure fl_input_set_tab_nav - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_tab_nav, "fl_input_set_tab_nav"); pragma Inline (fl_input_set_tab_nav); function fl_input_get_wrap - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_wrap, "fl_input_get_wrap"); pragma Inline (fl_input_get_wrap); procedure fl_input_set_wrap - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_wrap, "fl_input_set_wrap"); pragma Inline (fl_input_set_wrap); @@ -124,50 +122,50 @@ package body FLTK.Widgets.Inputs is function fl_input_get_input_type - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_input_type, "fl_input_get_input_type"); pragma Inline (fl_input_get_input_type); procedure fl_input_set_input_type - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_input_type, "fl_input_set_input_type"); pragma Inline (fl_input_set_input_type); function fl_input_get_shortcut - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.unsigned_long; pragma Import (C, fl_input_get_shortcut, "fl_input_get_shortcut"); pragma Inline (fl_input_get_shortcut); procedure fl_input_set_shortcut - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.unsigned_long); pragma Import (C, fl_input_set_shortcut, "fl_input_set_shortcut"); pragma Inline (fl_input_set_shortcut); function fl_input_get_mark - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_mark, "fl_input_get_mark"); pragma Inline (fl_input_get_mark); function fl_input_set_mark - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_set_mark, "fl_input_set_mark"); pragma Inline (fl_input_set_mark); function fl_input_get_position - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_position, "fl_input_get_position"); pragma Inline (fl_input_get_position); function fl_input_set_position - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_set_position, "fl_input_set_position"); @@ -177,14 +175,14 @@ package body FLTK.Widgets.Inputs is function fl_input_index - (I : in System.Address; + (I : in Storage.Integer_Address; P : in Interfaces.C.int) return Interfaces.C.unsigned; pragma Import (C, fl_input_index, "fl_input_index"); pragma Inline (fl_input_index); function fl_input_insert - (I : in System.Address; + (I : in Storage.Integer_Address; S : in Interfaces.C.char_array; L : in Interfaces.C.int) return Interfaces.C.int; @@ -192,7 +190,7 @@ package body FLTK.Widgets.Inputs is pragma Inline (fl_input_insert); function fl_input_replace - (I : in System.Address; + (I : in Storage.Integer_Address; B, E : in Interfaces.C.int; S : in Interfaces.C.char_array; L : in Interfaces.C.int) @@ -201,7 +199,7 @@ package body FLTK.Widgets.Inputs is pragma Inline (fl_input_replace); procedure fl_input_set_value - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.char_array; L : in Interfaces.C.int); pragma Import (C, fl_input_set_value, "fl_input_set_value"); @@ -211,19 +209,19 @@ package body FLTK.Widgets.Inputs is function fl_input_get_maximum_size - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_maximum_size, "fl_input_get_maximum_size"); pragma Inline (fl_input_get_maximum_size); procedure fl_input_set_maximum_size - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_maximum_size, "fl_input_set_maximum_size"); pragma Inline (fl_input_set_maximum_size); function fl_input_get_size - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_size, "fl_input_get_size"); pragma Inline (fl_input_get_size); @@ -232,49 +230,49 @@ package body FLTK.Widgets.Inputs is function fl_input_get_cursor_color - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_input_get_cursor_color, "fl_input_get_cursor_color"); pragma Inline (fl_input_get_cursor_color); procedure fl_input_set_cursor_color - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_input_set_cursor_color, "fl_input_set_cursor_color"); pragma Inline (fl_input_set_cursor_color); function fl_input_get_textcolor - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_input_get_textcolor, "fl_input_get_textcolor"); pragma Inline (fl_input_get_textcolor); procedure fl_input_set_textcolor - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_input_set_textcolor, "fl_input_set_textcolor"); pragma Inline (fl_input_set_textcolor); function fl_input_get_textfont - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_textfont, "fl_input_get_textfont"); pragma Inline (fl_input_get_textfont); procedure fl_input_set_textfont - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_textfont, "fl_input_set_textfont"); pragma Inline (fl_input_set_textfont); function fl_input_get_textsize - (I : in System.Address) + (I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_input_get_textsize, "fl_input_get_textsize"); pragma Inline (fl_input_get_textsize); procedure fl_input_set_textsize - (I : in System.Address; + (I : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_input_set_textsize, "fl_input_set_textsize"); pragma Inline (fl_input_set_textsize); @@ -283,7 +281,7 @@ package body FLTK.Widgets.Inputs is procedure fl_input_set_size - (I : in System.Address; + (I : in Storage.Integer_Address; W, H : in Interfaces.C.int); pragma Import (C, fl_input_set_size, "fl_input_set_size"); pragma Inline (fl_input_set_size); @@ -292,12 +290,12 @@ package body FLTK.Widgets.Inputs is procedure fl_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_input_draw, "fl_input_draw"); pragma Inline (fl_input_draw); function fl_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_input_handle, "fl_input_handle"); @@ -309,13 +307,13 @@ package body FLTK.Widgets.Inputs is procedure Finalize (This : in out Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Input'Class then if This.Needs_Dealloc then free_fl_input (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -339,9 +337,9 @@ package body FLTK.Widgets.Inputs is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + input_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + input_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-inputs.ads b/src/fltk-widgets-inputs.ads index 46767cd..c9eacea 100644 --- a/src/fltk-widgets-inputs.ads +++ b/src/fltk-widgets-inputs.ads @@ -305,7 +305,7 @@ private function fl_input_get_value - (F : in System.Address) + (F : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_input_get_value, "fl_input_get_value"); pragma Inline (fl_input_get_value); diff --git a/src/fltk-widgets-menus-choices.adb b/src/fltk-widgets-menus-choices.adb index 836f80f..590daff 100644 --- a/src/fltk-widgets-menus-choices.adb +++ b/src/fltk-widgets-menus-choices.adb @@ -7,20 +7,19 @@ with use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Menus.Choices is procedure choice_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, choice_set_draw_hook, "choice_set_draw_hook"); pragma Inline (choice_set_draw_hook); procedure choice_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, choice_set_handle_hook, "choice_set_handle_hook"); pragma Inline (choice_set_handle_hook); @@ -30,12 +29,12 @@ package body FLTK.Widgets.Menus.Choices is function new_fl_choice (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_choice, "new_fl_choice"); pragma Inline (new_fl_choice); procedure free_fl_choice - (B : in System.Address); + (B : in Storage.Integer_Address); pragma Import (C, free_fl_choice, "free_fl_choice"); pragma Inline (free_fl_choice); @@ -43,20 +42,20 @@ package body FLTK.Widgets.Menus.Choices is function fl_choice_value - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_choice_value, "fl_choice_value"); pragma Inline (fl_choice_value); function fl_choice_set_value - (M : in System.Address; + (M : in Storage.Integer_Address; I : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_choice_set_value, "fl_choice_set_value"); pragma Inline (fl_choice_set_value); function fl_choice_set_value2 - (M, I : in System.Address) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_choice_set_value2, "fl_choice_set_value2"); pragma Inline (fl_choice_set_value2); @@ -65,12 +64,12 @@ package body FLTK.Widgets.Menus.Choices is procedure fl_choice_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_choice_draw, "fl_choice_draw"); pragma Inline (fl_choice_draw); function fl_choice_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_choice_handle, "fl_choice_handle"); @@ -82,13 +81,13 @@ package body FLTK.Widgets.Menus.Choices is procedure Finalize (This : in out Choice) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Choice'Class then if This.Needs_Dealloc then free_fl_choice (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -112,9 +111,9 @@ package body FLTK.Widgets.Menus.Choices is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - choice_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - choice_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + choice_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + choice_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus-menu_bars.adb b/src/fltk-widgets-menus-menu_bars.adb index 428d439..cde9960 100644 --- a/src/fltk-widgets-menus-menu_bars.adb +++ b/src/fltk-widgets-menus-menu_bars.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Menus.Menu_Bars is procedure menu_bar_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, menu_bar_set_draw_hook, "menu_bar_set_draw_hook"); pragma Inline (menu_bar_set_draw_hook); procedure menu_bar_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, menu_bar_set_handle_hook, "menu_bar_set_handle_hook"); pragma Inline (menu_bar_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Menus.Menu_Bars is function new_fl_menu_bar (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu_bar, "new_fl_menu_bar"); pragma Inline (new_fl_menu_bar); procedure free_fl_menu_bar - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, free_fl_menu_bar, "free_fl_menu_bar"); pragma Inline (free_fl_menu_bar); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Menus.Menu_Bars is procedure fl_menu_bar_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_menu_bar_draw, "fl_menu_bar_draw"); pragma Inline (fl_menu_bar_draw); function fl_menu_bar_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_bar_handle, "fl_menu_bar_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Menus.Menu_Bars is procedure Finalize (This : in out Menu_Bar) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Menu_Bar'Class then free_fl_menu_bar (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Menu (This)); end Finalize; @@ -87,9 +82,9 @@ package body FLTK.Widgets.Menus.Menu_Bars is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_bar_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_bar_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + menu_bar_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + menu_bar_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-menus-menu_buttons.adb b/src/fltk-widgets-menus-menu_buttons.adb index 890d847..b4fd002 100644 --- a/src/fltk-widgets-menus-menu_buttons.adb +++ b/src/fltk-widgets-menus-menu_buttons.adb @@ -2,24 +2,19 @@ with - Interfaces.C, - System; - -use type - - System.Address; + Interfaces.C; package body FLTK.Widgets.Menus.Menu_Buttons is procedure menu_button_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, menu_button_set_draw_hook, "menu_button_set_draw_hook"); pragma Inline (menu_button_set_draw_hook); procedure menu_button_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, menu_button_set_handle_hook, "menu_button_set_handle_hook"); pragma Inline (menu_button_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Menus.Menu_Buttons is function new_fl_menu_button (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu_button, "new_fl_menu_button"); pragma Inline (new_fl_menu_button); procedure free_fl_menu_button - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, free_fl_menu_button, "free_fl_menu_button"); pragma Inline (free_fl_menu_button); @@ -42,19 +37,19 @@ package body FLTK.Widgets.Menus.Menu_Buttons is procedure fl_menu_button_type - (M : in System.Address; + (M : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_menu_button_type, "fl_menu_button_type"); pragma Inline (fl_menu_button_type); function fl_menu_button_popup - (M : in System.Address) - return System.Address; + (M : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_menu_button_popup, "fl_menu_button_popup"); pragma Inline (fl_menu_button_popup); function fl_menu_find_index2 - (M, I : in System.Address) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2"); pragma Inline (fl_menu_find_index2); @@ -63,12 +58,12 @@ package body FLTK.Widgets.Menus.Menu_Buttons is procedure fl_menu_button_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_menu_button_draw, "fl_menu_button_draw"); pragma Inline (fl_menu_button_draw); function fl_menu_button_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_button_handle, "fl_menu_button_handle"); @@ -80,13 +75,13 @@ package body FLTK.Widgets.Menus.Menu_Buttons is procedure Finalize (This : in out Menu_Button) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Menu_Button'Class then if This.Needs_Dealloc then free_fl_menu_button (This.Void_Ptr); end if; - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Menu (This)); end Finalize; @@ -110,9 +105,11 @@ package body FLTK.Widgets.Menus.Menu_Buttons is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_button_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_button_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + menu_button_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + menu_button_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -135,7 +132,7 @@ package body FLTK.Widgets.Menus.Menu_Buttons is return Extended_Index is use type Interfaces.C.int; - Ptr : System.Address := fl_menu_button_popup (This.Void_Ptr); + Ptr : Storage.Integer_Address := fl_menu_button_popup (This.Void_Ptr); begin return Extended_Index (fl_menu_find_index2 (This.Void_Ptr, Ptr) + 1); end Popup; diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb index d2bf2ff..d9e9815 100644 --- a/src/fltk-widgets-menus.adb +++ b/src/fltk-widgets-menus.adb @@ -3,12 +3,10 @@ with Interfaces.C.Strings, - Ada.Unchecked_Deallocation, - System; + Ada.Unchecked_Deallocation; use type - System.Address, Interfaces.C.int, Interfaces.C.unsigned_long, Interfaces.C.Strings.chars_ptr; @@ -18,12 +16,12 @@ package body FLTK.Widgets.Menus is procedure menu_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, menu_set_draw_hook, "menu_set_draw_hook"); pragma Inline (menu_set_draw_hook); procedure menu_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, menu_set_handle_hook, "menu_set_handle_hook"); pragma Inline (menu_set_handle_hook); @@ -33,12 +31,12 @@ package body FLTK.Widgets.Menus is function new_fl_menu (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_menu, "new_fl_menu"); pragma Inline (new_fl_menu); procedure free_fl_menu - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_menu, "free_fl_menu"); pragma Inline (free_fl_menu); @@ -46,34 +44,34 @@ package body FLTK.Widgets.Menus is function fl_menu_add - (M : in System.Address; + (M : in Storage.Integer_Address; T : in Interfaces.C.char_array; S : in Interfaces.C.unsigned_long; - C, U : in System.Address; + C, U : in Storage.Integer_Address; F : in Interfaces.C.unsigned_long) return Interfaces.C.int; pragma Import (C, fl_menu_add, "fl_menu_add"); pragma Inline (fl_menu_add); function fl_menu_insert - (M : in System.Address; + (M : in Storage.Integer_Address; P : in Interfaces.C.int; T : in Interfaces.C.char_array; S : in Interfaces.C.unsigned_long; - C, U : in System.Address; + C, U : in Storage.Integer_Address; F : in Interfaces.C.unsigned_long) return Interfaces.C.int; pragma Import (C, fl_menu_insert, "fl_menu_insert"); pragma Inline (fl_menu_insert); procedure fl_menu_remove - (M : in System.Address; + (M : in Storage.Integer_Address; P : in Interfaces.C.int); pragma Import (C, fl_menu_remove, "fl_menu_remove"); pragma Inline (fl_menu_remove); procedure fl_menu_clear - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_clear, "fl_menu_clear"); pragma Inline (fl_menu_clear); @@ -81,46 +79,46 @@ package body FLTK.Widgets.Menus is function fl_menu_get_item - (M : in System.Address; + (M : in Storage.Integer_Address; I : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_menu_get_item, "fl_menu_get_item"); pragma Inline (fl_menu_get_item); function fl_menu_find_item - (M : in System.Address; + (M : in Storage.Integer_Address; T : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_menu_find_item, "fl_menu_find_item"); pragma Inline (fl_menu_find_item); function fl_menu_find_item2 - (M, C : in System.Address) - return System.Address; + (M, C : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_menu_find_item2, "fl_menu_find_item2"); pragma Inline (fl_menu_find_item2); function fl_menu_find_index - (M : in System.Address; + (M : in Storage.Integer_Address; T : in Interfaces.C.char_array) return Interfaces.C.int; pragma Import (C, fl_menu_find_index, "fl_menu_find_index"); pragma Inline (fl_menu_find_index); function fl_menu_find_index2 - (M, I : in System.Address) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_find_index2, "fl_menu_find_index2"); pragma Inline (fl_menu_find_index2); function fl_menu_find_index3 - (M, C : in System.Address) + (M, C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_find_index3, "fl_menu_find_index3"); pragma Inline (fl_menu_find_index3); function fl_menu_size - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_size, "fl_menu_size"); pragma Inline (fl_menu_size); @@ -129,32 +127,32 @@ package body FLTK.Widgets.Menus is function fl_menu_mvalue - (M : in System.Address) - return System.Address; + (M : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_menu_mvalue, "fl_menu_mvalue"); pragma Inline (fl_menu_mvalue); function fl_menu_text - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_menu_text, "fl_menu_text"); pragma Inline (fl_menu_text); function fl_menu_value - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_value, "fl_menu_value"); pragma Inline (fl_menu_value); function fl_menu_set_value - (M : in System.Address; + (M : in Storage.Integer_Address; I : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_menu_set_value, "fl_menu_set_value"); pragma Inline (fl_menu_set_value); function fl_menu_set_value2 - (M, I : in System.Address) + (M, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_set_value2, "fl_menu_set_value2"); pragma Inline (fl_menu_set_value2); @@ -163,37 +161,37 @@ package body FLTK.Widgets.Menus is function fl_menu_get_textcolor - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_menu_get_textcolor, "fl_menu_get_textcolor"); pragma Inline (fl_menu_get_textcolor); procedure fl_menu_set_textcolor - (M : in System.Address; + (M : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_menu_set_textcolor, "fl_menu_set_textcolor"); pragma Inline (fl_menu_set_textcolor); function fl_menu_get_textfont - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_get_textfont, "fl_menu_get_textfont"); pragma Inline (fl_menu_get_textfont); procedure fl_menu_set_textfont - (M : in System.Address; + (M : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_menu_set_textfont, "fl_menu_set_textfont"); pragma Inline (fl_menu_set_textfont); function fl_menu_get_textsize - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_get_textsize, "fl_menu_get_textsize"); pragma Inline (fl_menu_get_textsize); procedure fl_menu_set_textsize - (M : in System.Address; + (M : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_menu_set_textsize, "fl_menu_set_textsize"); pragma Inline (fl_menu_set_textsize); @@ -202,24 +200,24 @@ package body FLTK.Widgets.Menus is function fl_menu_get_down_box - (M : in System.Address) + (M : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_menu_get_down_box, "fl_menu_get_down_box"); pragma Inline (fl_menu_get_down_box); procedure fl_menu_set_down_box - (M : in System.Address; + (M : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_menu_set_down_box, "fl_menu_set_down_box"); pragma Inline (fl_menu_set_down_box); procedure fl_menu_global - (M : in System.Address); + (M : in Storage.Integer_Address); pragma Import (C, fl_menu_global, "fl_menu_global"); pragma Inline (fl_menu_global); function fl_menu_measure - (M : in System.Address; + (M : in Storage.Integer_Address; I : in Interfaces.C.int; H : out Interfaces.C.int) return Interfaces.C.int; @@ -230,19 +228,19 @@ package body FLTK.Widgets.Menus is function fl_menu_popup - (M : in System.Address; + (M : in Storage.Integer_Address; X, Y : in Interfaces.C.int; T : in Interfaces.C.char_array; N : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_menu_popup, "fl_menu_popup"); pragma Inline (fl_menu_popup); function fl_menu_pulldown - (M : in System.Address; + (M : in Storage.Integer_Address; X, Y, W, H : in Interfaces.C.int; N : in Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_menu_pulldown, "fl_menu_pulldown"); pragma Inline (fl_menu_pulldown); @@ -250,7 +248,7 @@ package body FLTK.Widgets.Menus is procedure fl_menu_draw_item - (M : in System.Address; + (M : in Storage.Integer_Address; I : in Interfaces.C.int; X, Y, W, H : in Interfaces.C.int; S : in Interfaces.C.int); @@ -261,11 +259,11 @@ package body FLTK.Widgets.Menus is procedure Item_Hook - (M, U : in System.Address) + (M, U : in Storage.Integer_Address) is Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (fl_widget_get_user_data (M)); - Action : Widget_Callback := Callback_Convert.To_Pointer (U); + Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (M))); + Action : Widget_Callback := Callback_Convert.To_Access (U); begin Action.all (Ada_Widget.all); end Item_Hook; @@ -282,14 +280,14 @@ package body FLTK.Widgets.Menus is procedure Finalize (This : in out Menu) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Menu'Class then for Item of This.My_Items loop Free_Item (Item); end loop; free_fl_menu (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -313,9 +311,9 @@ package body FLTK.Widgets.Menus is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - menu_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - menu_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + menu_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + menu_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); This.My_Items := Item_Vectors.Empty_Vector; fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; @@ -334,10 +332,10 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) is Ret_Place : Interfaces.C.int; - Callback, User_Data : System.Address := System.Null_Address; + Callback, User_Data : Storage.Integer_Address := Null_Pointer; begin if Action /= null then - Callback := Item_Hook'Address; + Callback := Storage.To_Integer (Item_Hook'Address); User_Data := Callback_Convert.To_Address (Action); end if; Ret_Place := fl_menu_add @@ -365,10 +363,10 @@ package body FLTK.Widgets.Menus is Flags : in Menu_Flag := Flag_Normal) is Ret_Place : Interfaces.C.int; - Callback, User_Data : System.Address := System.Null_Address; + Callback, User_Data : Storage.Integer_Address := Null_Pointer; begin if Action /= null then - Callback := Item_Hook'Address; + Callback := Storage.To_Integer (Item_Hook'Address); User_Data := Callback_Convert.To_Address (Action); end if; Ret_Place := fl_menu_insert @@ -478,8 +476,8 @@ package body FLTK.Widgets.Menus is if Place = No_Index then raise No_Reference; end if; - Wrapper (This.My_Items (Place).all).Void_Ptr := - fl_menu_find_item2 (This.Void_Ptr, Callback_Convert.To_Address (Action)); + Wrapper (This.My_Items (Place).all).Void_Ptr := fl_menu_find_item2 + (This.Void_Ptr, Callback_Convert.To_Address (Action)); return R : FLTK.Menu_Items.Menu_Item_Reference := (Data => This.My_Items (Place)) do null; end return; @@ -741,7 +739,7 @@ package body FLTK.Widgets.Menus is Initial : in Extended_Index := No_Index) return Extended_Index is - Ptr : System.Address := fl_menu_popup + Ptr : Storage.Integer_Address := fl_menu_popup (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), @@ -758,7 +756,7 @@ package body FLTK.Widgets.Menus is Initial : in Extended_Index := No_Index) return Extended_Index is - Ptr : System.Address := fl_menu_pulldown + Ptr : Storage.Integer_Address := fl_menu_pulldown (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads index 7eb56d2..5023922 100644 --- a/src/fltk-widgets-menus.ads +++ b/src/fltk-widgets-menus.ads @@ -8,8 +8,7 @@ with private with Ada.Containers.Vectors, - Interfaces, - System; + Interfaces; package FLTK.Widgets.Menus is @@ -256,7 +255,7 @@ private - procedure Item_Hook (M, U : in System.Address); + procedure Item_Hook (M, U : in Storage.Integer_Address); pragma Convention (C, Item_Hook); diff --git a/src/fltk-widgets-progress_bars.adb b/src/fltk-widgets-progress_bars.adb index 387ff36..84ae173 100644 --- a/src/fltk-widgets-progress_bars.adb +++ b/src/fltk-widgets-progress_bars.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Progress_Bars is procedure progress_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, progress_set_draw_hook, "progress_set_draw_hook"); pragma Inline (progress_set_draw_hook); procedure progress_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, progress_set_handle_hook, "progress_set_handle_hook"); pragma Inline (progress_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Progress_Bars is function new_fl_progress (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_progress, "new_fl_progress"); pragma Inline (new_fl_progress); procedure free_fl_progress - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, free_fl_progress, "free_fl_progress"); pragma Inline (free_fl_progress); @@ -42,37 +37,37 @@ package body FLTK.Widgets.Progress_Bars is function fl_progress_get_minimum - (P : in System.Address) + (P : in Storage.Integer_Address) return Interfaces.C.C_float; pragma Import (C, fl_progress_get_minimum, "fl_progress_get_minimum"); pragma Inline (fl_progress_get_minimum); procedure fl_progress_set_minimum - (P : in System.Address; + (P : in Storage.Integer_Address; T : in Interfaces.C.C_float); pragma Import (C, fl_progress_set_minimum, "fl_progress_set_minimum"); pragma Inline (fl_progress_set_minimum); function fl_progress_get_maximum - (P : in System.Address) + (P : in Storage.Integer_Address) return Interfaces.C.C_float; pragma Import (C, fl_progress_get_maximum, "fl_progress_get_maximum"); pragma Inline (fl_progress_get_maximum); procedure fl_progress_set_maximum - (P : in System.Address; + (P : in Storage.Integer_Address; T : in Interfaces.C.C_float); pragma Import (C, fl_progress_set_maximum, "fl_progress_set_maximum"); pragma Inline (fl_progress_set_maximum); function fl_progress_get_value - (P : in System.Address) + (P : in Storage.Integer_Address) return Interfaces.C.C_float; pragma Import (C, fl_progress_get_value, "fl_progress_get_value"); pragma Inline (fl_progress_get_value); procedure fl_progress_set_value - (P : in System.Address; + (P : in Storage.Integer_Address; T : in Interfaces.C.C_float); pragma Import (C, fl_progress_set_value, "fl_progress_set_value"); pragma Inline (fl_progress_set_value); @@ -81,12 +76,12 @@ package body FLTK.Widgets.Progress_Bars is procedure fl_progress_draw - (P : in System.Address); + (P : in Storage.Integer_Address); pragma Import (C, fl_progress_draw, "fl_progress_draw"); pragma Inline (fl_progress_draw); function fl_progress_handle - (P : in System.Address; + (P : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_progress_handle, "fl_progress_handle"); @@ -98,11 +93,11 @@ package body FLTK.Widgets.Progress_Bars is procedure Finalize (This : in out Progress_Bar) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Progress_Bar'Class then free_fl_progress (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -126,9 +121,9 @@ package body FLTK.Widgets.Progress_Bars is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - progress_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - progress_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + progress_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + progress_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-adjusters.adb b/src/fltk-widgets-valuators-adjusters.adb index 078a840..861fe48 100644 --- a/src/fltk-widgets-valuators-adjusters.adb +++ b/src/fltk-widgets-valuators-adjusters.adb @@ -2,25 +2,23 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Valuators.Adjusters is procedure adjuster_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, adjuster_set_draw_hook, "adjuster_set_draw_hook"); pragma Inline (adjuster_set_draw_hook); procedure adjuster_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, adjuster_set_handle_hook, "adjuster_set_handle_hook"); pragma Inline (adjuster_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Valuators.Adjusters is function new_fl_adjuster (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_adjuster, "new_fl_adjuster"); pragma Inline (new_fl_adjuster); procedure free_fl_adjuster - (A : in System.Address); + (A : in Storage.Integer_Address); pragma Import (C, free_fl_adjuster, "free_fl_adjuster"); pragma Inline (free_fl_adjuster); @@ -43,13 +41,13 @@ package body FLTK.Widgets.Valuators.Adjusters is function fl_adjuster_is_soft - (A : in System.Address) + (A : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_adjuster_is_soft, "fl_adjuster_is_soft"); pragma Inline (fl_adjuster_is_soft); procedure fl_adjuster_set_soft - (A : in System.Address; + (A : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_adjuster_set_soft, "fl_adjuster_set_soft"); pragma Inline (fl_adjuster_set_soft); @@ -58,12 +56,12 @@ package body FLTK.Widgets.Valuators.Adjusters is procedure fl_adjuster_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_adjuster_draw, "fl_adjuster_draw"); pragma Inline (fl_adjuster_draw); function fl_adjuster_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_adjuster_handle, "fl_adjuster_handle"); @@ -75,11 +73,11 @@ package body FLTK.Widgets.Valuators.Adjusters is procedure Finalize (This : in out Adjuster) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Adjuster'Class then free_fl_adjuster (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -103,9 +101,9 @@ package body FLTK.Widgets.Valuators.Adjusters is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - adjuster_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - adjuster_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + adjuster_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + adjuster_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-counters-simple.adb b/src/fltk-widgets-valuators-counters-simple.adb index b0c3741..a6f1de4 100644 --- a/src/fltk-widgets-valuators-counters-simple.adb +++ b/src/fltk-widgets-valuators-counters-simple.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Counters.Simple is procedure simple_counter_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, simple_counter_set_draw_hook, "simple_counter_set_draw_hook"); pragma Inline (simple_counter_set_draw_hook); procedure simple_counter_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, simple_counter_set_handle_hook, "simple_counter_set_handle_hook"); pragma Inline (simple_counter_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Counters.Simple is function new_fl_simple_counter (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_simple_counter, "new_fl_simple_counter"); pragma Inline (new_fl_simple_counter); procedure free_fl_simple_counter - (A : in System.Address); + (A : in Storage.Integer_Address); pragma Import (C, free_fl_simple_counter, "free_fl_simple_counter"); pragma Inline (free_fl_simple_counter); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Counters.Simple is procedure fl_simple_counter_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_simple_counter_draw, "fl_simple_counter_draw"); pragma Inline (fl_simple_counter_draw); function fl_simple_counter_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_simple_counter_handle, "fl_simple_counter_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Counters.Simple is procedure Finalize (This : in out Simple_Counter) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Simple_Counter'Class then free_fl_simple_counter (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Counter (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Counters.Simple is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - simple_counter_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - simple_counter_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + simple_counter_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + simple_counter_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-counters.adb b/src/fltk-widgets-valuators-counters.adb index 6cda6d1..60beee3 100644 --- a/src/fltk-widgets-valuators-counters.adb +++ b/src/fltk-widgets-valuators-counters.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Counters is procedure counter_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, counter_set_draw_hook, "counter_set_draw_hook"); pragma Inline (counter_set_draw_hook); procedure counter_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, counter_set_handle_hook, "counter_set_handle_hook"); pragma Inline (counter_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Counters is function new_fl_counter (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_counter, "new_fl_counter"); pragma Inline (new_fl_counter); procedure free_fl_counter - (A : in System.Address); + (A : in Storage.Integer_Address); pragma Import (C, free_fl_counter, "free_fl_counter"); pragma Inline (free_fl_counter); @@ -42,19 +37,19 @@ package body FLTK.Widgets.Valuators.Counters is function fl_counter_get_step - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_counter_get_step, "fl_counter_get_step"); pragma Inline (fl_counter_get_step); procedure fl_counter_set_step - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_counter_set_step, "fl_counter_set_step"); pragma Inline (fl_counter_set_step); procedure fl_counter_set_lstep - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_counter_set_lstep, "fl_counter_set_lstep"); pragma Inline (fl_counter_set_lstep); @@ -63,37 +58,37 @@ package body FLTK.Widgets.Valuators.Counters is function fl_counter_get_textcolor - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_counter_get_textcolor, "fl_counter_get_textcolor"); pragma Inline (fl_counter_get_textcolor); procedure fl_counter_set_textcolor - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_counter_set_textcolor, "fl_counter_set_textcolor"); pragma Inline (fl_counter_set_textcolor); function fl_counter_get_textfont - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_counter_get_textfont, "fl_counter_get_textfont"); pragma Inline (fl_counter_get_textfont); procedure fl_counter_set_textfont - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_counter_set_textfont, "fl_counter_set_textfont"); pragma Inline (fl_counter_set_textfont); function fl_counter_get_textsize - (C : in System.Address) + (C : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_counter_get_textsize, "fl_counter_get_textsize"); pragma Inline (fl_counter_get_textsize); procedure fl_counter_set_textsize - (C : in System.Address; + (C : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_counter_set_textsize, "fl_counter_set_textsize"); pragma Inline (fl_counter_set_textsize); @@ -102,12 +97,12 @@ package body FLTK.Widgets.Valuators.Counters is procedure fl_counter_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_counter_draw, "fl_counter_draw"); pragma Inline (fl_counter_draw); function fl_counter_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_counter_handle, "fl_counter_handle"); @@ -119,11 +114,11 @@ package body FLTK.Widgets.Valuators.Counters is procedure Finalize (This : in out Counter) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Counter'Class then free_fl_counter (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -147,9 +142,9 @@ package body FLTK.Widgets.Valuators.Counters is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - counter_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - counter_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + counter_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + counter_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials-fill.adb b/src/fltk-widgets-valuators-dials-fill.adb index 40460f4..9e01cab 100644 --- a/src/fltk-widgets-valuators-dials-fill.adb +++ b/src/fltk-widgets-valuators-dials-fill.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Dials.Fill is procedure fill_dial_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, fill_dial_set_draw_hook, "fill_dial_set_draw_hook"); pragma Inline (fill_dial_set_draw_hook); procedure fill_dial_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, fill_dial_set_handle_hook, "fill_dial_set_handle_hook"); pragma Inline (fill_dial_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Dials.Fill is function new_fl_fill_dial (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_fill_dial, "new_fl_fill_dial"); pragma Inline (new_fl_fill_dial); procedure free_fl_fill_dial - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_fill_dial, "free_fl_fill_dial"); pragma Inline (free_fl_fill_dial); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Dials.Fill is procedure fl_fill_dial_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_fill_dial_draw, "fl_fill_dial_draw"); pragma Inline (fl_fill_dial_draw); function fl_fill_dial_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_fill_dial_handle, "fl_fill_dial_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Dials.Fill is procedure Finalize (This : in out Fill_Dial) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Fill_Dial'Class then free_fl_fill_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Dial (This)); end Finalize; @@ -87,9 +82,9 @@ package body FLTK.Widgets.Valuators.Dials.Fill is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - fill_dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - fill_dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + fill_dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + fill_dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials-line.adb b/src/fltk-widgets-valuators-dials-line.adb index 15565c3..e7799cd 100644 --- a/src/fltk-widgets-valuators-dials-line.adb +++ b/src/fltk-widgets-valuators-dials-line.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Dials.Line is procedure line_dial_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, line_dial_set_draw_hook, "line_dial_set_draw_hook"); pragma Inline (line_dial_set_draw_hook); procedure line_dial_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, line_dial_set_handle_hook, "line_dial_set_handle_hook"); pragma Inline (line_dial_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Dials.Line is function new_fl_line_dial (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_line_dial, "new_fl_line_dial"); pragma Inline (new_fl_line_dial); procedure free_fl_line_dial - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_line_dial, "free_fl_line_dial"); pragma Inline (free_fl_line_dial); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Dials.Line is procedure fl_line_dial_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_line_dial_draw, "fl_line_dial_draw"); pragma Inline (fl_line_dial_draw); function fl_line_dial_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_line_dial_handle, "fl_line_dial_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Dials.Line is procedure Finalize (This : in out Line_Dial) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Line_Dial'Class then free_fl_line_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Dial (This)); end Finalize; @@ -87,9 +82,9 @@ package body FLTK.Widgets.Valuators.Dials.Line is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - line_dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - line_dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + line_dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + line_dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-dials.adb b/src/fltk-widgets-valuators-dials.adb index 31ce0ed..d999333 100644 --- a/src/fltk-widgets-valuators-dials.adb +++ b/src/fltk-widgets-valuators-dials.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Dials is procedure dial_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, dial_set_draw_hook, "dial_set_draw_hook"); pragma Inline (dial_set_draw_hook); procedure dial_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, dial_set_handle_hook, "dial_set_handle_hook"); pragma Inline (dial_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Dials is function new_fl_dial (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_dial, "new_fl_dial"); pragma Inline (new_fl_dial); procedure free_fl_dial - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_dial, "free_fl_dial"); pragma Inline (free_fl_dial); @@ -42,13 +37,13 @@ package body FLTK.Widgets.Valuators.Dials is function fl_dial_get_type - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_dial_get_type, "fl_dial_get_type"); pragma Inline (fl_dial_get_type); procedure fl_dial_set_type - (D : in System.Address; + (D : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_dial_set_type, "fl_dial_set_type"); pragma Inline (fl_dial_set_type); @@ -57,31 +52,31 @@ package body FLTK.Widgets.Valuators.Dials is function fl_dial_get_angle1 - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_dial_get_angle1, "fl_dial_get_angle1"); pragma Inline (fl_dial_get_angle1); procedure fl_dial_set_angle1 - (D : in System.Address; + (D : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_dial_set_angle1, "fl_dial_set_angle1"); pragma Inline (fl_dial_set_angle1); function fl_dial_get_angle2 - (D : in System.Address) + (D : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_dial_get_angle2, "fl_dial_get_angle2"); pragma Inline (fl_dial_get_angle2); procedure fl_dial_set_angle2 - (D : in System.Address; + (D : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_dial_set_angle2, "fl_dial_set_angle2"); pragma Inline (fl_dial_set_angle2); procedure fl_dial_set_angles - (D : in System.Address; + (D : in Storage.Integer_Address; A, B : in Interfaces.C.int); pragma Import (C, fl_dial_set_angles, "fl_dial_set_angles"); pragma Inline (fl_dial_set_angles); @@ -90,12 +85,12 @@ package body FLTK.Widgets.Valuators.Dials is procedure fl_dial_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_dial_draw, "fl_dial_draw"); pragma Inline (fl_dial_draw); function fl_dial_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_dial_handle, "fl_dial_handle"); @@ -107,11 +102,11 @@ package body FLTK.Widgets.Valuators.Dials is procedure Finalize (This : in out Dial) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Dial'Class then free_fl_dial (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -135,9 +130,9 @@ package body FLTK.Widgets.Valuators.Dials is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - dial_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - dial_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + dial_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + dial_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-rollers.adb b/src/fltk-widgets-valuators-rollers.adb index 2a50f1b..8501aea 100644 --- a/src/fltk-widgets-valuators-rollers.adb +++ b/src/fltk-widgets-valuators-rollers.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Rollers is procedure roller_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, roller_set_draw_hook, "roller_set_draw_hook"); pragma Inline (roller_set_draw_hook); procedure roller_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, roller_set_handle_hook, "roller_set_handle_hook"); pragma Inline (roller_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Rollers is function new_fl_roller (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_roller, "new_fl_roller"); pragma Inline (new_fl_roller); procedure free_fl_roller - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_roller, "free_fl_roller"); pragma Inline (free_fl_roller); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Rollers is procedure fl_roller_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_roller_draw, "fl_roller_draw"); pragma Inline (fl_roller_draw); function fl_roller_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_roller_handle, "fl_roller_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Rollers is procedure Finalize (This : in out Roller) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Roller'Class then free_fl_roller (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -87,9 +82,9 @@ package body FLTK.Widgets.Valuators.Rollers is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - roller_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - roller_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + roller_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + roller_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-fill.adb b/src/fltk-widgets-valuators-sliders-fill.adb index 83f1ffb..d30fb79 100644 --- a/src/fltk-widgets-valuators-sliders-fill.adb +++ b/src/fltk-widgets-valuators-sliders-fill.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Fill is procedure fill_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, fill_slider_set_draw_hook, "fill_slider_set_draw_hook"); pragma Inline (fill_slider_set_draw_hook); procedure fill_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, fill_slider_set_handle_hook, "fill_slider_set_handle_hook"); pragma Inline (fill_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is function new_fl_fill_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_fill_slider, "new_fl_fill_slider"); pragma Inline (new_fl_fill_slider); procedure free_fl_fill_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_fill_slider, "free_fl_fill_slider"); pragma Inline (free_fl_fill_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is procedure fl_fill_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_fill_slider_draw, "fl_fill_slider_draw"); pragma Inline (fl_fill_slider_draw); function fl_fill_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_fill_slider_handle, "fl_fill_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is procedure Finalize (This : in out Fill_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Fill_Slider'Class then free_fl_fill_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Fill is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - fill_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - fill_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + fill_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + fill_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-hor_fill.adb b/src/fltk-widgets-valuators-sliders-hor_fill.adb index 3cb4f20..2d1ce52 100644 --- a/src/fltk-widgets-valuators-sliders-hor_fill.adb +++ b/src/fltk-widgets-valuators-sliders-hor_fill.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is procedure hor_fill_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, hor_fill_slider_set_draw_hook, "hor_fill_slider_set_draw_hook"); pragma Inline (hor_fill_slider_set_draw_hook); procedure hor_fill_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, hor_fill_slider_set_handle_hook, "hor_fill_slider_set_handle_hook"); pragma Inline (hor_fill_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is function new_fl_hor_fill_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_hor_fill_slider, "new_fl_hor_fill_slider"); pragma Inline (new_fl_hor_fill_slider); procedure free_fl_hor_fill_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_hor_fill_slider, "free_fl_hor_fill_slider"); pragma Inline (free_fl_hor_fill_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is procedure fl_hor_fill_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_hor_fill_slider_draw, "fl_hor_fill_slider_draw"); pragma Inline (fl_hor_fill_slider_draw); function fl_hor_fill_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_hor_fill_slider_handle, "fl_hor_fill_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is procedure Finalize (This : in out Hor_Fill_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Hor_Fill_Slider'Class then free_fl_hor_fill_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Fill is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_fill_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_fill_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + hor_fill_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + hor_fill_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-hor_nice.adb b/src/fltk-widgets-valuators-sliders-hor_nice.adb index 4f3db15..99291e5 100644 --- a/src/fltk-widgets-valuators-sliders-hor_nice.adb +++ b/src/fltk-widgets-valuators-sliders-hor_nice.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is procedure hor_nice_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, hor_nice_slider_set_draw_hook, "hor_nice_slider_set_draw_hook"); pragma Inline (hor_nice_slider_set_draw_hook); procedure hor_nice_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, hor_nice_slider_set_handle_hook, "hor_nice_slider_set_handle_hook"); pragma Inline (hor_nice_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is function new_fl_hor_nice_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_hor_nice_slider, "new_fl_hor_nice_slider"); pragma Inline (new_fl_hor_nice_slider); procedure free_fl_hor_nice_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_hor_nice_slider, "free_fl_hor_nice_slider"); pragma Inline (free_fl_hor_nice_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is procedure fl_hor_nice_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_hor_nice_slider_draw, "fl_hor_nice_slider_draw"); pragma Inline (fl_hor_nice_slider_draw); function fl_hor_nice_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_hor_nice_slider_handle, "fl_hor_nice_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is procedure Finalize (This : in out Hor_Nice_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Hor_Nice_Slider'Class then free_fl_hor_nice_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Hor_Nice is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_nice_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_nice_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + hor_nice_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + hor_nice_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-horizontal.adb b/src/fltk-widgets-valuators-sliders-horizontal.adb index 4675e23..bded6a2 100644 --- a/src/fltk-widgets-valuators-sliders-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-horizontal.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Horizontal is procedure horizontal_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, horizontal_slider_set_draw_hook, "horizontal_slider_set_draw_hook"); pragma Inline (horizontal_slider_set_draw_hook); procedure horizontal_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, horizontal_slider_set_handle_hook, "horizontal_slider_set_handle_hook"); pragma Inline (horizontal_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is function new_fl_horizontal_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_horizontal_slider, "new_fl_horizontal_slider"); pragma Inline (new_fl_horizontal_slider); procedure free_fl_horizontal_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_horizontal_slider, "free_fl_horizontal_slider"); pragma Inline (free_fl_horizontal_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is procedure fl_horizontal_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_horizontal_slider_draw, "fl_horizontal_slider_draw"); pragma Inline (fl_horizontal_slider_draw); function fl_horizontal_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_horizontal_slider_handle, "fl_horizontal_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is procedure Finalize (This : in out Horizontal_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Horizontal_Slider'Class then free_fl_horizontal_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Horizontal is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - horizontal_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - horizontal_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + horizontal_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + horizontal_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-nice.adb b/src/fltk-widgets-valuators-sliders-nice.adb index 3820c5f..af9e746 100644 --- a/src/fltk-widgets-valuators-sliders-nice.adb +++ b/src/fltk-widgets-valuators-sliders-nice.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Nice is procedure nice_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, nice_slider_set_draw_hook, "nice_slider_set_draw_hook"); pragma Inline (nice_slider_set_draw_hook); procedure nice_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, nice_slider_set_handle_hook, "nice_slider_set_handle_hook"); pragma Inline (nice_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is function new_fl_nice_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_nice_slider, "new_fl_nice_slider"); pragma Inline (new_fl_nice_slider); procedure free_fl_nice_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_nice_slider, "free_fl_nice_slider"); pragma Inline (free_fl_nice_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is procedure fl_nice_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_nice_slider_draw, "fl_nice_slider_draw"); pragma Inline (fl_nice_slider_draw); function fl_nice_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_nice_slider_handle, "fl_nice_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is procedure Finalize (This : in out Nice_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Nice_Slider'Class then free_fl_nice_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Nice is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - nice_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - nice_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + nice_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + nice_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-scrollbars.adb b/src/fltk-widgets-valuators-sliders-scrollbars.adb index e40ec1f..eeda596 100644 --- a/src/fltk-widgets-valuators-sliders-scrollbars.adb +++ b/src/fltk-widgets-valuators-sliders-scrollbars.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Scrollbars is procedure scrollbar_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, scrollbar_set_draw_hook, "scrollbar_set_draw_hook"); pragma Inline (scrollbar_set_draw_hook); procedure scrollbar_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, scrollbar_set_handle_hook, "scrollbar_set_handle_hook"); pragma Inline (scrollbar_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is function new_fl_scrollbar (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_scrollbar, "new_fl_scrollbar"); pragma Inline (new_fl_scrollbar); procedure free_fl_scrollbar - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_scrollbar, "free_fl_scrollbar"); pragma Inline (free_fl_scrollbar); @@ -42,31 +37,31 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is function fl_scrollbar_get_linesize - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_scrollbar_get_linesize, "fl_scrollbar_get_linesize"); pragma Inline (fl_scrollbar_get_linesize); procedure fl_scrollbar_set_linesize - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_scrollbar_set_linesize, "fl_scrollbar_set_linesize"); pragma Inline (fl_scrollbar_set_linesize); function fl_scrollbar_get_value - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_scrollbar_get_value, "fl_scrollbar_get_value"); pragma Inline (fl_scrollbar_get_value); procedure fl_scrollbar_set_value - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_scrollbar_set_value, "fl_scrollbar_set_value"); pragma Inline (fl_scrollbar_set_value); procedure fl_scrollbar_set_value2 - (S : in System.Address; + (S : in Storage.Integer_Address; P, W, F, T : in Interfaces.C.int); pragma Import (C, fl_scrollbar_set_value2, "fl_scrollbar_set_value2"); pragma Inline (fl_scrollbar_set_value2); @@ -75,12 +70,12 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is procedure fl_scrollbar_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_scrollbar_draw, "fl_scrollbar_draw"); pragma Inline (fl_scrollbar_draw); function fl_scrollbar_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_scrollbar_handle, "fl_scrollbar_handle"); @@ -92,11 +87,11 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is procedure Finalize (This : in out Scrollbar) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Scrollbar'Class then free_fl_scrollbar (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -120,9 +115,9 @@ package body FLTK.Widgets.Valuators.Sliders.Scrollbars is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - scrollbar_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - scrollbar_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + scrollbar_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + scrollbar_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-value-horizontal.adb b/src/fltk-widgets-valuators-sliders-value-horizontal.adb index d3c0c06..03805eb 100644 --- a/src/fltk-widgets-valuators-sliders-value-horizontal.adb +++ b/src/fltk-widgets-valuators-sliders-value-horizontal.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is procedure hor_value_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, hor_value_slider_set_draw_hook, "hor_value_slider_set_draw_hook"); pragma Inline (hor_value_slider_set_draw_hook); procedure hor_value_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, hor_value_slider_set_handle_hook, "hor_value_slider_set_handle_hook"); pragma Inline (hor_value_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is function new_fl_hor_value_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_hor_value_slider, "new_fl_hor_value_slider"); pragma Inline (new_fl_hor_value_slider); procedure free_fl_hor_value_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_hor_value_slider, "free_fl_hor_value_slider"); pragma Inline (free_fl_hor_value_slider); @@ -42,12 +37,12 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is procedure fl_hor_value_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_hor_value_slider_draw, "fl_hor_value_slider_draw"); pragma Inline (fl_hor_value_slider_draw); function fl_hor_value_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_hor_value_slider_handle, "fl_hor_value_slider_handle"); @@ -59,11 +54,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is procedure Finalize (This : in out Hor_Value_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Hor_Value_Slider'Class then free_fl_hor_value_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Value_Slider (This)); end Finalize; @@ -87,9 +82,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value.Horizontal is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - hor_value_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - hor_value_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + hor_value_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + hor_value_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders-value.adb b/src/fltk-widgets-valuators-sliders-value.adb index 48cd603..d6ad35a 100644 --- a/src/fltk-widgets-valuators-sliders-value.adb +++ b/src/fltk-widgets-valuators-sliders-value.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders.Value is procedure value_slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, value_slider_set_draw_hook, "value_slider_set_draw_hook"); pragma Inline (value_slider_set_draw_hook); procedure value_slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, value_slider_set_handle_hook, "value_slider_set_handle_hook"); pragma Inline (value_slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders.Value is function new_fl_value_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_value_slider, "new_fl_value_slider"); pragma Inline (new_fl_value_slider); procedure free_fl_value_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_value_slider, "free_fl_value_slider"); pragma Inline (free_fl_value_slider); @@ -42,37 +37,37 @@ package body FLTK.Widgets.Valuators.Sliders.Value is function fl_value_slider_get_textcolor - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_value_slider_get_textcolor, "fl_value_slider_get_textcolor"); pragma Inline (fl_value_slider_get_textcolor); procedure fl_value_slider_set_textcolor - (S : in System.Address; + (S : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_value_slider_set_textcolor, "fl_value_slider_set_textcolor"); pragma Inline (fl_value_slider_set_textcolor); function fl_value_slider_get_textfont - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_slider_get_textfont, "fl_value_slider_get_textfont"); pragma Inline (fl_value_slider_get_textfont); procedure fl_value_slider_set_textfont - (S : in System.Address; + (S : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_value_slider_set_textfont, "fl_value_slider_set_textfont"); pragma Inline (fl_value_slider_set_textfont); function fl_value_slider_get_textsize - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_slider_get_textsize, "fl_value_slider_get_textsize"); pragma Inline (fl_value_slider_get_textsize); procedure fl_value_slider_set_textsize - (S : in System.Address; + (S : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_value_slider_set_textsize, "fl_value_slider_set_textsize"); pragma Inline (fl_value_slider_set_textsize); @@ -81,12 +76,12 @@ package body FLTK.Widgets.Valuators.Sliders.Value is procedure fl_value_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_value_slider_draw, "fl_value_slider_draw"); pragma Inline (fl_value_slider_draw); function fl_value_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_value_slider_handle, "fl_value_slider_handle"); @@ -98,11 +93,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value is procedure Finalize (This : in out Value_Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Value_Slider'Class then free_fl_value_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Slider (This)); end Finalize; @@ -126,9 +121,11 @@ package body FLTK.Widgets.Valuators.Sliders.Value is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + value_slider_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + value_slider_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-sliders.adb b/src/fltk-widgets-valuators-sliders.adb index 5511695..6f536e5 100644 --- a/src/fltk-widgets-valuators-sliders.adb +++ b/src/fltk-widgets-valuators-sliders.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators.Sliders is procedure slider_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, slider_set_draw_hook, "slider_set_draw_hook"); pragma Inline (slider_set_draw_hook); procedure slider_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, slider_set_handle_hook, "slider_set_handle_hook"); pragma Inline (slider_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators.Sliders is function new_fl_slider (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_slider, "new_fl_slider"); pragma Inline (new_fl_slider); procedure free_fl_slider - (D : in System.Address); + (D : in Storage.Integer_Address); pragma Import (C, free_fl_slider, "free_fl_slider"); pragma Inline (free_fl_slider); @@ -42,13 +37,13 @@ package body FLTK.Widgets.Valuators.Sliders is function fl_slider_get_type - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_slider_get_type, "fl_slider_get_type"); pragma Inline (fl_slider_get_type); procedure fl_slider_set_type - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_slider_set_type, "fl_slider_set_type"); pragma Inline (fl_slider_set_type); @@ -57,37 +52,37 @@ package body FLTK.Widgets.Valuators.Sliders is procedure fl_slider_set_bounds - (S : in System.Address; + (S : in Storage.Integer_Address; A, B : in Interfaces.C.double); pragma Import (C, fl_slider_set_bounds, "fl_slider_set_bounds"); pragma Inline (fl_slider_set_bounds); function fl_slider_get_slider - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_slider_get_slider, "fl_slider_get_slider"); pragma Inline (fl_slider_get_slider); procedure fl_slider_set_slider - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_slider_set_slider, "fl_slider_set_slider"); pragma Inline (fl_slider_set_slider); function fl_slider_get_slider_size - (S : in System.Address) + (S : in Storage.Integer_Address) return Interfaces.C.C_float; pragma Import (C, fl_slider_get_slider_size, "fl_slider_get_slider_size"); pragma Inline (fl_slider_get_slider_size); procedure fl_slider_set_slider_size - (S : in System.Address; + (S : in Storage.Integer_Address; T : in Interfaces.C.C_float); pragma Import (C, fl_slider_set_slider_size, "fl_slider_set_slider_size"); pragma Inline (fl_slider_set_slider_size); function fl_slider_scrollvalue - (S : in System.Address; + (S : in Storage.Integer_Address; P, Z, F, T : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_slider_scrollvalue, "fl_slider_scrollvalue"); @@ -97,12 +92,12 @@ package body FLTK.Widgets.Valuators.Sliders is procedure fl_slider_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_slider_draw, "fl_slider_draw"); pragma Inline (fl_slider_draw); function fl_slider_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_slider_handle, "fl_slider_handle"); @@ -114,11 +109,11 @@ package body FLTK.Widgets.Valuators.Sliders is procedure Finalize (This : in out Slider) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Slider'Class then free_fl_slider (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -142,9 +137,9 @@ package body FLTK.Widgets.Valuators.Sliders is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - slider_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - slider_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + slider_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + slider_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators-value_inputs.adb b/src/fltk-widgets-valuators-value_inputs.adb index fbba892..e68a61c 100644 --- a/src/fltk-widgets-valuators-value_inputs.adb +++ b/src/fltk-widgets-valuators-value_inputs.adb @@ -3,25 +3,23 @@ with Ada.Unchecked_Deallocation, - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Valuators.Value_Inputs is procedure value_input_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, value_input_set_draw_hook, "value_input_set_draw_hook"); pragma Inline (value_input_set_draw_hook); procedure value_input_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, value_input_set_handle_hook, "value_input_set_handle_hook"); pragma Inline (value_input_set_handle_hook); @@ -31,12 +29,12 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function new_fl_value_input (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_value_input, "new_fl_value_input"); pragma Inline (new_fl_value_input); procedure free_fl_value_input - (A : in System.Address); + (A : in Storage.Integer_Address); pragma Import (C, free_fl_value_input, "free_fl_value_input"); pragma Inline (free_fl_value_input); @@ -44,8 +42,8 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function fl_value_input_get_input - (V : in System.Address) - return System.Address; + (V : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_value_input_get_input, "fl_value_input_get_input"); pragma Inline (fl_value_input_get_input); @@ -53,13 +51,13 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function fl_value_input_get_cursor_color - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_value_input_get_cursor_color, "fl_value_input_get_cursor_color"); pragma Inline (fl_value_input_get_cursor_color); procedure fl_value_input_set_cursor_color - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_value_input_set_cursor_color, "fl_value_input_set_cursor_color"); pragma Inline (fl_value_input_set_cursor_color); @@ -68,13 +66,13 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function fl_value_input_get_shortcut - (B : in System.Address) + (B : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_input_get_shortcut, "fl_value_input_get_shortcut"); pragma Inline (fl_value_input_get_shortcut); procedure fl_value_input_set_shortcut - (B : in System.Address; + (B : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_value_input_set_shortcut, "fl_value_input_set_shortcut"); pragma Inline (fl_value_input_set_shortcut); @@ -83,13 +81,13 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function fl_value_input_is_soft - (A : in System.Address) + (A : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_input_is_soft, "fl_value_input_is_soft"); pragma Inline (fl_value_input_is_soft); procedure fl_value_input_set_soft - (A : in System.Address; + (A : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_value_input_set_soft, "fl_value_input_set_soft"); pragma Inline (fl_value_input_set_soft); @@ -98,37 +96,37 @@ package body FLTK.Widgets.Valuators.Value_Inputs is function fl_value_input_get_text_color - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_value_input_get_text_color, "fl_value_input_get_text_color"); pragma Inline (fl_value_input_get_text_color); procedure fl_value_input_set_text_color - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_value_input_set_text_color, "fl_value_input_set_text_color"); pragma Inline (fl_value_input_set_text_color); function fl_value_input_get_text_font - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_input_get_text_font, "fl_value_input_get_text_font"); pragma Inline (fl_value_input_get_text_font); procedure fl_value_input_set_text_font - (TD : in System.Address; + (TD : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_value_input_set_text_font, "fl_value_input_set_text_font"); pragma Inline (fl_value_input_set_text_font); function fl_value_input_get_text_size - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_input_get_text_size, "fl_value_input_get_text_size"); pragma Inline (fl_value_input_get_text_size); procedure fl_value_input_set_text_size - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_value_input_set_text_size, "fl_value_input_set_text_size"); pragma Inline (fl_value_input_set_text_size); @@ -137,12 +135,12 @@ package body FLTK.Widgets.Valuators.Value_Inputs is procedure fl_value_input_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_value_input_draw, "fl_value_input_draw"); pragma Inline (fl_value_input_draw); function fl_value_input_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_value_input_handle, "fl_value_input_handle"); @@ -160,12 +158,12 @@ package body FLTK.Widgets.Valuators.Value_Inputs is procedure Finalize (This : in out Value_Input) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Value_Input'Class then free_fl_value_input (This.Void_Ptr); Free (This.My_Input); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -189,9 +187,11 @@ package body FLTK.Widgets.Valuators.Value_Inputs is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_input_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_input_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + value_input_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + value_input_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); This.My_Input := new INP.Input; diff --git a/src/fltk-widgets-valuators-value_outputs.adb b/src/fltk-widgets-valuators-value_outputs.adb index 0c99ace..8d74434 100644 --- a/src/fltk-widgets-valuators-value_outputs.adb +++ b/src/fltk-widgets-valuators-value_outputs.adb @@ -2,25 +2,23 @@ with - Interfaces.C.Strings, - System; + Interfaces.C.Strings; use type - Interfaces.C.int, - System.Address; + Interfaces.C.int; package body FLTK.Widgets.Valuators.Value_Outputs is procedure value_output_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, value_output_set_draw_hook, "value_output_set_draw_hook"); pragma Inline (value_output_set_draw_hook); procedure value_output_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, value_output_set_handle_hook, "value_output_set_handle_hook"); pragma Inline (value_output_set_handle_hook); @@ -30,12 +28,12 @@ package body FLTK.Widgets.Valuators.Value_Outputs is function new_fl_value_output (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_value_output, "new_fl_value_output"); pragma Inline (new_fl_value_output); procedure free_fl_value_output - (A : in System.Address); + (A : in Storage.Integer_Address); pragma Import (C, free_fl_value_output, "free_fl_value_output"); pragma Inline (free_fl_value_output); @@ -43,13 +41,13 @@ package body FLTK.Widgets.Valuators.Value_Outputs is function fl_value_output_is_soft - (A : in System.Address) + (A : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_output_is_soft, "fl_value_output_is_soft"); pragma Inline (fl_value_output_is_soft); procedure fl_value_output_set_soft - (A : in System.Address; + (A : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_value_output_set_soft, "fl_value_output_set_soft"); pragma Inline (fl_value_output_set_soft); @@ -58,37 +56,37 @@ package body FLTK.Widgets.Valuators.Value_Outputs is function fl_value_output_get_text_color - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_value_output_get_text_color, "fl_value_output_get_text_color"); pragma Inline (fl_value_output_get_text_color); procedure fl_value_output_set_text_color - (TD : in System.Address; + (TD : in Storage.Integer_Address; C : in Interfaces.C.unsigned); pragma Import (C, fl_value_output_set_text_color, "fl_value_output_set_text_color"); pragma Inline (fl_value_output_set_text_color); function fl_value_output_get_text_font - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_output_get_text_font, "fl_value_output_get_text_font"); pragma Inline (fl_value_output_get_text_font); procedure fl_value_output_set_text_font - (TD : in System.Address; + (TD : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_value_output_set_text_font, "fl_value_output_set_text_font"); pragma Inline (fl_value_output_set_text_font); function fl_value_output_get_text_size - (TD : in System.Address) + (TD : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_value_output_get_text_size, "fl_value_output_get_text_size"); pragma Inline (fl_value_output_get_text_size); procedure fl_value_output_set_text_size - (TD : in System.Address; + (TD : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_value_output_set_text_size, "fl_value_output_set_text_size"); pragma Inline (fl_value_output_set_text_size); @@ -97,12 +95,12 @@ package body FLTK.Widgets.Valuators.Value_Outputs is procedure fl_value_output_draw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_value_output_draw, "fl_value_output_draw"); pragma Inline (fl_value_output_draw); function fl_value_output_handle - (W : in System.Address; + (W : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_value_output_handle, "fl_value_output_handle"); @@ -114,11 +112,11 @@ package body FLTK.Widgets.Valuators.Value_Outputs is procedure Finalize (This : in out Value_Output) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Value_Output'Class then free_fl_value_output (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Valuator (This)); end Finalize; @@ -142,9 +140,11 @@ package body FLTK.Widgets.Valuators.Value_Outputs is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - value_output_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - value_output_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + value_output_set_draw_hook + (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + value_output_set_handle_hook + (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets-valuators.adb b/src/fltk-widgets-valuators.adb index f7515d2..7faec77 100644 --- a/src/fltk-widgets-valuators.adb +++ b/src/fltk-widgets-valuators.adb @@ -2,24 +2,19 @@ with - Interfaces.C.Strings, - System; - -use type - - System.Address; + Interfaces.C.Strings; package body FLTK.Widgets.Valuators is procedure valuator_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, valuator_set_draw_hook, "valuator_set_draw_hook"); pragma Inline (valuator_set_draw_hook); procedure valuator_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, valuator_set_handle_hook, "valuator_set_handle_hook"); pragma Inline (valuator_set_handle_hook); @@ -29,12 +24,12 @@ package body FLTK.Widgets.Valuators is function new_fl_valuator (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_valuator, "new_fl_valuator"); pragma Inline (new_fl_valuator); procedure free_fl_valuator - (V : in System.Address); + (V : in Storage.Integer_Address); pragma Import (C, free_fl_valuator, "free_fl_valuator"); pragma Inline (free_fl_valuator); @@ -42,21 +37,21 @@ package body FLTK.Widgets.Valuators is function fl_valuator_clamp - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double) return Interfaces.C.double; pragma Import (C, fl_valuator_clamp, "fl_valuator_clamp"); pragma Inline (fl_valuator_clamp); function fl_valuator_round - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double) return Interfaces.C.double; pragma Import (C, fl_valuator_round, "fl_valuator_round"); pragma Inline (fl_valuator_round); function fl_valuator_increment - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double; S : in Interfaces.C.int) return Interfaces.C.double; @@ -67,67 +62,67 @@ package body FLTK.Widgets.Valuators is function fl_valuator_get_minimum - (V : in System.Address) + (V : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_valuator_get_minimum, "fl_valuator_get_minimum"); pragma Inline (fl_valuator_get_minimum); procedure fl_valuator_set_minimum - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double); pragma Import (C, fl_valuator_set_minimum, "fl_valuator_set_minimum"); pragma Inline (fl_valuator_set_minimum); function fl_valuator_get_maximum - (V : in System.Address) + (V : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_valuator_get_maximum, "fl_valuator_get_maximum"); pragma Inline (fl_valuator_get_maximum); procedure fl_valuator_set_maximum - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double); pragma Import (C, fl_valuator_set_maximum, "fl_valuator_set_maximum"); pragma Inline (fl_valuator_set_maximum); function fl_valuator_get_step - (V : in System.Address) + (V : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_valuator_get_step, "fl_valuator_get_step"); pragma Inline (fl_valuator_get_step); procedure fl_valuator_set_step - (V : in System.Address; + (V : in Storage.Integer_Address; T : in Interfaces.C.double); pragma Import (C, fl_valuator_set_step, "fl_valuator_set_step"); pragma Inline (fl_valuator_set_step); function fl_valuator_get_value - (V : in System.Address) + (V : in Storage.Integer_Address) return Interfaces.C.double; pragma Import (C, fl_valuator_get_value, "fl_valuator_get_value"); pragma Inline (fl_valuator_get_value); procedure fl_valuator_set_value - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.double); pragma Import (C, fl_valuator_set_value, "fl_valuator_set_value"); pragma Inline (fl_valuator_set_value); procedure fl_valuator_bounds - (V : in System.Address; + (V : in Storage.Integer_Address; A, B : in Interfaces.C.double); pragma Import (C, fl_valuator_bounds, "fl_valuator_bounds"); pragma Inline (fl_valuator_bounds); procedure fl_valuator_precision - (V : in System.Address; + (V : in Storage.Integer_Address; D : in Interfaces.C.int); pragma Import (C, fl_valuator_precision, "fl_valuator_precision"); pragma Inline (fl_valuator_precision); procedure fl_valuator_range - (V : in System.Address; + (V : in Storage.Integer_Address; A, B : in Interfaces.C.double); pragma Import (C, fl_valuator_range, "fl_valuator_range"); pragma Inline (fl_valuator_range); @@ -136,7 +131,7 @@ package body FLTK.Widgets.Valuators is function fl_valuator_handle - (V : in System.Address; + (V : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_valuator_handle, "fl_valuator_handle"); @@ -148,11 +143,11 @@ package body FLTK.Widgets.Valuators is procedure Finalize (This : in out Valuator) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Valuator'Class then free_fl_valuator (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; Finalize (Widget (This)); end Finalize; @@ -176,9 +171,9 @@ package body FLTK.Widgets.Valuators is Interfaces.C.To_C (Text)); fl_widget_set_user_data (This.Void_Ptr, - Widget_Convert.To_Address (This'Unchecked_Access)); - valuator_set_draw_hook (This.Void_Ptr, Draw_Hook'Address); - valuator_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + valuator_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + valuator_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; diff --git a/src/fltk-widgets.adb b/src/fltk-widgets.adb index f08639b..0602297 100644 --- a/src/fltk-widgets.adb +++ b/src/fltk-widgets.adb @@ -11,8 +11,7 @@ use type Interfaces.C.int, Interfaces.C.unsigned, - Interfaces.C.Strings.chars_ptr, - System.Address; + Interfaces.C.Strings.chars_ptr; package body FLTK.Widgets is @@ -38,12 +37,12 @@ package body FLTK.Widgets is procedure widget_set_draw_hook - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, widget_set_draw_hook, "widget_set_draw_hook"); pragma Inline (widget_set_draw_hook); procedure widget_set_handle_hook - (W, H : in System.Address); + (W, H : in Storage.Integer_Address); pragma Import (C, widget_set_handle_hook, "widget_set_handle_hook"); pragma Inline (widget_set_handle_hook); @@ -53,12 +52,12 @@ package body FLTK.Widgets is function new_fl_widget (X, Y, W, H : in Interfaces.C.int; Text : in Interfaces.C.char_array) - return System.Address; + return Storage.Integer_Address; pragma Import (C, new_fl_widget, "new_fl_widget"); pragma Inline (new_fl_widget); procedure free_fl_widget - (F : in System.Address); + (F : in Storage.Integer_Address); pragma Import (C, free_fl_widget, "free_fl_widget"); pragma Inline (free_fl_widget); @@ -66,34 +65,34 @@ package body FLTK.Widgets is procedure fl_widget_activate - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_activate, "fl_widget_activate"); pragma Inline (fl_widget_activate); procedure fl_widget_deactivate - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_deactivate, "fl_widget_deactivate"); pragma Inline (fl_widget_deactivate); function fl_widget_active - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_active, "fl_widget_active"); pragma Inline (fl_widget_active); function fl_widget_active_r - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_active_r, "fl_widget_active_r"); pragma Inline (fl_widget_active_r); procedure fl_widget_set_active - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_set_active, "fl_widget_set_active"); pragma Inline (fl_widget_set_active); procedure fl_widget_clear_active - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_clear_active, "fl_widget_clear_active"); pragma Inline (fl_widget_clear_active); @@ -101,56 +100,56 @@ package body FLTK.Widgets is function fl_widget_changed - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_changed, "fl_widget_changed"); pragma Inline (fl_widget_changed); procedure fl_widget_set_changed - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_set_changed, "fl_widget_set_changed"); pragma Inline (fl_widget_set_changed); procedure fl_widget_clear_changed - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_clear_changed, "fl_widget_clear_changed"); pragma Inline (fl_widget_clear_changed); function fl_widget_output - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_output, "fl_widget_output"); pragma Inline (fl_widget_output); procedure fl_widget_set_output - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_set_output, "fl_widget_set_output"); pragma Inline (fl_widget_set_output); procedure fl_widget_clear_output - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_clear_output, "fl_widget_clear_output"); pragma Inline (fl_widget_clear_output); function fl_widget_visible - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_visible, "fl_widget_visible"); pragma Inline (fl_widget_visible); function fl_widget_visible_r - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_visible_r, "fl_widget_visible_r"); pragma Inline (fl_widget_visible_r); procedure fl_widget_set_visible - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_set_visible, "fl_widget_set_visible"); pragma Inline (fl_widget_set_visible); procedure fl_widget_clear_visible - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_clear_visible, "fl_widget_clear_visible"); pragma Inline (fl_widget_clear_visible); @@ -158,25 +157,25 @@ package body FLTK.Widgets is function fl_widget_get_visible_focus - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_visible_focus, "fl_widget_get_visible_focus"); pragma Inline (fl_widget_get_visible_focus); procedure fl_widget_set_visible_focus - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_widget_set_visible_focus, "fl_widget_set_visible_focus"); pragma Inline (fl_widget_set_visible_focus); function fl_widget_take_focus - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_take_focus, "fl_widget_take_focus"); pragma Inline (fl_widget_take_focus); function fl_widget_takesevents - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_takesevents, "fl_widget_takesevents"); pragma Inline (fl_widget_takesevents); @@ -185,25 +184,25 @@ package body FLTK.Widgets is function fl_widget_get_color - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_get_color, "fl_widget_get_color"); pragma Inline (fl_widget_get_color); procedure fl_widget_set_color - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_widget_set_color, "fl_widget_set_color"); pragma Inline (fl_widget_set_color); function fl_widget_get_selection_color - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_get_selection_color, "fl_widget_get_selection_color"); pragma Inline (fl_widget_get_selection_color); procedure fl_widget_set_selection_color - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_widget_set_selection_color, "fl_widget_set_selection_color"); pragma Inline (fl_widget_set_selection_color); @@ -212,39 +211,39 @@ package body FLTK.Widgets is function fl_widget_get_parent - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_get_parent, "fl_widget_get_parent"); pragma Inline (fl_widget_get_parent); function fl_widget_contains - (W, I : in System.Address) + (W, I : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_contains, "fl_widget_contains"); pragma Inline (fl_widget_contains); function fl_widget_inside - (W, P : in System.Address) + (W, P : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_inside, "fl_widget_inside"); pragma Inline (fl_widget_inside); function fl_widget_window - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_window, "fl_widget_window"); pragma Inline (fl_widget_window); function fl_widget_top_window - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_top_window, "fl_widget_top_window"); pragma Inline (fl_widget_top_window); function fl_widget_top_window_offset - (W : in System.Address; + (W : in Storage.Integer_Address; X, Y : out Interfaces.C.int) - return System.Address; + return Storage.Integer_Address; pragma Import (C, fl_widget_top_window_offset, "fl_widget_top_window_offset"); pragma Inline (fl_widget_top_window_offset); @@ -252,37 +251,37 @@ package body FLTK.Widgets is function fl_widget_get_align - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_get_align, "fl_widget_get_align"); pragma Inline (fl_widget_get_align); procedure fl_widget_set_align - (W : in System.Address; + (W : in Storage.Integer_Address; A : in Interfaces.C.unsigned); pragma Import (C, fl_widget_set_align, "fl_widget_set_align"); pragma Inline (fl_widget_set_align); function fl_widget_get_box - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_box, "fl_widget_get_box"); pragma Inline (fl_widget_get_box); procedure fl_widget_set_box - (W : in System.Address; + (W : in Storage.Integer_Address; B : in Interfaces.C.int); pragma Import (C, fl_widget_set_box, "fl_widget_set_box"); pragma Inline (fl_widget_set_box); function fl_widget_tooltip - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_widget_tooltip, "fl_widget_tooltip"); pragma Inline (fl_widget_tooltip); procedure fl_widget_copy_tooltip - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_widget_copy_tooltip, "fl_widget_copy_tooltip"); pragma Inline (fl_widget_copy_tooltip); @@ -291,61 +290,61 @@ package body FLTK.Widgets is function fl_widget_get_label - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_widget_get_label, "fl_widget_get_label"); pragma Inline (fl_widget_get_label); function fl_widget_get_labelcolor - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_get_labelcolor, "fl_widget_get_labelcolor"); pragma Inline (fl_widget_get_labelcolor); procedure fl_widget_set_labelcolor - (W : in System.Address; + (W : in Storage.Integer_Address; V : in Interfaces.C.unsigned); pragma Import (C, fl_widget_set_labelcolor, "fl_widget_set_labelcolor"); pragma Inline (fl_widget_set_labelcolor); function fl_widget_get_labelfont - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_labelfont, "fl_widget_get_labelfont"); pragma Inline (fl_widget_get_labelfont); procedure fl_widget_set_labelfont - (W : in System.Address; + (W : in Storage.Integer_Address; F : in Interfaces.C.int); pragma Import (C, fl_widget_set_labelfont, "fl_widget_set_labelfont"); pragma Inline (fl_widget_set_labelfont); function fl_widget_get_labelsize - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_labelsize, "fl_widget_get_labelsize"); pragma Inline (fl_widget_get_labelsize); procedure fl_widget_set_labelsize - (W : in System.Address; + (W : in Storage.Integer_Address; S : in Interfaces.C.int); pragma Import (C, fl_widget_set_labelsize, "fl_widget_set_labelsize"); pragma Inline (fl_widget_set_labelsize); function fl_widget_get_labeltype - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_labeltype, "fl_widget_get_labeltype"); pragma Inline (fl_widget_get_labeltype); procedure fl_widget_set_labeltype - (W : in System.Address; + (W : in Storage.Integer_Address; L : in Interfaces.C.int); pragma Import (C, fl_widget_set_labeltype, "fl_widget_set_labeltype"); pragma Inline (fl_widget_set_labeltype); procedure fl_widget_measure_label - (W : in System.Address; + (W : in Storage.Integer_Address; D, H : out Interfaces.C.int); pragma Import (C, fl_widget_measure_label, "fl_widget_measure_label"); pragma Inline (fl_widget_measure_label); @@ -354,18 +353,18 @@ package body FLTK.Widgets is procedure fl_widget_set_callback - (W, C : in System.Address); + (W, C : in Storage.Integer_Address); pragma Import (C, fl_widget_set_callback, "fl_widget_set_callback"); pragma Inline (fl_widget_set_callback); function fl_widget_get_when - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.unsigned; pragma Import (C, fl_widget_get_when, "fl_widget_get_when"); pragma Inline (fl_widget_get_when); procedure fl_widget_set_when - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.unsigned); pragma Import (C, fl_widget_set_when, "fl_widget_set_when"); pragma Inline (fl_widget_set_when); @@ -374,37 +373,37 @@ package body FLTK.Widgets is function fl_widget_get_x - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_x, "fl_widget_get_x"); pragma Inline (fl_widget_get_x); function fl_widget_get_y - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_y, "fl_widget_get_y"); pragma Inline (fl_widget_get_y); function fl_widget_get_w - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_w, "fl_widget_get_w"); pragma Inline (fl_widget_get_w); function fl_widget_get_h - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_get_h, "fl_widget_get_h"); pragma Inline (fl_widget_get_h); procedure fl_widget_size - (W : in System.Address; + (W : in Storage.Integer_Address; D, H : in Interfaces.C.int); pragma Import (C, fl_widget_size, "fl_widget_size"); pragma Inline (fl_widget_size); procedure fl_widget_position - (W : in System.Address; + (W : in Storage.Integer_Address; X, Y : in Interfaces.C.int); pragma Import (C, fl_widget_position, "fl_widget_position"); pragma Inline (fl_widget_position); @@ -413,12 +412,12 @@ package body FLTK.Widgets is procedure fl_widget_set_image - (W, I : in System.Address); + (W, I : in Storage.Integer_Address); pragma Import (C, fl_widget_set_image, "fl_widget_set_image"); pragma Inline (fl_widget_set_image); procedure fl_widget_set_deimage - (W, I : in System.Address); + (W, I : in Storage.Integer_Address); pragma Import (C, fl_widget_set_deimage, "fl_widget_set_deimage"); pragma Inline (fl_widget_set_deimage); @@ -426,38 +425,38 @@ package body FLTK.Widgets is function fl_widget_damage - (W : in System.Address) + (W : in Storage.Integer_Address) return Interfaces.C.int; pragma Import (C, fl_widget_damage, "fl_widget_damage"); pragma Inline (fl_widget_damage); procedure fl_widget_set_damage - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.int); pragma Import (C, fl_widget_set_damage, "fl_widget_set_damage"); pragma Inline (fl_widget_set_damage); procedure fl_widget_set_damage2 - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.int; X, Y, D, H : in Interfaces.C.int); pragma Import (C, fl_widget_set_damage2, "fl_widget_set_damage2"); pragma Inline (fl_widget_set_damage2); procedure fl_widget_draw_label - (W : in System.Address; + (W : in Storage.Integer_Address; X, Y, D, H : in Interfaces.C.int; A : in Interfaces.C.unsigned); pragma Import (C, fl_widget_draw_label, "fl_widget_draw_label"); pragma Inline (fl_widget_draw_label); procedure fl_widget_redraw - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_redraw, "fl_widget_redraw"); pragma Inline (fl_widget_redraw); procedure fl_widget_redraw_label - (W : in System.Address); + (W : in Storage.Integer_Address); pragma Import (C, fl_widget_redraw_label, "fl_widget_redraw_label"); pragma Inline (fl_widget_redraw_label); @@ -465,32 +464,32 @@ package body FLTK.Widgets is procedure Callback_Hook - (W, U : in System.Address) + (W, U : in Storage.Integer_Address) is Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); + Widget_Convert.To_Pointer (Storage.To_Address (U)); begin Ada_Widget.Callback.all (Ada_Widget.all); end Callback_Hook; procedure Draw_Hook - (U : in System.Address) + (U : in Storage.Integer_Address) is Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); + Widget_Convert.To_Pointer (Storage.To_Address (U)); begin Ada_Widget.Draw; end Draw_Hook; function Handle_Hook - (U : in System.Address; + (U : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int is Ada_Widget : access Widget'Class := - Widget_Convert.To_Pointer (U); + Widget_Convert.To_Pointer (Storage.To_Address (U)); begin return Event_Outcome'Pos (Ada_Widget.Handle (Event_Kind'Val (E))); end Handle_Hook; @@ -501,11 +500,11 @@ package body FLTK.Widgets is procedure Finalize (This : in out Widget) is begin - if This.Void_Ptr /= System.Null_Address and then + if This.Void_Ptr /= Null_Pointer and then This in Widget'Class then free_fl_widget (This.Void_Ptr); - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end if; end Finalize; @@ -528,9 +527,9 @@ package body FLTK.Widgets is 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); - widget_set_handle_hook (This.Void_Ptr, Handle_Hook'Address); + Storage.To_Integer (Widget_Convert.To_Address (This'Unchecked_Access))); + widget_set_draw_hook (This.Void_Ptr, Storage.To_Integer (Draw_Hook'Address)); + widget_set_handle_hook (This.Void_Ptr, Storage.To_Integer (Handle_Hook'Address)); fl_widget_set_label (This.Void_Ptr, Interfaces.C.To_C (Text)); end return; end Create; @@ -726,12 +725,13 @@ package body FLTK.Widgets is (This : in Widget) return access FLTK.Widgets.Groups.Group'Class is - Parent_Ptr : System.Address; + Parent_Ptr : Storage.Integer_Address; Actual_Parent : access FLTK.Widgets.Groups.Group'Class; begin Parent_Ptr := fl_widget_get_parent (This.Void_Ptr); - if Parent_Ptr /= System.Null_Address then - Actual_Parent := Group_Convert.To_Pointer (fl_widget_get_user_data (Parent_Ptr)); + if Parent_Ptr /= Null_Pointer then + Actual_Parent := Group_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (Parent_Ptr))); end if; return Actual_Parent; end Parent; @@ -759,12 +759,13 @@ package body FLTK.Widgets is (This : in Widget) return access FLTK.Widgets.Groups.Windows.Window'Class is - Window_Ptr : System.Address; + Window_Ptr : Storage.Integer_Address; Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; begin Window_Ptr := fl_widget_window (This.Void_Ptr); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); + if Window_Ptr /= Null_Pointer then + Actual_Window := Window_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (Window_Ptr))); end if; return Actual_Window; end Nearest_Window; @@ -774,12 +775,13 @@ package body FLTK.Widgets is (This : in Widget) return access FLTK.Widgets.Groups.Windows.Window'Class is - Window_Ptr : System.Address; + Window_Ptr : Storage.Integer_Address; Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; begin Window_Ptr := fl_widget_top_window (This.Void_Ptr); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); + if Window_Ptr /= Null_Pointer then + Actual_Window := Window_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (Window_Ptr))); end if; return Actual_Window; end Top_Window; @@ -790,15 +792,16 @@ package body FLTK.Widgets is Offset_X, Offset_Y : out Integer) return access FLTK.Widgets.Groups.Windows.Window'Class is - Window_Ptr : System.Address; + Window_Ptr : Storage.Integer_Address; Actual_Window : access FLTK.Widgets.Groups.Windows.Window'Class; begin Window_Ptr := fl_widget_top_window_offset (This.Void_Ptr, Interfaces.C.int (Offset_X), Interfaces.C.int (Offset_Y)); - if Window_Ptr /= System.Null_Address then - Actual_Window := Window_Convert.To_Pointer (fl_widget_get_user_data (Window_Ptr)); + if Window_Ptr /= Null_Pointer then + Actual_Window := Window_Convert.To_Pointer + (Storage.To_Address (fl_widget_get_user_data (Window_Ptr))); end if; return Actual_Window; end Top_Window_Offset; @@ -976,7 +979,7 @@ package body FLTK.Widgets is begin if Func /= null then This.Callback := Func; - fl_widget_set_callback (This.Void_Ptr, Callback_Hook'Address); + fl_widget_set_callback (This.Void_Ptr, Storage.To_Integer (Callback_Hook'Address)); end if; end Set_Callback; diff --git a/src/fltk-widgets.ads b/src/fltk-widgets.ads index 5ac6f49..b4fa049 100644 --- a/src/fltk-widgets.ads +++ b/src/fltk-widgets.ads @@ -11,8 +11,8 @@ limited with private with System.Address_To_Access_Conversions, - Ada.Unchecked_Conversion, - Interfaces.C; + Interfaces.C, + FLTK.Widget_Callback_Conversions; package FLTK.Widgets is @@ -373,15 +373,15 @@ private -- the user data portion should always be a reference back to the Ada binding procedure Callback_Hook - (W, U : in System.Address); + (W, U : in Storage.Integer_Address); pragma Convention (C, Callback_Hook); procedure Draw_Hook - (U : in System.Address); + (U : in Storage.Integer_Address); pragma Convention (C, Draw_Hook); function Handle_Hook - (U : in System.Address; + (U : in Storage.Integer_Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Convention (C, Handle_Hook); @@ -390,22 +390,19 @@ private package Widget_Convert is new System.Address_To_Access_Conversions (Widget'Class); - package Callback_Convert is - function To_Pointer is new Ada.Unchecked_Conversion (System.Address, Widget_Callback); - function To_Address is new Ada.Unchecked_Conversion (Widget_Callback, System.Address); - end Callback_Convert; + package Callback_Convert renames FLTK.Widget_Callback_Conversions; function fl_widget_get_user_data - (W : in System.Address) - return System.Address; + (W : in Storage.Integer_Address) + return Storage.Integer_Address; pragma Import (C, fl_widget_get_user_data, "fl_widget_get_user_data"); pragma Inline (fl_widget_get_user_data); procedure fl_widget_set_user_data - (W, D : in System.Address); + (W, D : in Storage.Integer_Address); pragma Import (C, fl_widget_set_user_data, "fl_widget_set_user_data"); pragma Inline (fl_widget_set_user_data); @@ -413,7 +410,7 @@ private procedure fl_widget_set_label - (W : in System.Address; + (W : in Storage.Integer_Address; T : in Interfaces.C.char_array); pragma Import (C, fl_widget_set_label, "fl_widget_set_label"); pragma Inline (fl_widget_set_label); diff --git a/src/fltk.adb b/src/fltk.adb index 34366eb..4a4b70c 100644 --- a/src/fltk.adb +++ b/src/fltk.adb @@ -2,14 +2,12 @@ with - Interfaces.C, - System; + Interfaces.C; use type Interfaces.C.int, - Interfaces.C.unsigned_long, - System.Address; + Interfaces.C.unsigned_long; package body FLTK is @@ -85,14 +83,14 @@ package body FLTK is (Object : in Wrapper) return Boolean is begin - return Object.Void_Ptr /= System.Null_Address; + return Object.Void_Ptr /= Null_Pointer; end Is_Valid; procedure Initialize (This : in out Wrapper) is begin - This.Void_Ptr := System.Null_Address; + This.Void_Ptr := Null_Pointer; end Initialize; diff --git a/src/fltk.ads b/src/fltk.ads index 1bacd6e..8c8922c 100644 --- a/src/fltk.ads +++ b/src/fltk.ads @@ -7,7 +7,7 @@ with private with Interfaces.C, - System; + System.Storage_Elements; package FLTK is @@ -365,16 +365,34 @@ package FLTK is private + package Storage renames System.Storage_Elements; + use type Interfaces.C.size_t, Storage.Integer_Address; + + + Null_Pointer : constant Storage.Integer_Address := Storage.To_Integer (System.Null_Address); + + pragma Linker_Options ("-lfltk"); pragma Linker_Options ("-lfltk_images"); pragma Linker_Options ("-lfltk_gl"); + function c_pointer_size + return Interfaces.C.size_t; + pragma Import (C, c_pointer_size, "c_pointer_size"); + + -- If this fails then we are on an architecture that for whatever reason + -- has significant problems interfacing between C and Ada + pragma Assert + (c_pointer_size * Interfaces.C.CHAR_BIT = Storage.Integer_Address'Size, + "Size of C void pointers and size of Ada address values do not match"); + + type Wrapper is new Ada.Finalization.Limited_Controlled with record - Void_Ptr : System.Address; + Void_Ptr : Storage.Integer_Address; Needs_Dealloc : Boolean := True; end record; |