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_graphics, []).
  36:- use_module(library(pce)).
  37:- use_module(library(pce_template)).
  38:- use_module(library(pce_shell)).
  39
  40:- pce_autoload(finder, library(find_file)).
  41:- pce_global(@finder, new(finder)).
  42
  43/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  44Public methods:
  45
  46        ->print
  47        Prints the content of the Window as a single page
  48
  49        ->save_postscript: [file], [directory]
  50        Save content of the Window as PostScript
  51- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  52
  53
  54:- pce_begin_class(print_graphics, template,
  55                   "Template defining ->print").
  56
  57/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  58Print  the image to the default  printer.  Also this  method should be
  59extended by requesting additional parameters from the user.
  60- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  61
  62print(Canvas) :->
  63    "Send to default printer"::
  64    print_canvas(Canvas).
  65
  66/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  67There are two routes to print.  On   MS-Windows  printing is achieved by
  68drawing on a GDI representing a printer, after which the Windows printer
  69driver creates printer-codes and sends them to the printer. The standard
  70Windows print dialog is shown by   win_printer->setup. Next we need some
  71calculation effort to place our diagram reasonably on the page.
  72
  73In the Unix world, things go different. In general you make a PostScript
  74file and hand this  to  the   print-spooler,  which  will  translate the
  75device-independant PostScript to whatever the printer needs.
  76
  77XPCE doesn't (yet)  try  to  hide   the  difference  between  these  two
  78approaches.
  79- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  80
  81print_canvas(Canvas) :-                 % MS-Windows
  82    get(@pce, convert, win_printer, class, _),
  83    !,
  84    (   send(Canvas, has_get_method, default_file),
  85        get(Canvas, default_file, Job)
  86    ->  true
  87    ;   Job = '<unknown job>'
  88    ),
  89    new(Prt, win_printer(Job)),
  90    send(Prt, setup, Canvas),
  91    send(Prt, open),
  92    get(Canvas, bounding_box, area(X, Y, W, H)),
  93    get(@display, dots_per_inch, size(DX, DY)),
  94    InchW is W/DX,
  95    InchH is H/DY,
  96
  97    get(Prt, size, size(PW0, PH0)),
  98    get(Prt, dots_per_inch, size(RX, RY)),
  99    MarX is RX,                     % default 1 inch margins
 100    MarY is RY,
 101    PrInchW is (PW0-MarX*2)/RX,
 102    PrInchH is (PH0-MarY*2)/RY,
 103
 104    send(Prt, map_mode, isotropic),
 105    (   InchW < PrInchW,
 106        InchH < PrInchH             % it fits on the page
 107    ->  OX is MarX + ((PrInchW-InchW)/2)*RX,
 108        send(Prt, window, area(X, Y, DX, DY)),
 109        send(Prt, viewport, area(OX, MarY, RX, RY))
 110    ;   Aspect is min(PrInchW/InchW, PrInchH/InchH),
 111        ARX is integer(Aspect*RX),
 112        ARY is integer(Aspect*RY),
 113        send(Prt, window, area(X, Y, DX, DY)),
 114        send(Prt, viewport, area(MarX, MarY, ARX, ARY))
 115    ),
 116    send(Prt, draw_in, Canvas?graphicals),
 117    send(Prt, close),
 118    free(Prt).
 119print_canvas(Canvas) :-                 % Unix/PostScript
 120    get(Canvas, print_command, Command),
 121    new(PsFile, file),
 122    send(PsFile, open, write),
 123    send(PsFile, append, Canvas?postscript),
 124    send(PsFile, append, 'showpage\n'),
 125    send(PsFile, close),
 126    get(PsFile, absolute_path, File),
 127    get(string('%s "%s"', Command, File), value, ShellCommand),
 128    pce_shell_command('/bin/sh'('-c', ShellCommand)),
 129    send(PsFile, remove),
 130    send(PsFile, done),
 131    send(Canvas, report, status, 'Sent to printer').
 132
 133
 134print_command(Canvas, Command:name) :<-
 135    "Get name of the printer"::
 136    get(Canvas, frame, Frame),
 137    default_printer(DefPrinter),
 138    get(Canvas, print_command_template, CmdTempl),
 139    print_cmd(CmdTempl, DefPrinter, Cmd),
 140    new(D, dialog(print_command?label_name)),
 141    send(D, append, new(P, text_item(print_command, Cmd))),
 142    send(D, append, button(cancel, message(D, return, @nil))),
 143    send(D, append, button(ok, message(D, return, P?selection))),
 144    send(D, default_button, ok),
 145    send(D, transient_for, Frame),
 146    send(D, modal, transient),
 147    get(D, confirm_centered, Canvas?frame?area?center, Answer),
 148    send(D, destroy),
 149    Answer \== @nil,
 150    Command = Answer.
 151
 152default_printer(Printer) :-
 153    get(@pce, environment_variable, 'PRINTER', Printer),
 154    !.
 155default_printer(postscript).
 156
 157
 158print_job_name(_, Job) :<-
 159    "Default name of the printer job"::
 160    Job = 'XPCE/SWI-Prolog'.
 161
 162print_command_template(_, Command) :<-
 163    "Default command to send a job to the printer"::
 164    Command = 'lpr -P%p'.
 165
 166/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 167print_cmd(+Template, +Printer, +File,  -Command)   determines  the shell
 168command to execute in order to get `File' printed on `Printer' using the
 169given template. The substitutions are handled by a regex object.
 170- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
 171
 172print_cmd(Template, Printer, Cmd) :-
 173    new(S, string('%s', Template)),
 174    substitute(S, '%p', Printer),
 175    get(S, value, Cmd),
 176    free(S).
 177
 178substitute(S, F, T) :-
 179    new(R, regex(F)),
 180    send(R, for_all, S,
 181         message(@arg1, replace, @arg2, T)),
 182    free(R).
 183
 184
 185                 /*******************************
 186                 *          POSTSCRIPT          *
 187                 *******************************/
 188
 189
 190save_postscript(Canvas, File:file=[file], Directory:directory=[directory]) :->
 191    "Save content as PostScript to File"::
 192    (   File == @default
 193    ->  get(@finder, file, save,
 194            chain(tuple('PostScript', ps),
 195                  tuple('Encapsulated PostScript', eps)),
 196            Directory,
 197            FileName)
 198    ;   FileName = File
 199    ),
 200    new(PsFile, file(FileName)),
 201    send(PsFile, open, write),
 202    send(PsFile, append, Canvas?postscript),
 203    send(PsFile, append, 'showpage\n'),
 204    send(PsFile, close),
 205    send(Canvas, report, status, 'Saved PostScript to %s', PsFile).
 206
 207:- pce_end_class(print_graphics).