From b81d4e31bc54ad83527eef800db6706ce967d5e1 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 26 Mar 2018 23:36:28 +1100 Subject: Added FLTK.Devices.Surfaces.Paged.Printers --- progress.txt | 2 +- src/c_fl_printer.cpp | 96 ++++++++ src/c_fl_printer.h | 45 ++++ src/fltk-devices-surfaces-paged-printers.adb | 346 +++++++++++++++++++++++++++ src/fltk-devices-surfaces-paged-printers.ads | 113 +++++++++ src/fltk-devices-surfaces.adb | 2 +- src/fltk-devices-surfaces.ads | 2 +- 7 files changed, 603 insertions(+), 3 deletions(-) create mode 100644 src/c_fl_printer.cpp create mode 100644 src/c_fl_printer.h create mode 100644 src/fltk-devices-surfaces-paged-printers.adb create mode 100644 src/fltk-devices-surfaces-paged-printers.ads diff --git a/progress.txt b/progress.txt index a865c9d..1e41e91 100644 --- a/progress.txt +++ b/progress.txt @@ -19,6 +19,7 @@ Done: FLTK.Devices FLTK.Devices.Surfaces.Paged +FLTK.Devices.Surfaces.Paged.Printers FLTK.Dialogs FLTK.Images FLTK.Images.Bitmaps @@ -123,7 +124,6 @@ FL_Table_Row FL_Tree FL_Copy_Surface FL_Image_Surface -FL_Printer FL_Tooltip FL_Preferences FL_Label diff --git a/src/c_fl_printer.cpp b/src/c_fl_printer.cpp new file mode 100644 index 0000000..614012b --- /dev/null +++ b/src/c_fl_printer.cpp @@ -0,0 +1,96 @@ + + +#include +#include +#include +#include "c_fl_printer.h" + + + + +PRINTER new_fl_printer(void) { + Fl_Printer *p = new Fl_Printer(); + return p; +} + +void free_fl_printer(PRINTER p) { + delete reinterpret_cast(p); +} + + + + +int fl_printer_start_job(PRINTER p, int c) { + return reinterpret_cast(p)->start_job(c,0,0); +} + +int fl_printer_start_job2(PRINTER p, int c, int f, int t) { + return reinterpret_cast(p)->start_job(c,&f,&t); +} + +void fl_printer_end_job(PRINTER p) { + reinterpret_cast(p)->end_job(); +} + +int fl_printer_start_page(PRINTER p) { + return reinterpret_cast(p)->start_page(); +} + +int fl_printer_end_page(PRINTER p) { + return reinterpret_cast(p)->end_page(); +} + + + + +void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b) { + reinterpret_cast(p)->margins(l,t,r,b); +} + +int fl_printer_printable_rect(PRINTER p, int * w, int * h) { + return reinterpret_cast(p)->printable_rect(w,h); +} + +void fl_printer_get_origin(PRINTER p, int * x, int * y) { + reinterpret_cast(p)->origin(x,y); +} + +void fl_printer_set_origin(PRINTER p, int x, int y) { + reinterpret_cast(p)->origin(x,y); +} + +void fl_printer_rotate(PRINTER p, float r) { + reinterpret_cast(p)->rotate(r); +} + +void fl_printer_scale(PRINTER p, float x, float y) { + reinterpret_cast(p)->scale(x,y); +} + +void fl_printer_translate(PRINTER p, int x, int y) { + reinterpret_cast(p)->translate(x,y); +} + +void fl_printer_untranslate(PRINTER p) { + reinterpret_cast(p)->untranslate(); +} + + + + +void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy) { + reinterpret_cast(p)->print_widget(reinterpret_cast(i),dx,dy); +} + +void fl_printer_print_window_part(PRINTER p, void * i, int x, int y, int w, int h, int dx, int dy) { + reinterpret_cast(p)->print_window_part(reinterpret_cast(i),x,y,w,h,dx,dy); +} + + + + +void fl_printer_set_current(PRINTER p) { + reinterpret_cast(p)->set_current(); +} + + diff --git a/src/c_fl_printer.h b/src/c_fl_printer.h new file mode 100644 index 0000000..0ae2499 --- /dev/null +++ b/src/c_fl_printer.h @@ -0,0 +1,45 @@ + + +#ifndef FL_PRINTER_GUARD +#define FL_PRINTER_GUARD + + + + +typedef void* PRINTER; + + + + +extern "C" PRINTER new_fl_printer(void); +extern "C" void free_fl_printer(PRINTER p); + + + + +extern "C" int fl_printer_start_job(PRINTER p, int c); +extern "C" int fl_printer_start_job2(PRINTER p, int c, int f, int t); +extern "C" void fl_printer_end_job(PRINTER p); +extern "C" int fl_printer_start_page(PRINTER p); +extern "C" int fl_printer_end_page(PRINTER p); + + +extern "C" void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b); +extern "C" int fl_printer_printable_rect(PRINTER p, int * w, int * h); +extern "C" void fl_printer_get_origin(PRINTER p, int * x, int * y); +extern "C" void fl_printer_set_origin(PRINTER p, int x, int y); +extern "C" void fl_printer_rotate(PRINTER p, float r); +extern "C" void fl_printer_scale(PRINTER p, float x, float y); +extern "C" void fl_printer_translate(PRINTER p, int x, int y); +extern "C" void fl_printer_untranslate(PRINTER p); + + +extern "C" void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy); +extern "C" void fl_printer_print_window_part(PRINTER p, void * i, int x, int y, int w, int h, int dx, int dy); + + +extern "C" void fl_printer_set_current(PRINTER p); + + +#endif + diff --git a/src/fltk-devices-surfaces-paged-printers.adb b/src/fltk-devices-surfaces-paged-printers.adb new file mode 100644 index 0000000..6114cae --- /dev/null +++ b/src/fltk-devices-surfaces-paged-printers.adb @@ -0,0 +1,346 @@ + + +with + + Interfaces.C, + System; + +use type + + Interfaces.C.int, + System.Address; + + +package body FLTK.Devices.Surfaces.Paged.Printers is + + + function new_fl_printer + return System.Address; + pragma Import (C, new_fl_printer, "new_fl_printer"); + + procedure free_fl_printer + (D : in System.Address); + pragma Import (C, free_fl_printer, "free_fl_printer"); + + + + + function fl_printer_start_job + (D : in System.Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_printer_start_job, "fl_printer_start_job"); + + function fl_printer_start_job2 + (D : in System.Address; + C, F, T : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_printer_start_job2, "fl_printer_start_job2"); + + procedure fl_printer_end_job + (D : in System.Address); + pragma Import (C, fl_printer_end_job, "fl_printer_end_job"); + + function fl_printer_start_page + (D : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_printer_start_page, "fl_printer_start_page"); + + function fl_printer_end_page + (D : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_printer_end_page, "fl_printer_end_page"); + + + + + procedure fl_printer_margins + (D : in System.Address; + L, T, R, B : out Interfaces.C.int); + pragma Import (C, fl_printer_margins, "fl_printer_margins"); + + function fl_printer_printable_rect + (D : in System.Address; + W, H : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_printer_printable_rect, "fl_printer_printable_rect"); + + procedure fl_printer_get_origin + (D : in System.Address; + X, Y : out Interfaces.C.int); + pragma Import (C, fl_printer_get_origin, "fl_printer_get_origin"); + + procedure fl_printer_set_origin + (D : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_printer_set_origin, "fl_printer_set_origin"); + + procedure fl_printer_rotate + (D : in System.Address; + R : in Interfaces.C.C_float); + pragma Import (C, fl_printer_rotate, "fl_printer_rotate"); + + procedure fl_printer_scale + (D : in System.Address; + X, Y : in Interfaces.C.C_float); + pragma Import (C, fl_printer_scale, "fl_printer_scale"); + + procedure fl_printer_translate + (D : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_printer_translate, "fl_printer_translate"); + + procedure fl_printer_untranslate + (D : in System.Address); + pragma Import (C, fl_printer_untranslate, "fl_printer_untranslate"); + + + + + procedure fl_printer_print_widget + (D, I : in System.Address; + DX, DY : in Interfaces.C.int); + pragma Import (C, fl_printer_print_widget, "fl_printer_print_widget"); + + procedure fl_printer_print_window_part + (D, I : in System.Address; + X, Y, W, H, DX, DY : in Interfaces.C.int); + pragma Import (C, fl_printer_print_window_part, "fl_printer_print_window_part"); + + + + + procedure fl_printer_set_current + (D : in System.Address); + pragma Import (C, fl_printer_set_current, "fl_printer_set_current"); + + + + + procedure Finalize + (This : in out Printer) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Printer'Class + then + free_fl_printer (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Paged_Surface (This)); + end Finalize; + + + + + package body Forge is + + function Create + return Printer is + begin + return This : Printer do + This.Void_Ptr := new_fl_printer; + end return; + end Create; + + end Forge; + + + + + procedure Start_Job + (This : in out Printer; + Count : in Natural) is + begin + if fl_printer_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 Printer; + Count : in Natural; + From, To : in Positive) is + begin + if fl_printer_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 End_Job + (This : in out Printer) is + begin + fl_printer_end_job (This.Void_Ptr); + end End_Job; + + + procedure Start_Page + (This : in out Printer) is + begin + if fl_printer_start_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end Start_Page; + + + procedure End_Page + (This : in out Printer) is + begin + if fl_printer_end_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end End_Page; + + + + + procedure Get_Margins + (This : in Printer; + Left, Top, Right, Bottom : out Integer) + is + L, T, R, B : Interfaces.C.int; + begin + fl_printer_margins (This.Void_Ptr, L, T, R, B); + Left := Integer (L); + Top := Integer (T); + Right := Integer (R); + Bottom := Integer (B); + end Get_Margins; + + + procedure Get_Printable_Rect + (This : in Printer; + W, H : out Integer) + is + Wid, Hei : Interfaces.C.int; + begin + if fl_printer_printable_rect (This.Void_Ptr, Wid, Hei) /= 0 then + raise Page_Error; + else + W := Integer (Wid); + H := Integer (Hei); + end if; + end Get_Printable_Rect; + + + procedure Get_Origin + (This : in Printer; + X, Y : out Integer) + is + Eks, Why : Interfaces.C.int; + begin + fl_printer_get_origin (This.Void_Ptr, Eks, Why); + X := Integer (Eks); + Y := Integer (Why); + end Get_Origin; + + + procedure Set_Origin + (This : in out Printer; + X, Y : in Integer) is + begin + fl_printer_set_origin + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Set_Origin; + + + procedure Rotate + (This : in out Printer; + Degrees : in Float) is + begin + fl_printer_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); + end Rotate; + + + procedure Scale + (This : in out Printer; + Factor : in Float) is + begin + fl_printer_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); + end Scale; + + + procedure Scale + (This : in out Printer; + Factor_X, Factor_Y : in Float) is + begin + fl_printer_scale + (This.Void_Ptr, + Interfaces.C.C_float (Factor_X), + Interfaces.C.C_float (Factor_Y)); + end Scale; + + + procedure Translate + (This : in out Printer; + Delta_X, Delta_Y : in Integer) is + begin + fl_printer_translate + (This.Void_Ptr, + Interfaces.C.int (Delta_X), + Interfaces.C.int (Delta_Y)); + end Translate; + + + procedure Untranslate + (This : in out Printer) is + begin + fl_printer_untranslate (This.Void_Ptr); + end Untranslate; + + + + + procedure Print_Widget + (This : in out Printer; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_printer_print_widget + (This.Void_Ptr, + Wrapper (Item).Void_Ptr, + Interfaces.C.int (Offset_X), + Interfaces.C.int (Offset_Y)); + end Print_Widget; + + + procedure Print_Window_Part + (This : in out Printer; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + X, Y, W, H : in Integer; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_printer_print_window_part + (This.Void_Ptr, + Wrapper (Item).Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H), + Interfaces.C.int (Offset_X), + Interfaces.C.int (Offset_Y)); + end Print_Window_Part; + + + + + procedure Set_Current + (This : in out Printer) is + begin + fl_printer_set_current (This.Void_Ptr); + Current_Ptr := This'Unchecked_Access; + end Set_Current; + + +end FLTK.Devices.Surfaces.Paged.Printers; + diff --git a/src/fltk-devices-surfaces-paged-printers.ads b/src/fltk-devices-surfaces-paged-printers.ads new file mode 100644 index 0000000..7eae340 --- /dev/null +++ b/src/fltk-devices-surfaces-paged-printers.ads @@ -0,0 +1,113 @@ + + +with + + FLTK.Widgets.Groups.Windows; + + +package FLTK.Devices.Surfaces.Paged.Printers is + + + type Printer is new Paged_Surface with private; + + + + + package Forge is + + function Create + return Printer; + + end Forge; + + + + + procedure Start_Job + (This : in out Printer; + Count : in Natural); + + procedure Start_Job + (This : in out Printer; + Count : in Natural; + From, To : in Positive); + + procedure End_Job + (This : in out Printer); + + procedure Start_Page + (This : in out Printer); + + procedure End_Page + (This : in out Printer); + + + + + procedure Get_Margins + (This : in Printer; + Left, Top, Right, Bottom : out Integer); + + procedure Get_Printable_Rect + (This : in Printer; + W, H : out Integer); + + procedure Get_Origin + (This : in Printer; + X, Y : out Integer); + + procedure Set_Origin + (This : in out Printer; + X, Y : in Integer); + + procedure Rotate + (This : in out Printer; + Degrees : in Float); + + procedure Scale + (This : in out Printer; + Factor : in Float); + + procedure Scale + (This : in out Printer; + Factor_X, Factor_Y : in Float); + + procedure Translate + (This : in out Printer; + Delta_X, Delta_Y : in Integer); + + procedure Untranslate + (This : in out Printer); + + + + + procedure Print_Widget + (This : in out Printer; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0); + + procedure Print_Window_Part + (This : in out Printer; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + X, Y, W, H : in Integer; + Offset_X, Offset_Y : in Integer := 0); + + + + + procedure Set_Current + (This : in out Printer); + + +private + + + type Printer is new Paged_Surface with null record; + + overriding procedure Finalize + (This : in out Printer); + + +end FLTK.Devices.Surfaces.Paged.Printers; + diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb index d32adda..7b95bec 100644 --- a/src/fltk-devices-surfaces.adb +++ b/src/fltk-devices-surfaces.adb @@ -76,7 +76,7 @@ package body FLTK.Devices.Surfaces is procedure Set_Current - (This : in out Surface_Device'Class) is + (This : in out Surface_Device) is begin fl_surface_set_current (This.Void_Ptr); Current_Ptr := This'Unchecked_Access; diff --git a/src/fltk-devices-surfaces.ads b/src/fltk-devices-surfaces.ads index 9c453e1..418903e 100644 --- a/src/fltk-devices-surfaces.ads +++ b/src/fltk-devices-surfaces.ads @@ -28,7 +28,7 @@ package FLTK.Devices.Surfaces is return access Surface_Device'Class; procedure Set_Current - (This : in out Surface_Device'Class); + (This : in out Surface_Device); private -- cgit