summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_fl_printer.cpp96
-rw-r--r--src/c_fl_printer.h45
-rw-r--r--src/fltk-devices-surfaces-paged-printers.adb346
-rw-r--r--src/fltk-devices-surfaces-paged-printers.ads113
-rw-r--r--src/fltk-devices-surfaces.adb2
-rw-r--r--src/fltk-devices-surfaces.ads2
6 files changed, 602 insertions, 2 deletions
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 <FL/Fl_Printer.H>
+#include <FL/Fl_Widget.H>
+#include <FL/Fl_Window.H>
+#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<Fl_Printer*>(p);
+}
+
+
+
+
+int fl_printer_start_job(PRINTER p, int c) {
+ return reinterpret_cast<Fl_Printer*>(p)->start_job(c,0,0);
+}
+
+int fl_printer_start_job2(PRINTER p, int c, int f, int t) {
+ return reinterpret_cast<Fl_Printer*>(p)->start_job(c,&f,&t);
+}
+
+void fl_printer_end_job(PRINTER p) {
+ reinterpret_cast<Fl_Printer*>(p)->end_job();
+}
+
+int fl_printer_start_page(PRINTER p) {
+ return reinterpret_cast<Fl_Printer*>(p)->start_page();
+}
+
+int fl_printer_end_page(PRINTER p) {
+ return reinterpret_cast<Fl_Printer*>(p)->end_page();
+}
+
+
+
+
+void fl_printer_margins(PRINTER p, int * l, int * t, int * r, int * b) {
+ reinterpret_cast<Fl_Printer*>(p)->margins(l,t,r,b);
+}
+
+int fl_printer_printable_rect(PRINTER p, int * w, int * h) {
+ return reinterpret_cast<Fl_Printer*>(p)->printable_rect(w,h);
+}
+
+void fl_printer_get_origin(PRINTER p, int * x, int * y) {
+ reinterpret_cast<Fl_Printer*>(p)->origin(x,y);
+}
+
+void fl_printer_set_origin(PRINTER p, int x, int y) {
+ reinterpret_cast<Fl_Printer*>(p)->origin(x,y);
+}
+
+void fl_printer_rotate(PRINTER p, float r) {
+ reinterpret_cast<Fl_Printer*>(p)->rotate(r);
+}
+
+void fl_printer_scale(PRINTER p, float x, float y) {
+ reinterpret_cast<Fl_Printer*>(p)->scale(x,y);
+}
+
+void fl_printer_translate(PRINTER p, int x, int y) {
+ reinterpret_cast<Fl_Printer*>(p)->translate(x,y);
+}
+
+void fl_printer_untranslate(PRINTER p) {
+ reinterpret_cast<Fl_Printer*>(p)->untranslate();
+}
+
+
+
+
+void fl_printer_print_widget(PRINTER p, void * i, int dx, int dy) {
+ reinterpret_cast<Fl_Printer*>(p)->print_widget(reinterpret_cast<Fl_Widget*>(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<Fl_Printer*>(p)->print_window_part(reinterpret_cast<Fl_Window*>(i),x,y,w,h,dx,dy);
+}
+
+
+
+
+void fl_printer_set_current(PRINTER p) {
+ reinterpret_cast<Fl_Printer*>(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
generated by cgit (git 2.30.0) at 2024-12-22 23:01:53 +0000