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)