diff options
Diffstat (limited to 'body/fltk-devices-surface-paged-postscript.adb')
| -rw-r--r-- | body/fltk-devices-surface-paged-postscript.adb | 43 |
1 files changed, 33 insertions, 10 deletions
diff --git a/body/fltk-devices-surface-paged-postscript.adb b/body/fltk-devices-surface-paged-postscript.adb index fa9f66d..07284bb 100644 --- a/body/fltk-devices-surface-paged-postscript.adb +++ b/body/fltk-devices-surface-paged-postscript.adb @@ -7,7 +7,7 @@ with Ada.Assertions, - Interfaces.C.Strings; + Interfaces.C; use type @@ -26,6 +26,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is -- Functions From C -- ------------------------ + -- Files -- + function fopen (Name, Mode : in Interfaces.C.char_array) return Storage.Integer_Address; @@ -39,6 +41,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is + -- Allocation -- + function new_fl_postscript_file_device return Storage.Integer_Address; pragma Import (C, new_fl_postscript_file_device, "new_fl_postscript_file_device"); @@ -52,6 +56,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is + -- Static Attributes -- + function fl_postscript_file_device_get_file_chooser_title return Interfaces.C.Strings.chars_ptr; pragma Import (C, fl_postscript_file_device_get_file_chooser_title, @@ -67,15 +73,20 @@ package body FLTK.Devices.Surface.Paged.Postscript is - function fl_postscript_file_device_get_driver - (D : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_postscript_file_device_get_driver, "fl_postscript_file_device_get_driver"); - pragma Inline (fl_postscript_file_device_get_driver); + -- Driver -- + -- function fl_postscript_file_device_get_driver + -- (D : in Storage.Integer_Address) + -- return Storage.Integer_Address; + -- pragma Import (C, fl_postscript_file_device_get_driver, + -- "fl_postscript_file_device_get_driver"); + -- pragma Inline (fl_postscript_file_device_get_driver); + + -- Job Control -- + function fl_postscript_file_device_start_job (D : in Storage.Integer_Address; C : in Interfaces.C.int) @@ -125,6 +136,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is + -- Spacing and Orientation -- + procedure fl_postscript_file_device_margins (D : in Storage.Integer_Address; L, T, R, B : out Interfaces.C.int); @@ -301,6 +314,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is -- API Subprograms -- ----------------------- + -- Driver -- + function Get_Postscript_Driver (This : in out Postscript_File_Device) return FLTK.Devices.Graphics.Graphics_Driver_Reference is @@ -311,6 +326,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is + -- Job Control -- + procedure Start_Job (This : in out Postscript_File_Device; Count : in Natural := 0) is @@ -346,7 +363,7 @@ package body FLTK.Devices.Surface.Paged.Postscript is Format : in Page_Format := A4; Layout : in Page_Layout := Portrait) is - Code : Interfaces.C.int := fl_postscript_file_device_start_job3 + Code : constant Interfaces.C.int := fl_postscript_file_device_start_job3 (This.Void_Ptr, Output.C_File, Interfaces.C.int (Count), @@ -355,7 +372,9 @@ package body FLTK.Devices.Surface.Paged.Postscript is begin pragma Assert (Code = 0); exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_PostScript_File_Device::start_job returned unexpected int value of " & + Interfaces.C.int'Image (Code); end Start_Job; @@ -365,7 +384,7 @@ package body FLTK.Devices.Surface.Paged.Postscript is Format : in Page_Format := A4; Layout : in Page_Layout := Portrait) is - Code : Interfaces.C.int := fl_postscript_file_device_start_job4 + Code : constant Interfaces.C.int := fl_postscript_file_device_start_job4 (This.Void_Ptr, Interfaces.C.int (Count), To_Cint (Format), @@ -377,7 +396,9 @@ package body FLTK.Devices.Surface.Paged.Postscript is when others => pragma Assert (Code = 0); end case; exception - when Chk.Assertion_Error => raise Internal_FLTK_Error; + when Chk.Assertion_Error => raise Internal_FLTK_Error with + "Fl_PostScript_File_Device::start_job returned unexpected int value of " & + Interfaces.C.int'Image (Code); end Start_Job; @@ -408,6 +429,8 @@ package body FLTK.Devices.Surface.Paged.Postscript is + -- Spacing and Orientation -- + procedure Get_Margins (This : in Postscript_File_Device; Left, Top, Right, Bottom : out Integer) is |