Added FLTK.Devices.Surfaces.Paged

7 files changed, 624 insertions, 6 deletions

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 <FL/Fl_Paged_Device.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#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<My_Paged_Device*>(p);
+}
+
+
+
+
+int fl_paged_device_start_job(PAGED_DEVICE p, int c) {
+    return reinterpret_cast<Fl_Paged_Device*>(p)->start_job(c,0,0);
+}
+
+int fl_paged_device_start_job2(PAGED_DEVICE p, int c, int f, int t) {
+    return reinterpret_cast<Fl_Paged_Device*>(p)->start_job(c,&f,&t);
+}
+
+void fl_paged_device_end_job(PAGED_DEVICE p) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->end_job();
+}
+
+int fl_paged_device_start_page(PAGED_DEVICE p) {
+    return reinterpret_cast<Fl_Paged_Device*>(p)->start_page();
+}
+
+int fl_paged_device_end_page(PAGED_DEVICE p) {
+    return reinterpret_cast<Fl_Paged_Device*>(p)->end_page();
+}
+
+
+
+
+void fl_paged_device_margins(PAGED_DEVICE p, int * l, int * t, int * r, int * b) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->margins(l,t,r,b);
+}
+
+int fl_paged_device_printable_rect(PAGED_DEVICE p, int * w, int * h) {
+    return reinterpret_cast<Fl_Paged_Device*>(p)->printable_rect(w,h);
+}
+
+void fl_paged_device_get_origin(PAGED_DEVICE p, int * x, int * y) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->origin(x,y);
+}
+
+void fl_paged_device_set_origin(PAGED_DEVICE p, int x, int y) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->origin(x,y);
+}
+
+void fl_paged_device_rotate(PAGED_DEVICE p, float r) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->rotate(r);
+}
+
+void fl_paged_device_scale(PAGED_DEVICE p, float x, float y) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->scale(x,y);
+}
+
+void fl_paged_device_translate(PAGED_DEVICE p, int x, int y) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->translate(x,y);
+}
+
+void fl_paged_device_untranslate(PAGED_DEVICE p) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->untranslate();
+}
+
+
+
+
+void fl_paged_device_print_widget(PAGED_DEVICE p, void * i, int dx, int dy) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->print_widget(reinterpret_cast<Fl_Widget*>(i),dx,dy);
+}
+
+void fl_paged_device_print_window(PAGED_DEVICE p, void * i, int dx, int dy) {
+    reinterpret_cast<Fl_Paged_Device*>(p)->print_window(reinterpret_cast<Fl_Window*>(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<Fl_Paged_Device*>(p)->print_window_part(reinterpret_cast<Fl_Window*>(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;