diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_fl_postscript_file_device.cpp | 125 | ||||
| -rw-r--r-- | src/c_fl_postscript_file_device.h | 47 | ||||
| -rw-r--r-- | src/fltk-devices-surface-paged-postscript.adb | 498 | ||||
| -rw-r--r-- | src/fltk-devices-surface-paged-postscript.ads | 214 | ||||
| -rw-r--r-- | src/fltk-devices-surface-paged-printers.ads | 1 |
5 files changed, 885 insertions, 0 deletions
diff --git a/src/c_fl_postscript_file_device.cpp b/src/c_fl_postscript_file_device.cpp new file mode 100644 index 0000000..22495dd --- /dev/null +++ b/src/c_fl_postscript_file_device.cpp @@ -0,0 +1,125 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#include <FL/Fl_PostScript.H> +#include "c_fl_postscript_file_device.h" + + + + +// Making available protected methods + +class My_PostScript_File_Device : Fl_PostScript_File_Device { +public: + using Fl_PostScript_File_Device::driver; +}; + + + + +// Flattened C API + +POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void) { + Fl_PostScript_File_Device *p = new Fl_PostScript_File_Device(); + return p; +} + +void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p) { + delete reinterpret_cast<Fl_PostScript_File_Device*>(p); +} + + + + +const char * fl_postscript_file_device_get_file_chooser_title() { + return Fl_PostScript_File_Device::file_chooser_title; +} + +void fl_postscript_file_device_set_file_chooser_title(const char * v) { + Fl_PostScript_File_Device::file_chooser_title = v; +} + + + + +void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p) { + return (reinterpret_cast<Fl_PostScript_File_Device*>(p)->*(&My_PostScript_File_Device::driver))(); +} + + + + +int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job(c, 0, 0); +} + +int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job(c, f, t); +} + +int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job + (reinterpret_cast<FILE*>(o), + c, + static_cast<Fl_Paged_Device::Page_Format>(f), + static_cast<Fl_Paged_Device::Page_Layout>(l)); +} + +int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_job + (c, + static_cast<Fl_Paged_Device::Page_Format>(f), + static_cast<Fl_Paged_Device::Page_Layout>(l)); +} + +void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->end_job(); +} + +int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->start_page(); +} + +int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->end_page(); +} + + + + +void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t, int * r, int * b) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->margins(l,t,r,b); +} + +int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h) { + return reinterpret_cast<Fl_PostScript_File_Device*>(p)->printable_rect(w,h); +} + +void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->origin(x,y); +} + +void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->origin(x,y); +} + +void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->rotate(r); +} + +void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->scale(x,y); +} + +void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->translate(x,y); +} + +void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p) { + reinterpret_cast<Fl_PostScript_File_Device*>(p)->untranslate(); +} + + diff --git a/src/c_fl_postscript_file_device.h b/src/c_fl_postscript_file_device.h new file mode 100644 index 0000000..f4d6d31 --- /dev/null +++ b/src/c_fl_postscript_file_device.h @@ -0,0 +1,47 @@ + + +// Programmed by Jedidiah Barber +// Released into the public domain + + +#ifndef FL_POSTSCRIPT_FILE_DEVICE_GUARD +#define FL_POSTSCRIPT_FILE_DEVICE_GUARD + + +typedef void* POSTSCRIPTFILEDEVICE; + + +extern "C" POSTSCRIPTFILEDEVICE new_fl_postscript_file_device(void); +extern "C" void free_fl_postscript_file_device(POSTSCRIPTFILEDEVICE p); + + +extern "C" const char * fl_postscript_file_device_get_file_chooser_title(); +extern "C" void fl_postscript_file_device_set_file_chooser_title(const char * v); + + +extern "C" void * fl_postscript_file_device_get_driver(POSTSCRIPTFILEDEVICE p); + + +extern "C" int fl_postscript_file_device_start_job(POSTSCRIPTFILEDEVICE p, int c); +extern "C" int fl_postscript_file_device_start_job2(POSTSCRIPTFILEDEVICE p, int c, int * f, int * t); +extern "C" int fl_postscript_file_device_start_job3(POSTSCRIPTFILEDEVICE p, void * o, int c, int f, int l); +extern "C" int fl_postscript_file_device_start_job4(POSTSCRIPTFILEDEVICE p, int c, int f, int l); +extern "C" void fl_postscript_file_device_end_job(POSTSCRIPTFILEDEVICE p); +extern "C" int fl_postscript_file_device_start_page(POSTSCRIPTFILEDEVICE p); +extern "C" int fl_postscript_file_device_end_page(POSTSCRIPTFILEDEVICE p); + + +extern "C" void fl_postscript_file_device_margins(POSTSCRIPTFILEDEVICE p, int * l, int * t, + int * r, int * b); +extern "C" int fl_postscript_file_device_printable_rect(POSTSCRIPTFILEDEVICE p, int * w, int * h); +extern "C" void fl_postscript_file_device_get_origin(POSTSCRIPTFILEDEVICE p, int * x, int * y); +extern "C" void fl_postscript_file_device_set_origin(POSTSCRIPTFILEDEVICE p, int x, int y); +extern "C" void fl_postscript_file_device_rotate(POSTSCRIPTFILEDEVICE p, float r); +extern "C" void fl_postscript_file_device_scale(POSTSCRIPTFILEDEVICE p, float x, float y); +extern "C" void fl_postscript_file_device_translate(POSTSCRIPTFILEDEVICE p, int x, int y); +extern "C" void fl_postscript_file_device_untranslate(POSTSCRIPTFILEDEVICE p); + + +#endif + + diff --git a/src/fltk-devices-surface-paged-postscript.adb b/src/fltk-devices-surface-paged-postscript.adb new file mode 100644 index 0000000..92653cb --- /dev/null +++ b/src/fltk-devices-surface-paged-postscript.adb @@ -0,0 +1,498 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + Interfaces.C.Strings; + +use type + + Interfaces.C.int; + + +package body FLTK.Devices.Surface.Paged.Postscript is + + + ------------------------ + -- Functions From C -- + ------------------------ + + function fopen + (Name, Mode : in Interfaces.C.char_array) + return Storage.Integer_Address; + pragma Import (C, fopen, "fopen"); + + function fclose + (Handle : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fclose, "fclose"); + + + + + function new_fl_postscript_file_device + return Storage.Integer_Address; + pragma Import (C, new_fl_postscript_file_device, "new_fl_postscript_file_device"); + pragma Inline (new_fl_postscript_file_device); + + procedure free_fl_postscript_file_device + (P : in Storage.Integer_Address); + pragma Import (C, free_fl_postscript_file_device, "free_fl_postscript_file_device"); + pragma Inline (free_fl_postscript_file_device); + + + + + 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, + "fl_postscript_file_device_get_file_chooser_title"); + pragma Inline (fl_postscript_file_device_get_file_chooser_title); + + procedure fl_postscript_file_device_set_file_chooser_title + (V : in Interfaces.C.Strings.chars_ptr); + pragma Import (C, fl_postscript_file_device_set_file_chooser_title, + "fl_postscript_file_device_set_file_chooser_title"); + pragma Inline (fl_postscript_file_device_set_file_chooser_title); + + + + + 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); + + + + + function fl_postscript_file_device_start_job + (D : in Storage.Integer_Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_start_job, "fl_postscript_file_device_start_job"); + pragma Inline (fl_postscript_file_device_start_job); + + function fl_postscript_file_device_start_job2 + (D : in Storage.Integer_Address; + C : in Interfaces.C.int; + F, T : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_start_job2, "fl_postscript_file_device_start_job2"); + pragma Inline (fl_postscript_file_device_start_job2); + + function fl_postscript_file_device_start_job3 + (D, O : in Storage.Integer_Address; + C, F, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_start_job3, "fl_postscript_file_device_start_job3"); + pragma Inline (fl_postscript_file_device_start_job3); + + function fl_postscript_file_device_start_job4 + (D : in Storage.Integer_Address; + C, F, L : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_start_job4, "fl_postscript_file_device_start_job4"); + pragma Inline (fl_postscript_file_device_start_job4); + + procedure fl_postscript_file_device_end_job + (D : in Storage.Integer_Address); + pragma Import (C, fl_postscript_file_device_end_job, "fl_postscript_file_device_end_job"); + pragma Inline (fl_postscript_file_device_end_job); + + function fl_postscript_file_device_start_page + (D : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_start_page, "fl_postscript_file_device_start_page"); + pragma Inline (fl_postscript_file_device_start_page); + + function fl_postscript_file_device_end_page + (D : in Storage.Integer_Address) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_end_page, "fl_postscript_file_device_end_page"); + pragma Inline (fl_postscript_file_device_end_page); + + + + + procedure fl_postscript_file_device_margins + (D : in Storage.Integer_Address; + L, T, R, B : out Interfaces.C.int); + pragma Import (C, fl_postscript_file_device_margins, "fl_postscript_file_device_margins"); + pragma Inline (fl_postscript_file_device_margins); + + function fl_postscript_file_device_printable_rect + (D : in Storage.Integer_Address; + W, H : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_postscript_file_device_printable_rect, + "fl_postscript_file_device_printable_rect"); + pragma Inline (fl_postscript_file_device_printable_rect); + + procedure fl_postscript_file_device_get_origin + (D : in Storage.Integer_Address; + X, Y : out Interfaces.C.int); + pragma Import (C, fl_postscript_file_device_get_origin, "fl_postscript_file_device_get_origin"); + pragma Inline (fl_postscript_file_device_get_origin); + + procedure fl_postscript_file_device_set_origin + (D : in Storage.Integer_Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_postscript_file_device_set_origin, "fl_postscript_file_device_set_origin"); + pragma Inline (fl_postscript_file_device_set_origin); + + procedure fl_postscript_file_device_rotate + (D : in Storage.Integer_Address; + R : in Interfaces.C.C_float); + pragma Import (C, fl_postscript_file_device_rotate, "fl_postscript_file_device_rotate"); + pragma Inline (fl_postscript_file_device_rotate); + + procedure fl_postscript_file_device_scale + (D : in Storage.Integer_Address; + X, Y : in Interfaces.C.C_float); + pragma Import (C, fl_postscript_file_device_scale, "fl_postscript_file_device_scale"); + pragma Inline (fl_postscript_file_device_scale); + + procedure fl_postscript_file_device_translate + (D : in Storage.Integer_Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_postscript_file_device_translate, "fl_postscript_file_device_translate"); + pragma Inline (fl_postscript_file_device_translate); + + procedure fl_postscript_file_device_untranslate + (D : in Storage.Integer_Address); + pragma Import (C, fl_postscript_file_device_untranslate, + "fl_postscript_file_device_untranslate"); + pragma Inline (fl_postscript_file_device_untranslate); + + + + + ----------------------------- + -- Auxiliary Subprograms -- + ----------------------------- + + procedure Open + (File : in out File_Type; + Name : in String) + is + Result : Storage.Integer_Address; + begin + File.Close; + Result := fopen + (Interfaces.C.To_C (Name), + Interfaces.C.To_C ("w")); + if Result = Null_Pointer then + raise File_Open_Error; + else + File.C_File := Result; + File.Open_State := True; + end if; + end Open; + + + function Is_Open + (File : in File_Type) + return Boolean is + begin + return File.Open_State; + end Is_Open; + + + procedure Close + (File : in out File_Type) + is + Result : Interfaces.C.int; + begin + if File.Is_Open then + Result := fclose (File.C_File); + if Result /= 0 then + raise File_Close_Error; + end if; + File.Open_State := False; + end if; + end Close; + + + + + ------------------- + -- Destructors -- + ------------------- + + procedure Finalize + (This : in out File_Type) is + begin + This.Close; + end Finalize; + + + procedure Finalize + (This : in out Postscript_File_Device) is + begin + if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then + free_fl_postscript_file_device (This.Void_Ptr); + This.Void_Ptr := Null_Pointer; + end if; + end Finalize; + + + procedure Finalize + (This : in out Postscript_File_Device_Final_Controller) is + begin + Interfaces.C.Strings.Free (File_Chooser_Title); + end Finalize; + + + + + -------------------- + -- Constructors -- + -------------------- + + package body Forge is + + function Create + return Postscript_File_Device is + begin + return This : Postscript_File_Device do + This.Void_Ptr := new_fl_postscript_file_device; + end return; + end Create; + + end Forge; + + + + + ------------------------- + -- Static Attributes -- + ------------------------- + + function Get_File_Chooser_Title + return String is + begin + return Interfaces.C.Strings.Value (fl_postscript_file_device_get_file_chooser_title); + end Get_File_Chooser_Title; + + + procedure Set_File_Chooser_Title + (Value : in String) is + begin + Interfaces.C.Strings.Free (File_Chooser_Title); + File_Chooser_Title := Interfaces.C.Strings.New_String (Value); + fl_postscript_file_device_set_file_chooser_title (File_Chooser_Title); + end Set_File_Chooser_Title; + + + + + ----------------------- + -- API Subprograms -- + ----------------------- + + function Get_Postscript_Driver + (This : in out Postscript_File_Device) + return FLTK.Devices.Graphics.Graphics_Driver_Reference is + begin + return raise Program_Error with "Get_Postscript_Driver unimplemented"; + end Get_Postscript_Driver; + + + + + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0) is + begin + if fl_postscript_file_device_start_job + (This.Void_Ptr, Interfaces.C.int (Count)) /= 0 + then + raise Page_Error; + end if; + end Start_Job; + + + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0; + From, To : out Positive) is + begin + if fl_postscript_file_device_start_job2 + (This.Void_Ptr, + Interfaces.C.int (Count), + Interfaces.C.int (From), + Interfaces.C.int (To)) /= 0 + then + raise Page_Error; + end if; + end Start_Job; + + + procedure Start_Job + (This : in out Postscript_File_Device; + Output : in File_Type'Class; + Count : in Natural := 0; + Format : in Page_Format := A4; + Layout : in Page_Layout := Portrait) + is + Code : Interfaces.C.int := fl_postscript_file_device_start_job3 + (This.Void_Ptr, + Output.C_File, + Interfaces.C.int (Count), + To_Cint (Format), + To_Cint (Layout)); + begin + if Code /= 0 then + raise Internal_FLTK_Error; + end if; + end Start_Job; + + + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0; + Format : in Page_Format := A4; + Layout : in Page_Layout := Portrait) + is + Code : Interfaces.C.int := fl_postscript_file_device_start_job4 + (This.Void_Ptr, + Interfaces.C.int (Count), + To_Cint (Format), + To_Cint (Layout)); + begin + case Code is + when 0 => null; + when 1 => raise User_Cancel_Error; + when 2 => raise File_Open_Error; + when others => raise Internal_FLTK_Error; + end case; + end Start_Job; + + + procedure End_Job + (This : in out Postscript_File_Device) is + begin + fl_postscript_file_device_end_job (This.Void_Ptr); + end End_Job; + + + procedure Start_Page + (This : in out Postscript_File_Device) is + begin + if fl_postscript_file_device_start_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end Start_Page; + + + procedure End_Page + (This : in out Postscript_File_Device) is + begin + if fl_postscript_file_device_end_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end End_Page; + + + + + procedure Get_Margins + (This : in Postscript_File_Device; + Left, Top, Right, Bottom : out Integer) is + begin + fl_postscript_file_device_margins + (This.Void_Ptr, + Interfaces.C.int (Left), + Interfaces.C.int (Top), + Interfaces.C.int (Right), + Interfaces.C.int (Bottom)); + end Get_Margins; + + + procedure Get_Printable_Rect + (This : in Postscript_File_Device; + W, H : out Integer) is + begin + if fl_postscript_file_device_printable_rect + (This.Void_Ptr, Interfaces.C.int (W), Interfaces.C.int (H)) /= 0 + then + raise Page_Error; + end if; + end Get_Printable_Rect; + + + procedure Get_Origin + (This : in Postscript_File_Device; + X, Y : out Integer) is + begin + fl_postscript_file_device_get_origin + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Get_Origin; + + + procedure Set_Origin + (This : in out Postscript_File_Device; + X, Y : in Integer) is + begin + fl_postscript_file_device_set_origin + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Set_Origin; + + + procedure Rotate + (This : in out Postscript_File_Device; + Degrees : in Float) is + begin + fl_postscript_file_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); + end Rotate; + + + procedure Scale + (This : in out Postscript_File_Device; + Factor : in Float) is + begin + fl_postscript_file_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); + end Scale; + + + procedure Scale + (This : in out Postscript_File_Device; + Factor_X, Factor_Y : in Float) is + begin + fl_postscript_file_device_scale + (This.Void_Ptr, + Interfaces.C.C_float (Factor_X), + Interfaces.C.C_float (Factor_Y)); + end Scale; + + + procedure Translate + (This : in out Postscript_File_Device; + Delta_X, Delta_Y : in Integer) is + begin + fl_postscript_file_device_translate + (This.Void_Ptr, + Interfaces.C.int (Delta_X), + Interfaces.C.int (Delta_Y)); + end Translate; + + + procedure Untranslate + (This : in out Postscript_File_Device) is + begin + fl_postscript_file_device_untranslate (This.Void_Ptr); + end Untranslate; + + +end FLTK.Devices.Surface.Paged.Postscript; + + diff --git a/src/fltk-devices-surface-paged-postscript.ads b/src/fltk-devices-surface-paged-postscript.ads new file mode 100644 index 0000000..a7ea51c --- /dev/null +++ b/src/fltk-devices-surface-paged-postscript.ads @@ -0,0 +1,214 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Devices.Graphics; + +private with + + Ada.Finalization, + Interfaces.C.Strings; + + +package FLTK.Devices.Surface.Paged.Postscript is + + + type Postscript_File_Device is new Paged_Device with private; + + type Postscript_File_Device_Reference (Data : not null access Postscript_File_Device'Class) is + limited null record with Implicit_Dereference => Data; + + + -- This will autoclose when it goes out of scope. + type File_Type is tagged limited private; + + -- Calling this on a file already open will close it then open the new name. + procedure Open + (File : in out File_Type; + Name : in String); + + function Is_Open + (File : in File_Type) + return Boolean; + + -- Calling this on a file already closed will have no effect. + procedure Close + (File : in out File_Type); + + + File_Open_Error : exception; + + File_Close_Error : exception; + + User_Cancel_Error : exception; + + + + + -- The initial Graphics_Driver this is supposed to have upon construction + -- is not currently implemented properly. Please wait warmly until the + -- binding for the Graphics sub-hierarchy is done. + + + + + package Forge is + + function Create + return Postscript_File_Device; + + end Forge; + + + + + function Get_File_Chooser_Title + return String; + + procedure Set_File_Chooser_Title + (Value : in String); + + + + + -- Not currently implemented, + -- will return a Postscript_Graphics_Driver when done. + function Get_Postscript_Driver + (This : in out Postscript_File_Device) + return FLTK.Devices.Graphics.Graphics_Driver_Reference; + + + + + -- Docs say don't use this version. + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0); + + -- Docs say don't use this version. + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0; + From, To : out Positive); + + procedure Start_Job + (This : in out Postscript_File_Device; + Output : in File_Type'Class; + Count : in Natural := 0; + Format : in Page_Format := A4; + Layout : in Page_Layout := Portrait) + with Pre => Output.Is_Open; + + procedure Start_Job + (This : in out Postscript_File_Device; + Count : in Natural := 0; + Format : in Page_Format := A4; + Layout : in Page_Layout := Portrait); + + procedure End_Job + (This : in out Postscript_File_Device); + + procedure Start_Page + (This : in out Postscript_File_Device); + + procedure End_Page + (This : in out Postscript_File_Device); + + + + + procedure Get_Margins + (This : in Postscript_File_Device; + Left, Top, Right, Bottom : out Integer); + + procedure Get_Printable_Rect + (This : in Postscript_File_Device; + W, H : out Integer); + + procedure Get_Origin + (This : in Postscript_File_Device; + X, Y : out Integer); + + procedure Set_Origin + (This : in out Postscript_File_Device; + X, Y : in Integer); + + procedure Rotate + (This : in out Postscript_File_Device; + Degrees : in Float); + + procedure Scale + (This : in out Postscript_File_Device; + Factor : in Float); + + procedure Scale + (This : in out Postscript_File_Device; + Factor_X, Factor_Y : in Float); + + procedure Translate + (This : in out Postscript_File_Device; + Delta_X, Delta_Y : in Integer); + + procedure Untranslate + (This : in out Postscript_File_Device); + + +private + + + type File_Type is new Ada.Finalization.Limited_Controlled with record + C_File : Storage.Integer_Address; + Open_State : Boolean := False; + end record; + + overriding procedure Finalize + (This : in out File_Type); + + + type Postscript_File_Device is new Paged_Device with null record; + + overriding procedure Finalize + (This : in out Postscript_File_Device); + + + File_Chooser_Title : Interfaces.C.Strings.chars_ptr; + + + pragma Inline (Is_Open); + + pragma Inline (Get_File_Chooser_Title); + + pragma Inline (Get_Postscript_Driver); + + pragma Inline (Start_Job); + pragma Inline (End_Job); + pragma Inline (Start_Page); + pragma Inline (End_Page); + + pragma Inline (Get_Margins); + pragma Inline (Get_Printable_Rect); + pragma Inline (Get_Origin); + pragma Inline (Set_Origin); + pragma Inline (Rotate); + pragma Inline (Scale); + pragma Inline (Translate); + pragma Inline (Untranslate); + + + -- Needed to ensure chars_ptr storage is properly cleaned up + type Postscript_File_Device_Final_Controller is new Ada.Finalization.Limited_Controlled + with null record; + + overriding procedure Finalize + (This : in out Postscript_File_Device_Final_Controller); + + Cleanup : Postscript_File_Device_Final_Controller; + + +end FLTK.Devices.Surface.Paged.Postscript; + + diff --git a/src/fltk-devices-surface-paged-printers.ads b/src/fltk-devices-surface-paged-printers.ads index b4beb82..c0bc34e 100644 --- a/src/fltk-devices-surface-paged-printers.ads +++ b/src/fltk-devices-surface-paged-printers.ads @@ -159,6 +159,7 @@ package FLTK.Devices.Surface.Paged.Printers is + -- Not currently implemented function Get_Original_Driver (This : in out Printer) return FLTK.Devices.Graphics.Graphics_Driver_Reference; |