1/*  Part of XPCE --- The SWI-Prolog GUI toolkit
2
3    Author:        Jan Wielemaker and Anjo Anjewierden
4    E-mail:        jan@swi.psy.uva.nl
5    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
6    Copyright (c)  2002-2011, University of Amsterdam
7    All rights reserved.
8
9    Redistribution and use in source and binary forms, with or without
10    modification, are permitted provided that the following conditions
11    are met:
12
13    1. Redistributions of source code must retain the above copyright
14       notice, this list of conditions and the following disclaimer.
15
16    2. Redistributions in binary form must reproduce the above copyright
17       notice, this list of conditions and the following disclaimer in
18       the documentation and/or other materials provided with the
19       distribution.
20
21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32    POSSIBILITY OF SUCH DAMAGE.
33*/
34
35:- module(pce_print_text, []).
36:- use_module(library(pce)).
37
38/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
39This module extends class text_buffer with   the ->print method, dealing
40with printing plain text.  This  issue   is  completely  different  when
41comparing Windows and Unix.
42
43Windows
44=======
45
46We create an editor and print the image thereof on a win_printer, page
47by page.
48
49Unix
50====
51
52There are many options here, unfortunately   none  is very standard. You
53can pipe the output directly through the   lpr  command, use an external
54beautifier that creates nice-looking  PostScript,   such  as  nenscript,
55mpage or aps or create the  PostScript   yourself.  At the moment, class
56text_image does not provide for generating   PostScript,  so this is not
57yet an option. To keep things simple we   pipe through lpr and leave the
58details to the lpr installation.
59- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
60
61:- pce_extend_class(text_buffer).
62
63print(TB, From:from=[int], To:to=[int],
64      JobName:job=[name],
65      Editor:editor=[editor],
66      Font:font=[font]) :->
67    "Print (region of) the text-buffer"::
68    get(TB, size, Size),
69    default(From, 0, F),
70    default(To, Size, T),
71    (   get(@pce, convert, win_printer, class, _)
72    ->  send(TB, win_print, F, T, JobName, Editor, Font)
73    ;   send(TB, unix_print, F, T, JobName, Editor, Font)
74    ).
75
76                 /*******************************
77                 *       WINDOWS PRINTING       *
78                 *******************************/
79
80win_print(TB, From:int, To:int,
81          JobName:[name], Editor:[editor], Font:[font]) :->
82    new(Prt, win_printer(JobName)),
83    (   Editor \== @default,
84        get(Editor, frame, Frame)
85    ->  true
86    ;   Frame = @default
87    ),
88    send(Prt, setup, Frame),
89    (   send(Prt, open)
90    ->  true
91    ;   send(TB, report, error, 'Failed to open printer'),
92        fail
93    ),
94    new(E, editor(TB, 80)),
95    send(E?image, elevation, @nil),
96    send(E?image, pen, 0),
97    send(TB, setup_print_editor, E, Editor),
98    (   Font \== @default
99    ->  send(E, font, Font)
100    ;   true
101    ),
102    get(E?area, width, Width),
103    get(Prt, size, size(W,H)),
104    get(Prt, dots_per_inch, size(DPIX,DPIY)),
105    InchW is W/DPIX,
106    InchH is H/DPIY,
107    PageW is round(Width*(InchW/(InchW-2))), % 1 inch margin
108    PageH is round(PageW*(H/W)),
109    send(Prt, resolution, PageH),
110    Height is round(PageH*((InchH-2)/InchH)),
111    LDPI is round(PageH/InchH),
112    send(E, do_set, 0, 0, Width, Height),
113
114    new(BG, device),                % background
115    (   JobName \== @default
116    ->  send(BG, display, new(T, text(JobName))),
117        send(BG, display, new(P, text)),
118        send(P, name, pageno),
119        get(T, height, TH),
120        BT is LDPI-TH/2,
121        Right is LDPI+Width,
122        send(T, position, point(LDPI, BT-TH)),
123        send(P, position, point(Right, BT-TH)),
124        send(BG, display, line(LDPI, BT, Right, BT)),
125        send(BG, attribute, page_right, Right)
126    ;   true
127    ),
128
129    send(E, scroll_to, From, 1),
130    print_pages(Prt, E, To, margin(LDPI,LDPI), BG, 1, Pages),
131    send(TB, report, status, 'Sent %d pages to the printer', Pages),
132    send(Prt, close),
133    send(E, destroy).
134
135setup_print_editor(_TB, E:editor, From:[editor]) :->
136    "Get defaults from editor"::
137    (   From \== @default
138    ->  get(From, styles, Styles),
139        send(Styles, for_all,
140             message(E, style, @arg1?name, @arg1?value)),
141        get(From, font, Font),
142        send(E, font, Font)
143    ;   true
144    ).
145
146%!  print_pages(+Printer, +Editor, +EndIndex, +Margin,
147%!              +Background, +Page, -LastPage) is det.
148%
149%   Actual page printing loop.
150%
151%   @param Margin   Term margin(+X,+Y) representing the page margins
152
153print_pages(Printer, Editor, End, Margin, BG, Page, Pages) :-
154    get(Editor, image, Image),
155    Margin = margin(MX, MY),
156    (   get(BG, member, pageno, PageNoText)
157    ->  send(PageNoText, string, string('%s %d', page?label_name, Page)),
158        get(BG, page_right, Right),
159        send(PageNoText, x, Right-PageNoText?width)
160    ;   true
161    ),
162    send(Printer, draw_in, BG),
163    get(Image, end, EndImg),
164    (   EndImg > End
165    ->  get(Image, start, Start),
166        get(Image, character_position, End, point(_,BaseY)),
167        send(Editor, do_set, height := BaseY),
168        send(Editor, scroll_to, Start, 1) % make sure it doesn't move
169    ;   true
170    ),
171    send(Printer, draw_in, Image, point(MX, MY)),
172    (   (   EndImg >= End
173        ;   get(Image, eof_in_window, @on)
174        )
175    ->  Pages = Page
176    ;   send(Printer, next_page),
177        send(Editor, scroll_to, EndImg, 1),
178        NextPage is Page+1,
179        print_pages(Printer, Editor, End, Margin, BG, NextPage, Pages)
180    ).
181
182
183                 /*******************************
184                 *         UNIX PRINTING        *
185                 *******************************/
186
187unix_print(TB, From:int, To:int,
188           _JobName:[name], Editor:[editor], _Font:[font]) :->
189    "Print on Unix printer"::
190    (   getenv('PRINTER', LP)
191    ->  true
192    ;   LP = lp
193    ),
194    atom_concat('lpr -P', LP, DefCommand),
195    new(D, dialog(print_command?label_name)),
196    send(D, append, new(TI, text_item(command, DefCommand))),
197    send(D, append, button(print, message(D, return, TI?selection))),
198    send(D, append, button(cancel, message(D, destroy))),
199    send(D, default_button, print),
200    (   Editor \== @default,
201        get(Editor, frame, Frame)
202    ->  send(D, transient_for, Frame),
203        send(D, modal, transient),
204        get(Frame?area, center, Center)
205    ;   Center = @default
206    ),
207    get(D, confirm_centered, Center, Command),
208    send(D, destroy),
209    get(TB, contents, From, To-From, String),
210    get(String, value, Atom),
211    catch(do_print(Command, Atom), E,
212          (   message_to_string(E, Msg),
213              send(TB, report, error, Msg))),
214    send(TB, report, status, 'Document sent to printer').
215
216do_print(Command, Text) :-
217    open(pipe(Command), write, Out),
218    write(Out, Text),
219    close(Out).
220
221:- pce_end_class.
222
223/*
224test :-
225        new(TB, text_buffer),
226        send(TB, insert_file, 0, 'print_text.pl'),
227        send(TB, try_print, job := 'Test me').
228
229test(To) :-
230        new(TB, text_buffer),
231        send(TB, insert_file, 0, 'print_text.pl'),
232        send(TB, try_print, to := To, job := 'Test me').
233*/
234