From 7c8cb6a77c65c14421abaa8882e153e90e725166 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 25 Mar 2018 00:28:55 +1100 Subject: Added FLTK.Devices.Surfaces.Paged --- progress.txt | 2 +- src/c_fl_paged_device.cpp | 102 +++++++++++ src/c_fl_paged_device.h | 43 +++++ src/fltk-devices-surfaces-paged.adb | 347 ++++++++++++++++++++++++++++++++++++ src/fltk-devices-surfaces-paged.ads | 126 +++++++++++++ src/fltk-devices-surfaces.adb | 4 +- src/fltk-devices-surfaces.ads | 6 +- 7 files changed, 624 insertions(+), 6 deletions(-) create mode 100644 src/c_fl_paged_device.cpp create mode 100644 src/c_fl_paged_device.h create mode 100644 src/fltk-devices-surfaces-paged.adb create mode 100644 src/fltk-devices-surfaces-paged.ads diff --git a/progress.txt b/progress.txt index 69411a0..a865c9d 100644 --- a/progress.txt +++ b/progress.txt @@ -18,6 +18,7 @@ Polished: Done: FLTK.Devices +FLTK.Devices.Surfaces.Paged FLTK.Dialogs FLTK.Images FLTK.Images.Bitmaps @@ -122,7 +123,6 @@ FL_Table_Row FL_Tree FL_Copy_Surface FL_Image_Surface -FL_Paged_Device FL_Printer FL_Tooltip FL_Preferences diff --git a/src/c_fl_paged_device.cpp b/src/c_fl_paged_device.cpp new file mode 100644 index 0000000..6c56c75 --- /dev/null +++ b/src/c_fl_paged_device.cpp @@ -0,0 +1,102 @@ + + +#include +#include +#include +#include "c_fl_paged_device.h" + + + + +class My_Paged_Device : public Fl_Paged_Device { + public: + using Fl_Paged_Device::Fl_Paged_Device; + friend PAGED_DEVICE new_fl_paged_device(void); +}; + + + + +PAGED_DEVICE new_fl_paged_device(void) { + My_Paged_Device *p = new My_Paged_Device(); + return p; +} + +void free_fl_paged_device(PAGED_DEVICE p) { + delete reinterpret_cast(p); +} + + + + +int fl_paged_device_start_job(PAGED_DEVICE p, int c) { + return reinterpret_cast(p)->start_job(c,0,0); +} + +int fl_paged_device_start_job2(PAGED_DEVICE p, int c, int f, int t) { + return reinterpret_cast(p)->start_job(c,&f,&t); +} + +void fl_paged_device_end_job(PAGED_DEVICE p) { + reinterpret_cast(p)->end_job(); +} + +int fl_paged_device_start_page(PAGED_DEVICE p) { + return reinterpret_cast(p)->start_page(); +} + +int fl_paged_device_end_page(PAGED_DEVICE p) { + return reinterpret_cast(p)->end_page(); +} + + + + +void fl_paged_device_margins(PAGED_DEVICE p, int * l, int * t, int * r, int * b) { + reinterpret_cast(p)->margins(l,t,r,b); +} + +int fl_paged_device_printable_rect(PAGED_DEVICE p, int * w, int * h) { + return reinterpret_cast(p)->printable_rect(w,h); +} + +void fl_paged_device_get_origin(PAGED_DEVICE p, int * x, int * y) { + reinterpret_cast(p)->origin(x,y); +} + +void fl_paged_device_set_origin(PAGED_DEVICE p, int x, int y) { + reinterpret_cast(p)->origin(x,y); +} + +void fl_paged_device_rotate(PAGED_DEVICE p, float r) { + reinterpret_cast(p)->rotate(r); +} + +void fl_paged_device_scale(PAGED_DEVICE p, float x, float y) { + reinterpret_cast(p)->scale(x,y); +} + +void fl_paged_device_translate(PAGED_DEVICE p, int x, int y) { + reinterpret_cast(p)->translate(x,y); +} + +void fl_paged_device_untranslate(PAGED_DEVICE p) { + reinterpret_cast(p)->untranslate(); +} + + + + +void fl_paged_device_print_widget(PAGED_DEVICE p, void * i, int dx, int dy) { + reinterpret_cast(p)->print_widget(reinterpret_cast(i),dx,dy); +} + +void fl_paged_device_print_window(PAGED_DEVICE p, void * i, int dx, int dy) { + reinterpret_cast(p)->print_window(reinterpret_cast(i),dx,dy); +} + +void fl_paged_device_print_window_part(PAGED_DEVICE 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); +} + + diff --git a/src/c_fl_paged_device.h b/src/c_fl_paged_device.h new file mode 100644 index 0000000..0d4a7f1 --- /dev/null +++ b/src/c_fl_paged_device.h @@ -0,0 +1,43 @@ + + +#ifndef FL_PAGED_DEVICE_GUARD +#define FL_PAGED_DEVICE_GUARD + + + + +typedef void* PAGED_DEVICE; + + + + +extern "C" PAGED_DEVICE new_fl_paged_device(void); +extern "C" void free_fl_paged_device(PAGED_DEVICE p); + + + + +extern "C" int fl_paged_device_start_job(PAGED_DEVICE p, int c); +extern "C" int fl_paged_device_start_job2(PAGED_DEVICE p, int c, int f, int t); +extern "C" void fl_paged_device_end_job(PAGED_DEVICE p); +extern "C" int fl_paged_device_start_page(PAGED_DEVICE p); +extern "C" int fl_paged_device_end_page(PAGED_DEVICE p); + + +extern "C" void fl_paged_device_margins(PAGED_DEVICE p, int * l, int * t, int * r, int * b); +extern "C" int fl_paged_device_printable_rect(PAGED_DEVICE p, int * w, int * h); +extern "C" void fl_paged_device_get_origin(PAGED_DEVICE p, int * x, int * y); +extern "C" void fl_paged_device_set_origin(PAGED_DEVICE p, int x, int y); +extern "C" void fl_paged_device_rotate(PAGED_DEVICE p, float r); +extern "C" void fl_paged_device_scale(PAGED_DEVICE p, float x, float y); +extern "C" void fl_paged_device_translate(PAGED_DEVICE p, int x, int y); +extern "C" void fl_paged_device_untranslate(PAGED_DEVICE p); + + +extern "C" void fl_paged_device_print_widget(PAGED_DEVICE p, void * i, int dx, int dy); +extern "C" void fl_paged_device_print_window(PAGED_DEVICE p, void * i, int dx, int dy); +extern "C" void fl_paged_device_print_window_part(PAGED_DEVICE p, void * i, int x, int y, int w, int h, int dx, int dy); + + +#endif + diff --git a/src/fltk-devices-surfaces-paged.adb b/src/fltk-devices-surfaces-paged.adb new file mode 100644 index 0000000..f21dd3c --- /dev/null +++ b/src/fltk-devices-surfaces-paged.adb @@ -0,0 +1,347 @@ + + +with + + Interfaces.C, + System; + +use type + + Interfaces.C.int, + System.Address; + + +package body FLTK.Devices.Surfaces.Paged is + + + function new_fl_paged_device + return System.Address; + pragma Import (C, new_fl_paged_device, "new_fl_paged_device"); + + procedure free_fl_paged_device + (D : in System.Address); + pragma Import (C, free_fl_paged_device, "free_fl_paged_device"); + + + + + function fl_paged_device_start_job + (D : in System.Address; + C : in Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_paged_device_start_job, "fl_paged_device_start_job"); + + function fl_paged_device_start_job2 + (D : in System.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"); + + procedure fl_paged_device_end_job + (D : in System.Address); + pragma Import (C, fl_paged_device_end_job, "fl_paged_device_end_job"); + + function fl_paged_device_start_page + (D : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_paged_device_start_page, "fl_paged_device_start_page"); + + function fl_paged_device_end_page + (D : in System.Address) + return Interfaces.C.int; + pragma Import (C, fl_paged_device_end_page, "fl_paged_device_end_page"); + + + + + procedure fl_paged_device_margins + (D : in System.Address; + L, T, R, B : out Interfaces.C.int); + pragma Import (C, fl_paged_device_margins, "fl_paged_device_margins"); + + function fl_paged_device_printable_rect + (D : in System.Address; + W, H : out Interfaces.C.int) + return Interfaces.C.int; + pragma Import (C, fl_paged_device_printable_rect, "fl_paged_device_printable_rect"); + + procedure fl_paged_device_get_origin + (D : in System.Address; + X, Y : out Interfaces.C.int); + pragma Import (C, fl_paged_device_get_origin, "fl_paged_device_get_origin"); + + procedure fl_paged_device_set_origin + (D : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_paged_device_set_origin, "fl_paged_device_set_origin"); + + procedure fl_paged_device_rotate + (D : in System.Address; + R : in Interfaces.C.C_float); + pragma Import (C, fl_paged_device_rotate, "fl_paged_device_rotate"); + + procedure fl_paged_device_scale + (D : in System.Address; + X, Y : in Interfaces.C.C_float); + pragma Import (C, fl_paged_device_scale, "fl_paged_device_scale"); + + procedure fl_paged_device_translate + (D : in System.Address; + X, Y : in Interfaces.C.int); + pragma Import (C, fl_paged_device_translate, "fl_paged_device_translate"); + + procedure fl_paged_device_untranslate + (D : in System.Address); + pragma Import (C, fl_paged_device_untranslate, "fl_paged_device_untranslate"); + + + + + procedure fl_paged_device_print_widget + (D, I : in System.Address; + DX, DY : in Interfaces.C.int); + pragma Import (C, fl_paged_device_print_widget, "fl_paged_device_print_widget"); + + procedure fl_paged_device_print_window + (D, I : in System.Address; + DX, DY : in Interfaces.C.int); + pragma Import (C, fl_paged_device_print_window, "fl_paged_device_print_window"); + + procedure fl_paged_device_print_window_part + (D, I : in System.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"); + + + + + procedure Finalize + (This : in out Paged_Surface) is + begin + if This.Void_Ptr /= System.Null_Address and then + This in Paged_Surface'Class + then + free_fl_paged_device (This.Void_Ptr); + This.Void_Ptr := System.Null_Address; + end if; + Finalize (Surface_Device (This)); + end Finalize; + + + + + package body Forge is + + function Create + return Paged_Surface is + begin + return This : Paged_Surface do + This.Void_Ptr := new_fl_paged_device; + end return; + end Create; + + end Forge; + + + + + procedure Start_Job + (This : in out Paged_Surface; + Count : in Natural) is + begin + if fl_paged_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 Paged_Surface; + Count : in Natural; + From, To : in Positive) is + begin + if fl_paged_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 End_Job + (This : in out Paged_Surface) is + begin + fl_paged_device_end_job (This.Void_Ptr); + end End_Job; + + + procedure Start_Page + (This : in out Paged_Surface) is + begin + if fl_paged_device_start_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end Start_Page; + + + procedure End_Page + (This : in out Paged_Surface) is + begin + if fl_paged_device_end_page (This.Void_Ptr) /= 0 then + raise Page_Error; + end if; + end End_Page; + + + + + procedure Get_Margins + (This : in Paged_Surface; + Left, Top, Right, Bottom : out Integer) + is + L, T, R, B : Interfaces.C.int; + begin + fl_paged_device_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 Paged_Surface; + W, H : out Integer) + is + Wid, Hei : Interfaces.C.int; + begin + if fl_paged_device_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 Paged_Surface; + X, Y : out Integer) + is + Eks, Why : Interfaces.C.int; + begin + fl_paged_device_get_origin (This.Void_Ptr, Eks, Why); + X := Integer (Eks); + Y := Integer (Why); + end Get_Origin; + + + procedure Set_Origin + (This : in out Paged_Surface; + X, Y : in Integer) is + begin + fl_paged_device_set_origin + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y)); + end Set_Origin; + + + procedure Rotate + (This : in out Paged_Surface; + Degrees : in Float) is + begin + fl_paged_device_rotate (This.Void_Ptr, Interfaces.C.C_float (Degrees)); + end Rotate; + + + procedure Scale + (This : in out Paged_Surface; + Factor : in Float) is + begin + fl_paged_device_scale (This.Void_Ptr, Interfaces.C.C_float (Factor), 0.0); + end Scale; + + + procedure Scale + (This : in out Paged_Surface; + Factor_X, Factor_Y : in Float) is + begin + fl_paged_device_scale + (This.Void_Ptr, + Interfaces.C.C_float (Factor_X), + Interfaces.C.C_float (Factor_Y)); + end Scale; + + + procedure Translate + (This : in out Paged_Surface; + Delta_X, Delta_Y : in Integer) is + begin + fl_paged_device_translate + (This.Void_Ptr, + Interfaces.C.int (Delta_X), + Interfaces.C.int (Delta_Y)); + end Translate; + + + procedure Untranslate + (This : in out Paged_Surface) is + begin + fl_paged_device_untranslate (This.Void_Ptr); + end Untranslate; + + + + + procedure Print_Widget + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_paged_device_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 + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_paged_device_print_window + (This.Void_Ptr, + Wrapper (Item).Void_Ptr, + Interfaces.C.int (Offset_X), + Interfaces.C.int (Offset_Y)); + end Print_Window; + + + procedure Print_Window_Part + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + X, Y, W, H : in Integer; + Offset_X, Offset_Y : in Integer := 0) is + begin + fl_paged_device_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; + + +end FLTK.Devices.Surfaces.Paged; + diff --git a/src/fltk-devices-surfaces-paged.ads b/src/fltk-devices-surfaces-paged.ads new file mode 100644 index 0000000..908c8d1 --- /dev/null +++ b/src/fltk-devices-surfaces-paged.ads @@ -0,0 +1,126 @@ + + +with + + FLTK.Widgets.Groups.Windows; + + +package FLTK.Devices.Surfaces.Paged is + + + type Paged_Surface is new Surface_Device with private; + + type Page_Format is + (A0, A1, A2, A3, A4, A5, A6, A7, A8, A9, + B0, B1, B2, B3, B4, B5, B6, B7, B8, B9, B10, + C5E, DLE, Executive, Folio, Ledger, + Legal, Letter, Tabloid, Envelope); + + type Page_Layout is + (Potrait, Landscape, Reversed, Orientation); + + + + + Page_Error : exception; + + + + + package Forge is + + function Create + return Paged_Surface; + + end Forge; + + + + + procedure Start_Job + (This : in out Paged_Surface; + Count : in Natural); + + procedure Start_Job + (This : in out Paged_Surface; + Count : in Natural; + From, To : in Positive); + + procedure End_Job + (This : in out Paged_Surface); + + procedure Start_Page + (This : in out Paged_Surface); + + procedure End_Page + (This : in out Paged_Surface); + + + + + procedure Get_Margins + (This : in Paged_Surface; + Left, Top, Right, Bottom : out Integer); + + procedure Get_Printable_Rect + (This : in Paged_Surface; + W, H : out Integer); + + procedure Get_Origin + (This : in Paged_Surface; + X, Y : out Integer); + + procedure Set_Origin + (This : in out Paged_Surface; + X, Y : in Integer); + + procedure Rotate + (This : in out Paged_Surface; + Degrees : in Float); + + procedure Scale + (This : in out Paged_Surface; + Factor : in Float); + + procedure Scale + (This : in out Paged_Surface; + Factor_X, Factor_Y : in Float); + + procedure Translate + (This : in out Paged_Surface; + Delta_X, Delta_Y : in Integer); + + procedure Untranslate + (This : in out Paged_Surface); + + + + + procedure Print_Widget + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Widget'Class; + Offset_X, Offset_Y : in Integer := 0); + + procedure Print_Window + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + Offset_X, Offset_Y : in Integer := 0); + + procedure Print_Window_Part + (This : in out Paged_Surface; + Item : in FLTK.Widgets.Groups.Windows.Window'Class; + X, Y, W, H : in Integer; + Offset_X, Offset_Y : in Integer := 0); + + +private + + + type Paged_Surface is new Surface_Device with null record; + + overriding procedure Finalize + (This : in out Paged_Surface); + + +end FLTK.Devices.Surfaces.Paged; + diff --git a/src/fltk-devices-surfaces.adb b/src/fltk-devices-surfaces.adb index a0c5042..d32adda 100644 --- a/src/fltk-devices-surfaces.adb +++ b/src/fltk-devices-surfaces.adb @@ -69,14 +69,14 @@ package body FLTK.Devices.Surfaces is function Get_Current - return access Surface_Device is + return access Surface_Device'Class is begin return Current_Ptr; end Get_Current; procedure Set_Current - (This : in out Surface_Device) is + (This : in out Surface_Device'Class) 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 da3d0a6..9c453e1 100644 --- a/src/fltk-devices-surfaces.ads +++ b/src/fltk-devices-surfaces.ads @@ -25,10 +25,10 @@ package FLTK.Devices.Surfaces is function Get_Current - return access Surface_Device; + return access Surface_Device'Class; procedure Set_Current - (This : in out Surface_Device); + (This : in out Surface_Device'Class); private @@ -41,7 +41,7 @@ private Original_Surface : aliased Surface_Device; - Current_Ptr : access Surface_Device := Original_Surface'Access; + Current_Ptr : access Surface_Device'Class := Original_Surface'Access; end FLTK.Devices.Surfaces; -- cgit