/*  Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        jan@swi.psy.uva.nl
    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
    Copyright (c)  1985-2002, University of Amsterdam
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

:- module(draw_canvas, []).

:- use_module(library(pce)).
:- use_module(align).
:- require([ add_config/2
           , chain_list/2
           , default/3
           , file_name_extension/3
           , forall/2
           , get_config/2
           , ignore/1
           , pce_shell_command/1
           , send_list/3
           ]).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Class `draw_canvas' defines  the actual drawing  area.  Representing a
collection  of graphicals, the  closest PCE  class is   `picture'.  In
addition  to pictures, class   draw_canvas  takes care of the  current
mode, the  current prototype, the  file (for  loading  and saving  the
image) and an editor for changing attributes of graphical objects.

For editing  the drawing,  two  variables have been added:  `mode' and
`proto'.   `Mode' is an indication of  the current  mode.  The various
gestures defined in  the file `gesture'  are only active in predefined
modes.  They can access the current mode with:

        @event?receiver?window?mode

For  modes that  create  objects,   the variable `proto'   contains  a
prototype of the object to be created.  Instances of the prototype are
created   using `Object <-clone',     except   for  links,  which  are
instantiated by creating a connection from them.

The variables <->file and <-modified are used to implement  ->save and
->load.

NOTE:   Modified   is a difficult  issue.  It   should  be set  by all
        operations  that   change  anything  to the    contents of the
        diagram.  Maybe it is better to implement  a modified variable
        at the level of window, or implement a message that allows the
        programmer to keep track of actions on the picture.

The attribute_editor is a reference to  an editor that allows the user
to change the attributes of the graphicals in the selection.

NOTE:   Should we  define  the  type  of the attribute_editor   to  be
        `draw_attribute_editor*' or rather `object*' and just rely the
        attribute editor has the appropriate methods to facilitate the
        communication?
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- pce_begin_class(draw_canvas, picture, "Drawing plane of PceDraw").

variable(mode,             name,                        get,
         "Current mode of operation").
variable(proto,            object*,                     both,
         "Current create prototype (graphical/link)").
variable(file,             file*,                       get,
         "Current save/load file").
variable(modified,         bool,                        get,
         "Has the contents been modified?").
variable(auto_align_mode,   bool,                       both,
         "Autoalign graphicals after create/resize").
variable(attribute_editor, draw_attribute_editor*,      both,
         "Editor handling attributes").
variable(undo_buffer,      draw_undo_manager,           get,
         "Records undo actions").



                /********************************
                *           INITIALISE          *
                ********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
->initialise initialises the picture and custom  slots that should not
be @nil.  It also attaches  an event recogniser  to the picture.  Note
that there are two ways to attach an event recogniser to a picture.

The first  is to  attach a recogniser  using the `Object ->recogniser'
method. In this case, the object is  extended with  an interceptor and
the recogniser is attached to this interceptor.   Recognisers attached
to an interceptor are activated by the `Graphical ->event'.

The second is  to  define a  method ->event.   This method may  either
decide to  decode the events itself,  or  leave this to  a recogniser.
These    approaches are used  in the   file   shapes.pl to make shapes
sensitive to user actions.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

initialise(Canvas) :->
    "Create a drawing canvas"::
    send(Canvas, send_super, initialise, 'Canvas'),
    send(Canvas, selection_feedback, handles),
    send(Canvas, slot, undo_buffer, draw_undo_manager(Canvas, 100)),
    send(Canvas, slot, modified, @off),
    send(Canvas, auto_align_mode, @off),
    send(Canvas, mode, select, @nil),
    send(Canvas, recogniser, @draw_canvas_recogniser).

                 /*******************************
                 *        EVENT HANDLING        *
                 *******************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The recogniser itself is  a  reusable object  (which   implies   other
instances of draw_canvas can use the same instance of the recogniser).
For this reason, it  is declared using pce_global/2.   The  first time
the recogniser reference is passed to PCE, the  interface will trap an
exception and create the object  using  the declaration in  this file.
This approach will delay the creation of the reusable object  until it
is really  necessary  and avoids conditions  in  the  code  (i.e.  `if
object does not exist then create it' just before it is used).

NOTE:   I'm  not sure whether  or not  it is better  to a) Declare the
        global objects in gesture.pl and just refer to them here or b)
        Just declare the classes there and create instances here.

        Both  approaches have their advantages.    The first  approach
        guarantees maximal reuse.  Actually there is only one instance
        of each gesture class and one may advocate it is better to use
        object-level programming to  create  this sole instance.   PCE
        should offer

                :- pce_begin_object(NewTerm).
                ...
                :- pce_end_object.

        similar to defining classes.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- pce_global(@draw_canvas_popup, make_draw_canvas_popup).

make_draw_canvas_popup(P) :-
    new(Canvas, @event?receiver),
    new(P, popup),
    send_list(P, append,
              [ menu_item(select_mode,
                          message(Canvas?frame?menu, activate_select),
                          end_group := @on),
                menu_item(paste,
                          message(Canvas, paste,
                                  Canvas?current_event?position))
              ]).


:- pce_global(@draw_canvas_keybinding, make_draw_canvas_keybinding).

canvas_keybinding('DEL',   cut_selection).
canvas_keybinding('\\C-a', select_all).
canvas_keybinding('\\C-h', hide_selection).
canvas_keybinding('\\C-e', expose_selection).
canvas_keybinding('\\C-c', copy_selection).
canvas_keybinding('\\C-v', paste).
canvas_keybinding('\\C-_', simple_undo).
canvas_keybinding('\\C-z', simple_undo).
canvas_keybinding('\\C-s', save).
canvas_keybinding('\\C-p', print).
canvas_keybinding('TAB',   start_typing).

make_draw_canvas_keybinding(B) :-
    new(B, key_binding),
    forall(canvas_keybinding(Key, Method),
           send(B, function, Key, Method)).


:- pce_global(@draw_canvas_recogniser, make_draw_canvas_recogniser).

make_draw_canvas_recogniser(G) :-
    new(KBFocus, @event?window?keyboard_focus),
    new(ST, handler(keyboard,
                    message(@receiver, start_typing, @event))),
    new(EX, handler(area_exit,
                    message(@event?window, keyboard_focus, @nil))),
    new(G, handler_group(@draw_create_resize_gesture,
                         @draw_create_line_gesture,
                         @draw_create_bezier_gesture,
                         @draw_create_path_gesture,
                         @draw_create_text_recogniser,
                         @draw_create_proto_recogniser,
                         @draw_warp_select_gesture,
                         @draw_canvas_keybinding,
                         new(P, click_gesture(middle, '', single,
                                              message(KBFocus, paste))),
                         popup_gesture(@draw_canvas_popup),
                         ST, EX)),
    send(P, condition, KBFocus \== @nil).


start_typing(C, Id:event_id) :->
    "Start typing if the selection wants the keyboard"::
    get(C, keyboard_focus, @nil),
    (   get(C, selection, Selection),
        get(Selection, size, 1),
        get(Selection, head, Obj),
        send(Obj, '_wants_keyboard_focus')
    ->  send(C, selection, @nil),
        send(C, keyboard_focus, Obj),
        (   Id \== 9
        ->  send(Selection?head, generate_event, Id)
        ;   true
        )
    ;   Id == 9
    ->  send(C, advance)
    ).


                /********************************
                *            UNLINK             *
                ********************************/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The ->unlink behaviour  is called when  an object is  removed from the
PCE object base, either initiated through  `Object ->free', or through
the garbage collector.  `Object ->unlink' is responsible for unlinking
the object   from its environment.   For  example,  when  a  window is
unlinked it should inform X-windows; when a  graphical is unlinked, it
should  inform its device.  Removing an  object entails the  following
steps:

        1) Call ->unlink
        2) Reset all slots that have objects in them to @nil
        3) Reclaim the memory

Like ->initialise,   ->unlink    should invoke   the method   of   the
super-class.  Normally, it will  first do its own  part of the job and
then starts the ->unlink of the superclass.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

unlink(Canvas) :->
    (   get(Canvas, attribute_editor, Editor),
        Editor \== @nil
    ->  send(Editor, quit)
    ;   true
    ),
    get(Canvas, undo_buffer, UB),
    free(UB),
    send(Canvas, send_super, unlink).


                /********************************
                *         MODIFICATIONS         *
                ********************************/

:- pce_group(modified).

modified(C) :->
    send(C, slot, modified, @on).

open_undo_group(C) :->
    "Open a new undo group"::
    send(C?undo_buffer, open_undo_group).

close_undo_group(C) :->
    "Close the undo group"::
    send(C?undo_buffer, close_undo_group).

undo_action(C, Action:code) :->
    "Record an action for undo"::
    send(C?undo_buffer, undo_action, Action).

clear_undo_group(C) :->
    "Empty the current undo-group"::
    send(C?undo_buffer, clear_group).

simple_undo(C) :->
    "Just undo the last action"::
    get(C, undo_buffer, UB),
    send(UB, start_undo),
    send(UB, undo),
    send(UB, end_undo).

undo(C) :->
    "Start undo dialog"::
    send(C?undo_buffer, open, C?frame).

reset(C) :->
    "Trap abort"::
    send(C, send_super, reset),
    send(C?undo_buffer, reset).

                /********************************
                *           SELECTION           *
                ********************************/
:- pce_group(selection).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Managing the  selection.    This is  no  different  than for  standard
picture, except that we  have to update the  attribute-editor if it is
attached.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

selection(C, Sel:'graphical|chain*') :->
    "Set the selection shape or chain"::
    send(C, send_super, selection, Sel),
    send(C, keyboard_focus, @nil),
    send(C, update_attribute_editor).


toggle_select(C, Shape:graphical) :->
    "(Un)select a shape"::
    send(Shape, toggle_selected),
    send(C, update_attribute_editor).

select_all(C) :->
    "Select all displayed objects"::
    send(C, selection, C?graphicals).


                /********************************
                *            IMPORTS            *
                ********************************/
:- pce_group(imports).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Import a  named X11 image (bitmap) file  into the  drawing.  This code
implements a simple   modal dialog  window that prompts  for an image.
The  `text_item  ->type'  attribute  describes the  (PCE) type  of the
object requested.  After the user has entered a  name  and type return
or pressed the  `ok' button, PCE  will try to  convert the typed value
into an  PCE image  object.  See `image  <-convert' for the conversion
rules.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

import_image(C) :->
    "Import an image at location (0,0)"::
    new(D, dialog('Import Image')),
    send(D, append, new(TI, text_item(image, ''))),
    send(TI, type, image),
    send(D, append, button(ok, message(D, return, TI?selection))),
    send(D, append, button(cancel, message(D, return, @nil))),
    send(D, default_button, ok),
    get(D, confirm_centered, Image),
    send(D, destroy),
    Image \== @nil,
    send(C, display, draw_bitmap(Image)).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Import another PCE frame as a bitmap.  The user  may select a frame to
be imported by clicking on it.  There  are two ways to implement this.
The first is to grab the mouse-focus,  wait for a left-click  and then
locate the  frame on  which the  user  clicked.  The second is  to use
PCE's `inspect-handlers'.   If an event happens that  satisfies one of
the `display <-inspect_handlers', PCE  will  locate  the graphical  on
which    the  event  occurred   and    execute  the  message  of   the
inspect-handler with @arg1  bound to the  graphical on which the event
occurred.  This mechanism is  exploited by the `Inspector' and `Visual
Hierarchy' tools of the manual.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

import_frame(C) :->
    "Import image of a frame"::
    get(C, display, Display),
    new(D, dialog('Import Frame')),
    send(D, append,
         label(prompt, 'Please left-click inside PCE frame to import')),
    send(D, append, button(cancel, message(D, return, @nil))),
    send(Display, inspect_handler,
         new(G, handler(ms_left_up, message(D, return, @arg1?frame)))),
    get(D, confirm, Frame),
    send(Display?inspect_handlers, delete, G),
    send(D, destroy),
    Frame \== @nil,
    object(Frame),                  % not yet deleted?
    send(C, display, draw_bitmap(Frame?image)).


                /********************************
                *             EDIT              *
                ********************************/
:- pce_group(edit).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Selection-edit operations.  Most of them are rather trivial.  Note the
use of `Chain ->for_all'  to perform operations on  all members of the
selection.   This  method  is  a lot    faster then transferring   the
selection to a Prolog list and than operating on it:

        get(Canvas, selection, Selection),
        chain_list(Selection, List),
        forall(member(Gr, List), send(Gr, free)).

The `Chain ->for_all' operation first makes an array of objects in the
chain, than invokes  the message consequtively on  each  member of the
list.   Before  sending the message,  it  validates  the object  still
exists.  This makes the  method  safe for cases  were  destroying  one
object  destroyes  related objects  that  may be  in   the chain  too.
Connections  are  an example: destroying a graphical  destroys all its
connections and therefore leaves `dangling' references.

One could   generalise from the code   below   by introducing a method
->for_selection: message, but the advantages are very small.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

edit(Canvas, Msg, Grs:'[graphical|chain]') :->
    "Perform operation on graphicals or selection"::
    default(Grs, Canvas?selection, G0),
    (   send(G0, instance_of, chain)
    ->  send(G0, for_all, Msg)
    ;   send(Msg, forward, G0)
    ),
    send(Canvas, modified).


expose_selection(Canvas, Grs:'[graphical|chain]') :->
    "Expose selected graphicals"::
    send(Canvas, edit, message(@arg1, restack, 1), Grs).


hide_selection(Canvas, Grs:'[graphical|chain]') :->
    "Hide selected graphicals"::
    send(Canvas, edit, message(@arg1, restack, -1), Grs).


cut_selection(Canvas, Grs:[graphical|chain]) :->
    "Erase all members of the selection"::
    send(Canvas, copy_selection, Grs),
    send(Canvas, edit, message(@arg1, cut), Grs).

:- pce_global(@draw_clipboard, new(device)).

copy_selection(Canvas, Grs:[graphical|chain]) :->
    "Copy all members of the selection to @draw_clipboard"::
    default(Grs, Canvas?selection, ToCopy),
    get(ToCopy, clone, Copy),
    send(@draw_clipboard, clear),
    send(Copy, for_all,
         message(@draw_clipboard, display, @arg1)),
    clean_clipboard(@draw_clipboard),
    send(@draw_clipboard, reference).


clean_clipboard(Device) :-
    new(Done, hash_table),
    send(Device?graphicals, for_some,
         message(@prolog, clean_clipboard_connections,
                 @arg1, Device, Done)),
    send(Done, done).


clean_clipboard_connections(Gr, _CB, Done) :-
    get(Done, member, Gr, @on),
    !.
clean_clipboard_connections(Gr, CB, _) :-
    \+ get(Gr, is_displayed, CB, @on),
    !,
    send(Gr, destroy).
clean_clipboard_connections(Gr, CB, Done) :-
    send(Done, append, Gr, @on),
    get(Gr, connections, AllConnections),
    send(AllConnections, for_all,
         message(@prolog, clean_clipboard_connections,
                 ?(@arg1, opposite, Gr), CB, Done)).


paste(Canvas, At:[point]) :->
    "Paste @draw_clipboard"::
    (   object(@draw_clipboard)
    ->  (   At == @default
        ->  (   get(@event, window, Canvas)
            ->  get(@event, position, Canvas, Pos)
            ;   Pos = point(0,0)
            )
        ;   Pos = At
        ),
        get(@draw_clipboard?graphicals, clone, Clone),
        send(Canvas, open_undo_group),
        send(Clone, for_all,
             and(if(?(@arg1, hypered, slave_of),
                    new(and),
                    message(@arg1, relative_move, Pos)),
                 message(Canvas, display, @arg1),
                 message(Canvas, undo_action,
                         create(message, @arg1, cut)))),
        send(Canvas, close_undo_group),
        send(Canvas, selection, Clone),
        send(Clone, done),
        send(Canvas, modified)
    ;   send(Canvas, report, warning, 'Draw Clipboard is empty')
    ).

                 /*******************************
                 *       WINDOWS CLIPBOARD      *
                 *******************************/

map_format(aldus, wmf) :- !.
map_format(Fmt, Fmt).

export_win_metafile(Canvas, What:[{selection,drawing}], Format:[{wmf,emf}]) :->
    "Export to the Windows clipboard"::
    send(Canvas, keyboard_focus, @nil),
    default(What, selection, TheWhat),
    (   Format == @default
    ->  get_config(draw_config:file/meta_file_format, TheFormat0),
        map_format(TheFormat0, TheFormat)
    ;   TheFormat = Format
    ),
    get(Canvas, selection, OldSelection),
    send(Canvas, selection, @nil),
    (   TheWhat == selection
    ->  Graphs = OldSelection
    ;   get(Canvas, graphicals, Graphs)
    ),
    new(MF, win_metafile),
    send(MF, draw_in, Graphs),
    send(@display, selection_owner, MF,
         primary,                   % which
         @receiver,                 % fetch object
         message(@receiver, free),  % loose selection
         TheFormat),
    send(Canvas, selection, OldSelection),
    send(Canvas, report, status, 'Put %s on clipboard', TheWhat).

import_win_metafile(Canvas) :->
    "Get selection as picture and import it"::
    (   get(Canvas?display, selection,
            primary, win_metafile, win_metafile, MF)
    ->  new(DMF, draw_metafile),
        send(DMF, copy, MF),
        send(Canvas, display, DMF),
        free(MF),
        send(Canvas, report, status, 'Imported metafile')
    ;   send(Canvas, report, warning, 'Could not get clipboard data')
    ).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The method below  duplicates the selection  and displays the duplicate
at  an   optionally specified  offset.   There  are  various difficult
operations in  this  predicate.  The  `if-then-else'  illustrates  how
default arguments are handled inside a method.

Next, the selection, which is  a chain  with  the selected shapes,  is
cloned.  `Object <-clone'  creates  a  recursive clone. Note that  the
selection as  a   whole is cloned   rather  than each member    of  it
separately.   This guarantees  proper kloning of relations  inside the
selection (such as connections).

NOTE:   Connections to objects outside the selection are not handled
        properly.  Kloning objects has to be based on semantics
        attached to slot-relations rather than classes.

Finally  ->done is sent  to  the clone  of  the selection chain.  This
indicates PCE that Prolog is no  longer interrested  in the object and
that, if there  are  no references to  it, it may  be removed.   Using
`Object ->done' is generally advocated over using  ->free after Prolog
has finished   with the  result  of a   get operation.   Consider  the
following cases:

        get(Graphical, position, Pos),
        ...
        send(Pos, free).

and

        get(Graphical, area, Area),
        ...
        send(Area, free).

In the first example, `Pos' is a point created by  the method, but not
referred to by  the `Graphical'.    Using ->free  is  correct.  In the
second case however the method <-area returns  the <-area attribute of
`Graphical' and destroying this would make `Graphical' an inconsistent
object.  Using ->done, the point will be removed in the first example,
but the area will remain in the second.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

duplicate_selection(Canvas, Offset:[point]) :->
    "Duplicate the selection"::
    default(Offset, point(10, 10), Off),
    get(Canvas?selection, clone, Duplicate),
    send(Canvas, open_undo_group),
    send(Duplicate, for_all,
         and(message(Canvas, display, @arg1),
             message(@arg1, relative_move, Off))),
    clean_duplicates(Duplicate),
    send(Canvas, selection, Duplicate),
    send(Canvas, clear_undo_group),
    send(Duplicate, for_all,
         message(Canvas, undo_action,
                 create(message, @arg1, cut))),
    send(Canvas, close_undo_group),
    send(Duplicate, done),
    send(Canvas, modified).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The method `object <-clone' makes a recursive  copy of an  object.  If
an  object with connection is  cloned the connections   as well as the
`other  side' of  the  connections will  be  cloned   as  well.   This
predicate removes all  graphical   objects that  are related  to   the
duplicated object but not displayed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

clean_duplicates(Chain) :-
    new(Done, hash_table),
    send(Chain, for_some,
         message(@prolog, clean_duplicate_connections, @arg1, Done)),
    send(Done, free).

clean_duplicate_connections(Gr, Done) :-
    get(Done, member, Gr, @on),
    !.
clean_duplicate_connections(Gr, _) :-
    \+ get(Gr, window, _),
    !,
    send(Gr, destroy).
clean_duplicate_connections(Gr, Done) :-
    send(Done, append, Gr, @on),
    get(Gr, connections, AllConnections),
    send(AllConnections, for_all,
         message(@prolog, clean_duplicate_connections,
                 ?(@arg1, opposite, Gr), Done)).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Start the attribute editor on the current selection.  The  first time,
we need to create the editor.   If the user hits  `quit' on the button
of  the editor, the editor is  just  removed  from   the display using
`Frame ->show: @off' and this function can make it visible again using
->show: @on.  This approach has several advantages.  First  of all, it
is a lot faster and second, the attribute editor will be  at  the same
location on the display as were the user left it last time.

See also ->unlink in this class and 'draw_attribute_editor ->quit'.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

edit_selection(Canvas) :->
    "Start attribute editor on selection"::
    get(Canvas, attribute_editor, Editor),
    (    Editor == @nil
    ->   send(Canvas, slot, attribute_editor,
              new(A, draw_attribute_editor(Canvas))),
         send(A, open)
    ;    A = Editor,
         send(A, show, @on),
         send(A, expose)
    ),
    send(A, client, Canvas?selection).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Update  the setting   of   the attribute editor   because  either  the
selection has  changed, or the attributes of  members of the selection
has changed.

NOTE:   The move and resize gestures should invoke this behaviour too.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

update_attribute_editor(Canvas) :->
    "Update values in attribute editor"::
    get(Canvas, attribute_editor, Editor),
    (   Editor \== @nil
    ->  send(Editor, client, Canvas?selection)
    ;   true
    ).


clear(Canvas, Confirm:[bool]) :->
    "Clear and reset <->file attribute"::
    (   Confirm == @on,
        \+ send(Canvas?graphicals, empty)
    ->  send(@display, confirm, 'Clear drawing?')
    ;   true
    ),
    send(Canvas, send_super, clear),
    send(Canvas, file, @nil),
    send(Canvas, slot, modified, @off),
    send(Canvas?undo_buffer, clear),
    send(Canvas, update_attribute_editor).


                /********************************
                *           ALIGNMENT           *
                ********************************/
:- pce_group(alignment).

align_with_selection(Canvas, Gr:graphical) :->
    "Align graphical (with selection)"::
    (   get(Canvas, selection, G0),
        send(G0, delete_all, Gr),
        \+ send(G0, empty)
    ->  true
    ;   get(Canvas?graphicals, copy, G0),
        send(G0, delete_all, Gr)
    ),
    get(G0, find_all, not(message(@arg1, instance_of, line)), G1),
    chain_list(G1, L1),
    align_graphical(Gr, L1).


align_selection(Canvas) :->
    "Align all elements of the selection"::
    send(Canvas, edit, message(Canvas, align_graphical, @arg1)).


align_graphical(Canvas, Gr:graphical) :->
    "Align a single graphical"::
    get(Canvas?graphicals, find_all,
        and(not(message(@arg1, instance_of, line)),
            not(?(@arg1, hypered, supports))),
        G0),
    send(G0, delete_all, Gr),
    chain_list(G0, L0),
    auto_adjust(resize, Gr, L0),
    align_graphical(Gr, L0).


auto_align(Canvas, Gr:graphical, How:{create,resize,move}) :->
    "Align graphical if auto_align_mode is @on"::
    (   get(Canvas, auto_align_mode, @on)
    ->  ignore(auto_align(Canvas, Gr, How))
    ;   true
    ).


auto_align(Canvas, Gr, How) :-
    get(Canvas?graphicals, find_all,
        and(not(message(@arg1, instance_of, line)),
            not(?(@arg1, hypered, supports))),
        G0),
    send(G0, delete_all, Gr),
    chain_list(G0, L0),
    auto_adjust(How, Gr, L0),
    align_graphical(Gr, L0).


auto_adjust(How, Gr, L0) :-
    (How == create ; How == resize),
    \+ send(Gr, instance_of, text),
    adjust_graphical(Gr, L0),
    !.
auto_adjust(_, _, _).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Distribute spaces between graphicals evenly.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

distribute_selection(Canvas) :->
    "Distribute selected objects"::
    get(Canvas, selection, Selection),
    send(Selection, for_all,
         if(or(message(@arg1, instance_of, connection),
               ?(@arg1, hypered, supports)),
            message(Selection, delete, @arg1))),
    get(Selection, size, Size),
    (   Size < 3
    ->  send(Canvas, report, warning, 'Need at least 3 selected objects')
    ;   side_selector(Dir, Top, Bottom, Height),
        sequence_in_dir(Selection, Dir)
    ->  get(Selection?head, Top, Y0),
        get(Selection?tail, Bottom, Y1),
        H is Y1 - Y0,
        new(HTotal, number(0)),
        send(Selection, for_all, message(HTotal, plus, @arg1?Height)),
        get(HTotal, value, HT),
        Sep is (H - HT)/(Size-1),
        chain_list(Selection, List),
        send(Canvas, open_undo_group),
        distribute(List, Y0, Dir, 0, Sep),
        send(Canvas, close_undo_group),
        send(Canvas, report, status, 'Distributed in %s-direction', Dir)
    ;   send(Canvas, report, warning, 'Cannot determine direction')
    ).

sequence_in_dir(Chain, Dir) :-
    side_selector(Dir, Sel, _, _),
    send(Chain, sort, ?(@arg1?Sel, compare, @arg2?Sel)),
    chain_list(Chain, List),
    sequence(List, Dir).

side_selector(y, top_side, bottom_side, height).
side_selector(x, left_side, right_side, width).


sequence([_], _) :- !.
sequence([H1,H2|T], y) :-
    !,
    get(H1, bottom_side, Bottom),
    get(H2, top_side, Top),
    Top >= Bottom,
    sequence([H2|T], y).
sequence([H1,H2|T], x) :-
    get(H1, right_side, R),
    get(H2, left_side, L),
    L >= R,
    sequence([H2|T], x).

distribute([], _, _, _, _).
distribute([H|T], V0, Sel, N, Sep) :-
    send(H, Sel, V0+N*Sep),
    (   Sel == y
    ->  get(H?area, height, Me)
    ;   get(H?area, width, Me)
    ),
    V1 is V0+Me,
    NN is N + 1,
    distribute(T, V1, Sel, NN, Sep).


              /********************************
              *           LOAD/SAVE           *
              ********************************/
:- pce_group(file).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Saving and loading is  currently performed  by saving the  PCE objects
using  PCE's binary  saving   algorithm.  This approach   has  several
advantages and disadvantages.  The advantages:

        * Using `Object ->save_in_file', applications whose database
          consists of a collection of PCE objects can easily save
          their data.
        * The PCE built-in loading and saving is fast.

The disadvantages

        * Binary format.  Currently no provisions for byte-order
          differences.
        * It is difficult to control what exactly will be stored on
          file.  See also the discussion on kloning with ->duplicate.
        * Significant changes to the representation of PCE-classes
          make reloading impossible.  This is notably a problem for
          loading and storing graphical information.

An alternative is to write  an  application-specific save/load that is
more robust against changes  to PCE, but may be  slow.   This kind  of
saved version can be used to convert to later versions of PCE.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
->save_as requests a filename and  then invokes `Object ->save'.   The
filename is requested   via  @finder, an instance of  the user-defined
class   `finder', defined   in  the  PCE library file  `find_file.pl'.
Linking the library is declared in the file draw.pl.

This   addresses the  general case  of  asking  for information  using
dialog-boxes.  In  earlier PCE applications it  was normal to  build a
dialog-box, display it, read the information and destroy it again.

For the file-finder,  the  reusable   object @finder is created  using
pce_global/2 construct.   Once  created,  @finder   is mapped   on and
removed-from   the display    using `Frame ->show:   @on/@off'.   This
approach is fast and allow us to remember status (such as the selected
directory) from the last time the finder was used.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

prompt_pd_file(_Canvas, Mode:{open,save}, FileName:name) :<-
    "Prompt for a load or save file"::
    get(@finder, file, Mode, tuple('PceDraw files', pd), FileName).


save_as(Canvas) :->
    "Save in user-specified file"::
    get(Canvas, prompt_pd_file, save, FileName),
    new(File, file(FileName)),
    send(Canvas, save, File),
    get(File, absolute_path, Path),
    register_recent_file(Path).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Actual saving to file.  The  toplevel-object  saved  is a sheet.  This
way we can easily add new  attributes without affecting compatibility.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

save(Canvas, File:[file]) :->
    "Save canvas in named file"::
    (   File == @default
    ->  (   get(Canvas, file, SaveFile),
            SaveFile \== @nil
        ->  true
        ;   get(Canvas, prompt_pd_file, save, SaveFileName),
            send(Canvas, file, new(SaveFile, file(SaveFileName)))
        )
    ;   send(Canvas, file, File),
        SaveFile = File
    ),
    send(SaveFile, backup),
    send(Canvas, keyboard_focus, @nil),
    get(Canvas?frame, version, Version),
    new(Sheet, sheet(attribute(graphicals, Canvas?graphicals),
                     attribute(version, Version))),
    (   get_config(draw_config:file/save_prototypes, @on)
    ->  get(Canvas?frame?menu, proto_sheet, ProtoTypes),
        send(Sheet, value, prototypes, ProtoTypes)
    ;   true
    ),
    send(Sheet, save_in_file, SaveFile),
    send(Canvas, slot, modified, @off),
    send(Sheet, free),
    new(Which, string('pd')),
    (   get_config(draw_config:file/save_postscript_on_save, @on)
    ->  send(Canvas, postscript),
        send(Which, append, '+ps')
    ;   true
    ),
    (   get_config(draw_config:file/save_metafile_on_save, @on)
    ->  send(Canvas, save_default_windows_metafile),
        send(Which, append, '+mf')
    ;   true
    ),
    send(Canvas, report, status, 'Saved (%s) %s',
         Which, SaveFile?base_name).

save_if_modified(Canvas, AllowQuit:[bool]) :->
    "Save if the drawing is modified"::
    (   get(Canvas, modified, @on)
    ->  get(Canvas, frame, Draw),
        new(D, dialog('Drawing is modified')),
        send(D, icon, Draw?icon_image),
        send(D, transient_for, Draw),
        send(D, append, label(message, 'Drawing has changed')),
        (   AllowQuit == @on
        ->  send(D, append, button('Save & Quit',
                                   message(D, return, save_and_quit))),
            send(D, append, button(quit,
                                   message(D, return, quit)))
        ;   send(D, append, button(save,
                                   message(D, return, save)))
        ),
        send(D, append, button(cancel,
                               message(D, return, cancel))),
        get(D, confirm_centered, Rval),
        send(D, destroy),
        (   Rval == save_and_quit
        ->  send(Canvas, save),
            send(Draw, destroy)
        ;   Rval == quit
        ->  send(Draw, destroy)
        ;   Rval == save
        ->  send(Canvas, save)
        )
    ;   true
    ).


load_from(Canvas) :->
    "Load from user-specified file"::
    get(Canvas, prompt_pd_file, open, File),
    send(Canvas, load, File, @on).


import(Canvas) :->
    "Add contents of user-requested file"::
    get(Canvas, prompt_pd_file, open, File),
    send(Canvas, load, File, @off).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Load specified file  and set the  file  attribute.  The PCE object  is
loaded from the file using the `File <-object: method.

NOTE:   Currently PCE provides no way for the programmer to specify
        what should happen on file errors.  This will be fixed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

load(Canvas, File:file, Clear:[bool]) :->
    "Load from named file and [clear]"::
    (    Clear == @on,
         \+ send(Canvas?graphicals, empty)
    ->   send(Canvas, save_if_modified),
         send(Canvas, clear)
    ;    true
    ),
    get(File, object, Sheet),
    get(Sheet, graphicals, Grs),
    send(Grs, for_all,
         and(message(Canvas, display, @arg1),
             message(@arg1, selected, @off))),
    send(Canvas, normalise, Grs),
    (   Clear == @on
    ->  send(Canvas, file, File)
    ;   true
    ),
    (   get(Sheet, value, version, SaveVersion)
    ->  true
    ;   SaveVersion = @nil
    ),
    (   Clear == @on,
        get(Sheet, value, prototypes, ProtoTypes)
    ->  send(Canvas?frame?menu, proto_sheet, ProtoTypes, @on)
    ;   true
    ),
    send(Canvas, convert_old_drawing, SaveVersion),
    send(Canvas, slot, modified, @off),
    send(Canvas, report, status, 'Loaded %s', File?base_name),
    get(File, absolute_path, Path),
    register_recent_file(Path),
    send(Sheet, done).

%       register_recent_file(+Path)
%
%       Register a file with the recent file list.  Allows the list to
%       grow up to 20.

register_recent_file(Path) :-
    Key = draw_config:history/recent_files,
    (   get_config(Key, Set0)
    ;   Set0 = []
    ),
    delete(Set0, Path, Set1),
    first_n(10, [Path|Set1], Set),
    set_config(Key, Set).

first_n(0, _, []) :- !.
first_n(_, [], []) :- !.
first_n(N, [H|T0], [H|T]) :-
    NN is N - 1,
    first_n(NN, T0, T).

file(Canvas, File:file*) :->
    "Set file attribute"::
    send(Canvas, slot, file, File),
    get(Canvas, frame, Draw),
    send(Draw, update_label).


                 /*******************************
                 *             VERSION          *
                 *******************************/

convert_old_drawing(Canvas, SaveVersion:real*) :->
    (   convert_old_drawing(SaveVersion, Canvas),
        fail
    ;   true
    ).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Before versions were attached to saved  figures, class draw_compound was
a subclass of class device. Now, it is   a subclass of class figure. The
code below turns the draw_compounds into valid figures.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

convert_old_drawing(@nil, Canvas) :-
    get(Canvas, find, @default,
        if(message(@arg1, instance_of, draw_compound),
           and(if(@arg1?radius == @nil,
                  and(message(@arg1, slot, status, all_active),
                      message(@arg1, slot, radius, 0),
                      message(@arg1, slot, border, 0),
                      message(@arg1, slot, pen,    0))),
               new(or)),
           new(or)),
        _).
convert_old_drawing(_, Canvas) :-
    object(@win_ansi_var),
    get(Canvas, find, @default,
        and(if(and(message(@arg1, instance_of, text),
                   @arg1?font == @win_ansi_var),
               message(@arg1, font, normal)),
            new(or)),
        _).


                /********************************
                *           POSTSCRIPT          *
                ********************************/
:- pce_group(postscript).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Create a PostScript description of the contents of the picture.

NOTE:   This should ask for options such as landscape and scaling
        factor, which can be applied to the Graphical <-postscript
        method.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

postscript(Canvas) :->
    "Write PostScript to default file"::
    get(Canvas, default_file, eps, File),
    send(Canvas, generate_postscript, File).


postscript_as(Canvas) :->
    "Write PostScript to file"::
    get(Canvas, default_file, eps, DefFile),
    get_config(draw_config:file/postscript_file_extension, Ext),
    get(@finder, file, save, Ext, @default, DefFile, FileName),
    send(Canvas, generate_postscript, FileName).


generate_postscript(Canvas, PsFile:file) :->
    "Write PostScript to named file"::
    send(PsFile, open, write),
    send(PsFile, append, Canvas?postscript),
    send(PsFile, append, string('showpage\n')),
    send(PsFile, close),
    send(Canvas, report, status,
         'Written PostScript to `%s''', PsFile?base_name).


default_file(Canvas, Ext:[name], DefName:name) :<-
    "Default name for PostScript file"::
    (   get(Canvas, file, File),
        File \== @nil
    ->  get(File, name, Name),
        file_name_extension(Base, pd, Name)
    ;   Base = scratch
    ),
    (   Ext == @default
    ->  DefName = Base
    ;   file_name_extension(Base, Ext, DefName)
    ).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Windows MetaFile generation
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

save_default_windows_metafile(Canvas) :->
    "Save default format to default file"::
    get_config(draw_config:file/meta_file_format, Fmt),
    wmf_extension(Fmt, Ext),
    get(Canvas, default_file, Ext, DefFile),
    send(Canvas, generate_metafile, DefFile, Fmt).

wmf_extension(aldus, wmf) :- !.
wmf_extension(Fmt, Fmt).

windows_metafile(Canvas, File:[file], Format:[{emf,wmf,aldus}]) :->
    "Write Windows Metafile"::
    (   Format == @default
    ->  get_config(draw_config:file/meta_file_format, Fmt)
    ;   Fmt = Format
    ),
    wmf_extension(Fmt, Ext),
    (   File == @default
    ->  get(Canvas, default_file, Ext, DefFile),
        get(@finder, file, save,
            tuple('Windows metafiles', Ext),
            @default, DefFile, TheFile)
    ;   TheFile = File
    ),
    send(Canvas, generate_metafile, TheFile, Fmt).


generate_metafile(Canvas, File:file, Format:{emf,wmf,aldus}) :->
    "Write document to file as meta-file"::
    new(MF, win_metafile),
    send(MF, draw_in, Canvas?graphicals),
    send(MF, save, File, Format),
    send(Canvas, report, status,
         'Saved as "%s" file to %s', Format, File?absolute_path).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Print  the image to the default  printer.  Also this  method should be
extended by requesting additional parameters from the user.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

print(Canvas) :->
    "Send to default printer"::
    print_canvas(Canvas).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
There are two routes to print.  On   MS-Windows  printing is achieved by
drawing on a GDI representing a printer, after which the Windows printer
driver creates printer-codes and sends them to the printer. The standard
Windows print dialog is shown by   win_printer->setup. Next we need some
calculation effort to place our diagram reasonably on the page.

In the Unix world, things go different. In general you make a PostScript
file and hand this  to  the   print-spooler,  which  will  translate the
device-independant PostScript to whatever the printer needs.

XPCE doesn't (yet)  try  to  hide   the  difference  between  these  two
approaches.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

print_canvas(Canvas) :-
    get(@pce, convert, win_printer, class, _),
    !,
    get(Canvas, default_file, Job),
    new(Prt, win_printer(Job)),
    send(Prt, setup, Canvas),
    send(Prt, open),
    get(Canvas, bounding_box, area(X, Y, W, H)),
    get(@display, dots_per_inch, size(DX, DY)),
    InchW is W/DX,
    InchH is H/DY,

    get(Prt, size, size(PW0, PH0)),
    get(Prt, dots_per_inch, size(RX, RY)),
    MarX is RX,                     % default 1 inch margins
    MarY is RY,
    PrInchW is (PW0-MarX*2)/RX,
    PrInchH is (PH0-MarY*2)/RY,

    send(Prt, map_mode, isotropic),
    (   InchW < PrInchW,
        InchH < PrInchH             % it fits on the page
    ->  OX is MarX + ((PrInchW-InchW)/2)*RX,
        send(Prt, window, area(X, Y, DX, DY)),
        send(Prt, viewport, area(OX, MarY, RX, RY))
    ;   Aspect is min(PrInchW/InchW, PrInchH/InchH),
        ARX is integer(Aspect*RX),
        ARY is integer(Aspect*RY),
        send(Prt, window, area(X, Y, DX, DY)),
        send(Prt, viewport, area(MarX, MarY, ARX, ARY))
    ),
    send(Prt, draw_in, Canvas?graphicals),
    send(Prt, close),
    free(Prt).
print_canvas(Canvas) :-
    get(Canvas, default_printer, Printer),
    new(PsFile, file),
    send(PsFile, open, write),
    send(PsFile, append, Canvas?postscript),
    send(PsFile, append, 'showpage\n'),
    send(PsFile, close),
    get(PsFile, absolute_path, File),
    get_config(draw_config:print/print_command, CmdTempl),
    print_cmd(CmdTempl, Printer, File, Cmd),
    pce_shell_command('/bin/sh'('-c', Cmd)),
    send(PsFile, remove),
    send(PsFile, done),
    send(Canvas, report, status, 'Sent to printer `%s''', Printer).


default_printer(Canvas, Printer:name) :<-
    "Get name of the printer"::
    get(Canvas, frame, Draw),
    default_printer(Draw, DefPrinter),
    new(D, dialog('PceDraw: printer?')),
    send(D, append, new(P, text_item(printer, DefPrinter))),
    send(D, append, button(cancel, message(D, return, @nil))),
    send(D, append, button(ok, message(D, return, P?selection))),
    send(D, default_button, ok),
    send(D, transient_for, Draw),
    send(D, modal, transient),
    get(D, confirm_centered, Canvas?frame?area?center, Answer),
    send(D, destroy),
    Answer \== @nil,
    Printer = Answer.

default_printer(_, Printer) :-
    get_config(draw_config:print/printer, Printer0),
    Printer0 \== @default,
    !,
    (   get(Printer0, scan, '$%[a-zA-Z0-9_]', vector(VarName)),
        get(@pce, environment_variable, VarName, Printer)
    ->  true
    ;   Printer = Printer0
    ).
default_printer(_, Printer) :-
    get(@pce, environment_variable, 'PRINTER', Printer),
    !.
default_printer(_, postscript).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
print_cmd(+Template, +Printer, +File,  -Command)   determines  the shell
command to execute in order to get `File' printed on `Printer' using the
given template. The substitutions are handled by a regex object.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

print_cmd(Template, Printer, File, Cmd) :-
    new(S, string('%s', Template)),
    substitute(S, '%p', Printer),
    substitute(S, '%f', File),
    get(S, value, Cmd),
    free(S).

substitute(S, F, T) :-
    new(R, regex(F)),
    send(R, for_all, S,
         message(@arg1, replace, @arg2, T)),
    free(R).


                /********************************
                *             MODES             *
                ********************************/
:- pce_group(mode).

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Switch the mode of the editor.  The mode determines which gestures are
active  (see `gesture.pl') and  therefore what  happens on some event.
For each mode, a cursor is defined to indicate the mode to the user.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

mode(Canvas, Mode:name, Cursor:cursor*) :->
    "Set the mode of the canvas"::
    send(Canvas, cursor, Cursor),
    send(Canvas, slot, mode, Mode),
    send(Canvas, keyboard_focus, @nil),
    send(Canvas, selection, @nil),
                                    % cleanup pending operations
    (   get(Canvas, focus_recogniser, R),
        R \== @nil
    ->  (   send(R, has_send_method, cancel)
        ->  send(R, cancel)
        ;   true
        ),
        send(Canvas, focus, @nil)
    ;   true
    ).

:- pce_end_class.