/*  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)  2003-2011, 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(pce_grapher,
          [ grapher/1,                  % +Message
            grapher/2                   % +Grapher, +Message
          ]).
:- set_prolog_flag(generate_debug_info, false).
:- use_module(library(pce)).
:- use_module(library(pce_util)).
:- use_module(library(pce_tagged_connection)).
:- use_module(library(print_graphics)).
:- use_module(library(lists)).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The pce_grapher library is created  to   provide  graph visualisation in
Prolog programs. Operations on  the  grapher   are  undoable  to support
backtracing Prolog predicates. In its simple mode one predicate is used:
grapher/1. The argument is either a single   action or (more commonly) a
list of actions. Actions in  the  simple   mode  of  operation are given
below. Please study the source for more complicated operations.

        * node(Node [, Image])
        Add named node to the graph if it is not already there.  If
        Image is provided it must be an XPCE graphical and will be used
        instead of the default small circle.  If Node already exists and
        Image is provided the image is changed.  Examples:

                node(amsterdam)
                node(amsterdam, box(7,7))
                node(amsterdam, bitmap('amsterdam.gif'))

        * arc(From, To)
          arc(From, To, Label)
          arc(From, To, Option ...)
        Add an arc between two nodes.  If one of the two nodes is not
        in the graph it is added to the graph.  If Label is present the
        given label is added to the link.  Options are of the form
        Name := Value where the options below are provided.  Options
        may be in any order but must follow the From and To.

                + label := Atom
                  As arc(From, To, Label)
                + pen := Integer
                  Thickness of the drawing pen.  Default is 1.  Must
                  be zero or more.
                + colour := Colour
                  Colour of the link.  Default is black.  Colours can
                  be specified by name or as '#RRGGBB' where RR, GG and
                  BB are the hexadecimal red, green and blue components.
                  Colournames can be found using the ?- manpce. tool using
                  "File/Demo programs" and selecting one of "Colours" or
                  "HSV Colours"
                + arrows := Arrows
                  Where Arrows is one of none, first, second or both with
                  the obvious meaning.

        * selected(Node [, Boolean])
          selected(From, To, [, Boolean])
        Select (highlight) a node or link.  Default is to select the
        object,  Using @off for Boolean the object is deselected.

        * selection(Node)
        Deselect all nodes and relations and select the specified Node.

        * selection(Nodes)
        Deselect all nodes and relations and select the members of the
        given list of nodes.

        * selection(@nil)
        Deselect all nodes.

        * clear
        Remove everything.  This operation cannot be undone.

        * step
        Wait and display a menu to single step, fast-forward or abort.
        If the stepper-mode is fast_forward or Prolog is in the tracer
        the step operation is ignored.

        * mode(Mode)
        If Mode is `step', the step operation will stop.  If `fast_forward'
        it will simply be a no-op.

        * persist
        Normally used at the end of an action to make a non-backtrackable
        change.

EXAMPLES
========

Assume  we  have  a   predicate    train(From,   To,   Train)  providing
train-connections  between  named  stations  with  a  named  train.  The
following draws the initial graph and if it   exists resets it to a sane
state.

  train_graph :-
          findall(arc(From, To), train(From, To, _), Arcs),
          grapher([ clear,              % Clear the graph
                    mode(step),         % Use single stepping
                    Arcs,               % Add the graphs
                    persist             % Do not allow backtracing
                  ]).

To change the circle from the station of departure to a box and select
it, do:

        grapher([ node(Departure, box(7,7)),
                  selection(Departure)
                ])

To visualise transition from Here to Next  using a given Train and wait,
use the call below. Arrows := second adds an arrow to the link.

        grapher([ arc(Here, Next, Train, arrows := second),
                  selection(Next),      % Select Next
                  step                  % Single step
                ])

The exmple above draws the entire station graph before searching a path.
This graph can also be built incrementally.  In this case we initialise
the system using:

        grapher([ clear,
                  node(Departure, box(7,7)),
                  persist,              % persist this
                  selection(Departure)
                ])

and we draw the steps using the call   below. Note that we first add the
link, make it persistent, then add the   train information (which can be
undone), select our location and wait for the user.

        grapher([ arc(Here, Next),      % Add arc
                  persist,              % ... persistent
                  arc(Here, Next, Train, arrows := second),
                  selection(Next),      % Select Next
                  step                  % Single step
                ])


PROBLEMS
========

Besides being written in a hurry and not  yet well tested there are some
integration problems with this code that make it less ideal.

        * Backtracking and cuts
        If the choicepoint of grapher/1 is destroyed using a cut the
        current implementation cannot undo if backtracking happens at
        a higher level.  The current SWI-Prolog implementation doesn't
        give a sensible way to avoid that problem.

        * Tracing
        Although this module is locked as a system module, it is not
        unlikely to make debugging harder due to the extra choicepoints
        created.

        * Undo
        Not all operations can be undo and the undo isn't very relyable
        if arbitrary operations are executed on the grapher.  Notably
        using an undoable operation followed by `clear' will cause troubles
        if the action is actually undone.  Use `clear' only at initialisation.

        * Abort
        Is quite likely to fail from time to time.  This must be fixed in
        the XPCE/SWI-Prolog interaction.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

:- pce_global(@grapher, make_grapher). :- pce_global(@grapher_undo,
                  new(var('chain*', grapher_undo, @nil))).
:- pce_global(@grapher_app, make_grapher_app).

make_grapher_app(A) :-
    new(A, application(grapher)),
    send(A, kind, service).

make_grapher(G) :-
    send(new(G, grapher), open),
    send(G, wait).

%!  grapher(+MessageOrList)
%
%   Send a message or list of messages to the grapher.  Leaves a
%   choicepoint which undos the modifications if we backtrack into
%   it.

grapher(Message) :-
    grapher(@grapher, Message).

grapher(G, Message) :-
    append(Actions, [persist], Message),
    !,
    actions(Actions, G),
    send(G, flush).
grapher(G, Message) :-
    new(Undo, chain),
    (   send(@grapher_undo, assign, Undo),
        call_cleanup(actions(Message, G),
                     send(@grapher_undo, assign, @nil))
    ;   send(Undo, for_all,
             message(@arg1, execute)),
        fail
    ),
    notrace(send(G, flush)).

actions([], _) :- !.
actions([H|T], G) :-
    !,
    actions(H, G),
    actions(T, G).
actions(persist, _) :-
    !,
    send(@grapher_undo, clear).
actions(step, G) :-
    !,
    (   tracing
    ->  true
    ;   get(G, mode, fast_forward)
    ->  true
    ;   notrace(get(G, prompt_step, Action)),
        (   Action == forward
        ->  true
        ;   Action == fast_forward
        ->  send(G, mode, fast_forward)
        ;   Action == abort
        ->  abort
        )
    ).
actions(Msg, G) :-
    notrace(send(G, Msg)).

undoable :-
    \+ get(@grapher_undo, '_value', @nil).

                 /*******************************
                 *         GRAPHER WINDOW       *
                 *******************************/

resource(forward,      image, image('16x16/vcr_forward.xpm')).
resource(fast_forward, image, image('16x16/vcr_fast_forward.xpm')).
resource(layout,       image, image('16x16/graph.xpm')).
resource(abort,        image, library('trace/icons/abort.xpm')).


:- pce_begin_class(grapher, picture,
                   "Picture showing graph").
:- use_class_template(print_graphics).

variable(nodes,     hash_table := new(hash_table), get,
         "Id --> node table").
variable(new_nodes, chain := new(chain),           get,
         "Nodes added since last ->layout").
variable(layouting, bool := @off, get,
         "Layout is in progress").
variable(mode,      {step,fast_forward} := step,   both,
         "Mode of operation").

class_variable(size,    size,  size(400,400)).

initialise(G, Label:[name], Size:[size]) :->
    default(Label, 'SWI-Prolog Grapher', TheLabel),
    send_super(G, initialise, TheLabel, Size),
    send(G, application, @grapher_app),
    send(G, create_popup).

:- pce_group(arcs).

arc(G, From:from=name, To:to=name,
    Label:label=[name]*,
    Pen:pen=[int],
    Colour:colour=[colour],
    Arrows:arrows=[{first,second,both}]) :->
    "Add an arc with parameters"::
    get(G, node, From, @on, FN),
    get(G, node, To, @on, TN),
    get(FN, connect, TN, C),
    (   Arrows \== @default,
        \+ get(C, from_node, FN)
    ->  reverse_arrows(Arrows, Arrs)
    ;   Arrs = Arrows
    ),
    if_provided(C, label,  Label),  % textual or graphics label
    if_provided(C, pen,    Pen),    % thickness of the line
    if_provided(C, colour, Colour), % colour of the line
    if_provided(C, arrows, Arrs).   % arrows at its ends

reverse_arrows(second, first).
reverse_arrows(first,  second).
reverse_arrows(both,   both).

if_provided(_, _, @default) :- !.
if_provided(Obj, Method, Value) :-
    Msg =.. [Method,Value],
    (   undoable
    ->  get(Obj, Method, Old),
        send(@grapher_undo, prepend,
             message(Obj, Method, Old))
    ;   true
    ),
    send(Obj, Msg).

:- pce_group(nodes).

node(G, Name:label=name, Img:image=[image|graphical]) :->
    "Find/create a new node"::
    get(G, node, Name, @on, Img, _Node).

node(G, Name:label=name, Create:create=[bool], Img:image=[image|graphical],
     Node:graph_node) :<-
    "Find/create a new node"::
    get(G, nodes, Nodes),
    (   get(Nodes, member, Name, Node)
    ->  (   Img == @default
        ->  true
        ;   send(Node, image, Img)
        )
    ;   Create == @on
    ->  get(G, create_node, Name, Img, Node),
        send(G, append, Node),
        (   undoable
        ->  send(@grapher_undo, prepend,
                 message(Node, destroy))
        ;   true
        )
    ).

to_node(G, From:[name|graph_node], Node:graph_node) :<-
    "Convert to a node"::
    (   atom(From)
    ->  get(G, node, From, Node)
    ;   Node = From
    ).

create_node(_G, Name:label=name, Img:image=[image|graphical],
            Node:graph_node) :<-
    "Create a new node from with given label"::
    new(Node, graph_node(Name, Img)).

:- pce_group(highlight).

%       ->selected: From, Selected
%       ->selected: From, To, Selected

selected(G, From:name, To:[bool|name], Selected:[bool]) :->
    "Highlight node or connection"::
    default(Selected, @on, Val),
    get(G, node, From, FN),
    (   atom(To)                    % an arc
    ->  default(Selected, @on, Val),
        get(G, node, To, TN),
        get(FN, connected, TN, C),
        send(C, selected, Val)
    ;   default(To, @on, Val)
    ->  send(FN, selected, Val)
    ).

selection(G, Obj:'name|graphical|chain*') :->
    "Set selection (using undo)"::
    (   undoable
    ->  get(G, selection, Old),
        send(@grapher_undo, prepend,
             message(G, selection, Old))
    ;   true
    ),
    (   Obj == @nil
    ->  send_super(G, selection, Obj)
    ;   atom(Obj)
    ->  get(G, node, Obj, Node),
        send_super(G, selection, Node)
    ;   get(Obj, map, ?(G, to_node, @arg1), Nodes),
        send_super(G, selection, Nodes)
    ).

flash(G, From:name, To:[name], Time:[real]) :->
    "Highlight for some time"::
    default(Time, 0.2, Delay),
    send(G, selected, From, To, @on),
    send(timer(Delay), delay),
    send(G, selected, From, To, @off).

:- pce_group(part).

append(G, N:'name|graph_node') :->
    "Display node at computed position"::
    (   atom(N)
    ->  get(G, create_node, N, Node)
    ;   Node = N
    ),
    send(G, place_random, Node),
    send(G, display, Node),
    get(Node, name, Name),
    send(G?nodes, append, Name, Node),
    send(G?new_nodes, append, Node).

deleted_node(G, N:graph_node) :->
    "Node was deleted; update <-nodes"::
    get(N, name, Name),
    send(G?nodes, delete, Name),
    send(G?new_nodes, delete_all, N).

clear(G) :->
    "Really destroy all nodes and arcs"::
    send_super(G, clear, destroy).

:- pce_group(layout).

place_random(G, N:graphical) :->
    "Place N at random location (first in middle)"::
    get(N?area, size, size(W, H)),
    get(G, visible, area(X, Y, PW, PH)),
    (   send(G?graphicals, empty)
    ->  GX is X +(PW-W)//2,
        GY is Y +(PH-H)//2
    ;   B is 10,                    % Border
        GX is X + B + random(PW-W-2*B),
        GY is Y + B + random(PH-H-2*B)
    ),
    send(N, set, GX, GY).

layout(D, All:all=[bool], Animate:animate=[bool]) :->
    "Produce automatic layout"::
    send(D, slot, layouting, @on),
    call_cleanup(layout(D, All, Animate),
                 send(D, slot, layouting, @off)).

layout(D, All, Animate) :-
    new(Nodes, chain),
    send(D?graphicals, for_all,
         if(message(@arg1, instance_of, graph_node),
            message(Nodes, append, @arg1))),
    get(D, visible, Area),
    (   All == @on
    ->  MoveOnly = @default,
        send(D, save_positions, Nodes)
    ;   get(D, new_nodes, MoveOnly),
        send(D, save_positions, MoveOnly)
    ),
    (   MoveOnly \== @default,
        send(MoveOnly, empty)
    ->  true
    ;   Animate == @off
    ->  send(Nodes?head, layout, 2, 40,
             iterations := 200,
             area := Area,
             network := Nodes,
             move_only := MoveOnly)
    ;   Steps = 50,                 % Animated move
        Interations is 200//50,
        (   between(1, Steps, _),
            send(Nodes?head, layout, 2, 40,
                 iterations := Interations,
                 area := Area,
                 network := Nodes,
                 move_only := MoveOnly),
            (   get(D, request_compute, @nil)
            ->  true                % No object has been moved
            ;   send(D, flush),
                sleep(0.01),
                fail
            )
        ;   true
        )
    ->  true
    ),
    send(D?new_nodes, clear).

save_positions(_D, For:chain) :->
    "Save positions if undoable"::
    (   undoable
    ->  chain_list(For, List),
        (   member(Gr, List),
            get(Gr, position, P),
            send(@grapher_undo, prepend, message(Gr, position, P)),
            fail
        ;   true
        )
    ;   true
    ).

compute(D) :->
    "Incorporate layout of new nodes"::
    (   get(D, layouting, @off),
        get(D, new_nodes, New),
        \+ send(New, empty)
    ->  send(D, layout, animate := @off)
    ;   true
    ),
    send_super(D, compute).

reset(D) :->
    "Extend graceful recovery reset after a crash"::
    send_super(D, reset),
    send(D, slot, layouting, @off).

:- pce_group(event).

create_popup(G) :->
    send(G, popup, new(P, popup)),
    new(NonEmpty, not(message(G?graphicals, empty))),
    send_list(P, append,
              [ menu_item(layout,
                          message(G, layout, @on),
                          condition := NonEmpty),
                gap,
                menu_item(print,
                          message(G, print),
                          condition := NonEmpty),
                menu_item(copy_graph,
                          message(G, copy_graph),
                          condition := @pce?window_system == windows),
                menu_item(clear,
                          message(G, clear),
                          condition := NonEmpty)
              ]).

step(G) :->
    "Step for next action"::
    send(G, flush),
    (   get(G, mode, step)
    ->  get(G, prompt_step, Action),
        (   Action == forward
        ->  true
        ;   Action == fast_forward
        ->  send(G, mode, fast_forward)
        ;   Action == abort
        ->  abort
        )
    ;   true
    ).

prompt_step(G, Reply:{forward,fast_forward,abort}) :<-
    "Prompt for single step operation"::
    send(@display, synchronise),
    new(D, dialog('Step grapher')),
    send(D, gap, size(0,0)),
    send(D, border, size(3,3)),
    send(D, append,
         new(F, button(forward, message(D, return, forward)))),
    send(D, append,
         new(FF, button(fast_forward, message(D, return, fast_forward)))),
    send(D, append,
         new(L, button(layout, message(G, layout, @on)))),
    send(D, append,
         new(A, button(abort, message(D, return, abort)))),
    send(F,  label, image(resource(forward))),
    send(FF, label, image(resource(fast_forward))),
    send(A,  label, image(resource(abort))),
    send(L,  label, image(resource(layout))),
    (   true
    ->  send(D?tile, border, 0),    % Dubious.  Why is there a tile?
        send(D, create),
        get(D, area, area(_,_,DW,DH)),
        get(G, visible, area(X,Y,W,H)),
        DX is X+W-DW,
        DY is Y+H-DH,
        send(D, do_set, DX, DY),
        send(G, display, D),
        get(D, confirm, Reply)
    ;   get(D, frame, Frame),
        send(Frame, kind, popup),
        send(Frame, create),
        get(Frame, area, area(_,_,W,H)),
        get(G, area, area(_,_,DW,DH)),
        get(G, display_position, point(X,Y)),
        FX is X+DW-W,
        FY is Y+DH-H,
        send(D, transient_for, G?frame),
        send(D, modal, transient),
        get(D, confirm, point(FX, FY), Reply)
    ),
    send(D, destroy).

:- pce_group(clipboard).


copy_graph(Canvas) :->
    "Export to the Windows clipboard"::
    new(MF, win_metafile),
    get(Canvas?graphicals, copy, Graphicals),
    send(Graphicals, for_all,
         if(message(@arg1, instance_of, window),
            message(Graphicals, delete, @arg1))),
    send(MF, draw_in, Graphicals),
    send(@display, selection_owner, MF,
         primary,                   % which
         @receiver,                 % fetch object
         message(@receiver, free),  % loose selection
         emf),
    send(Canvas, report, status, 'Placed graph on clipboard').

:- pce_end_class(grapher).


                 /*******************************
                 *             NODES            *
                 *******************************/

:- pce_begin_class(graph_node(name), device,
                   "Node in a graph").

variable(highlight, bool := @off, get, "Selected state").

:- pce_global(@graph_node_format, make_graph_node_format).

make_graph_node_format(F) :-
    new(F, format(horizontal, 1, @on)),
    send(F, row_sep, 0),
    send(F, adjustment, vector(center)).

:- pce_global(@graph_north_handle, new(handle(w/2, 0, graph, north))).
:- pce_global(@graph_south_handle, new(handle(w/2, h, graph, south))).
:- pce_global(@graph_west_handle,  new(handle(0, h/2, graph, west))).
:- pce_global(@graph_east_handle,  new(handle(w, h/2, graph, east))).

initialise(N, Name:name, Image:[image|graphical]) :->
    "Create from Name and Image"::
    send_super(N, initialise),
    send(N, name, Name),
    send(N, format, @graph_node_format),
    (   Image == @default
    ->  get(N, default_image, Img)
    ;   send(Image, instance_of, image)
    ->  new(Img, bitmap(Image))
    ;   Img = Image
    ),
    send(N, prepare_image, Img),
    send(N, display, Img),
    send(N, display, text(Name)).

device(N, Dev:device*) :->
    "Chance device (admin)"::
    (   Dev == @nil,
        get(N, device, Old),
        send(Old, instance_of, grapher)
    ->  send(Old, deleted_node, N)
    ;   true
    ),
    send_super(N, device, Dev).

default_image(_N, Img:graphical) :<-
    "Default node image"::
    new(Img, circle(7)),
    send(Img, pen, 2).

prepare_image(_N, Img:graphical) :->
    "Prepare image for creating connections"::
    send_list(Img, handle,
              [ @graph_north_handle,
                @graph_south_handle,
                @graph_west_handle,
                @graph_east_handle
              ]),
    send(Img, name, image).

image(N, Img:graphical) :->
    get(N, image, Old),
    (   undoable
    ->  send(@grapher_undo, prepend,
             message(N, image, Old))
    ;   true
    ),
    send(Old, device, @nil),
    (   get_chain(Old, connections, List),
        member(C, List),
        get(C, from, From),
        get(C, to, To),
        (   Old == From
        ->  send(C, relate, Img, To)
        ;   send(C, relate, From, Img)
        ),
        fail
    ;   true
    ),
    send(N, prepare_image, Img),
    send(N, display, Img),
    send(Img, hide).                % make top one

:- pce_group(part).

image(N, Img:graphical) :<-
    get(N, member, image, Img).

label(N, Label:text) :<-
    get(N, member, text, Label).

:- pce_group(connect).

connect(N, To:graph_node, C:graph_connection) :<-
    "Return existing/create connection"::
    (   get(N, connected, To, C)
    ->  true
    ;   new(C, graph_connection(N, To))
    ).

connect(N, To:graph_node, Label:[name]) :->
    "Create connection with attributes"::
    get(N, connect, To, C),
    send(C, label, Label).

connected(N, To:graph_node, Link:[link], FN:[name], TN:[name],
          C:graph_connection) :<-
    "Find connection between two nodes"::
    get(N, image, FromImg),
    get(To, image, ToImg),
    get(FromImg, connected, ToImg, Link, FN, TN, C).

:- pce_group(selected).

selected(N, Val:bool) :<-
    get(N, highlight, Val).

selected(N, Val:bool) :->
    "Pretty selected visualisation"::
    get(N, selected, Old),
    (   Val == Old
    ->  true
    ;   send(N, slot, highlight, Val),
        send(N?graphicals, for_all,
             message(@arg1, selected, Val)),
        (   undoable
        ->  send(@grapher_undo, prepend,
                 message(N, selected, Old))
        ;   true
        )
    ).

:- pce_group(event).

:- pce_global(@graph_node_recogniser, make_graph_node_recogniser).
:- pce_global(@graph_node_popup, make_graph_node_popup).

make_graph_node_recogniser(G) :-
    new(C, move_gesture(left)),
    new(P, popup_gesture(@receiver?popup)),
    new(G, handler_group(P, C)).

make_graph_node_popup(P) :-
    Node = @arg1,
    new(P, popup),
    send_list(P, append,
              [ menu_item(delete,
                          message(Node, destroy))
              ]).

event(N, Ev:event) :->
    (   send_super(N, event, Ev)
    ->  true
    ;   send(@graph_node_recogniser, event, Ev)
    ).

popup(_, Popup:popup) :<-
    "Popup menu for the node"::
    Popup = @graph_node_popup.

:- pce_end_class(graph_node).


                 /*******************************
                 *             LINK             *
                 *******************************/

:- pce_global(@graph_link, new(link(graph, graph, @default,
                                    graph_connection))).

:- pce_begin_class(graph_connection, tagged_connection,
                   "Connection between two nodes").

variable(highlight, bool := @off, get, "Selected state").
variable(saved_pen, int*,         get, "Pen saved over selection").

class_variable(label_font, font, italic).

initialise(C, From:graph_node, To:graph_node,
           Link:[link], FH:[name], TH:[name]) :->
    "Create connection between two graph nodes"::
    default(Link, @graph_link, TheLink),
    get(From, image, IF),
    get(To, image, TF),
    send_super(C, initialise, IF, TF, TheLink, FH, TH).

label(C, Label:[name|graphical]*) :->
    "Label the arc"::
    (   Label == @default           % @default: leave as is
    ->  true
    ;   Label == @nil               % @nil: no label
    ->  send(C, tag, @nil)
    ;   atom(Label)                 % atom: opaque italic text
    ->  get(C, label_font, Font),
        send(C, tag, new(T, text(Label, center, Font))),
        send(T, background, @default)
    ;   send(C, tag, Label)         % graphical: use as label
    ).

label(C, Label:'name|graphical*') :<-
    "Current label"::
    get(C, tag, Tag),
    (   Tag == @nil
    ->  Label = @nil
    ;   get(Tag, class_name, text)  % dubious.  Should _know_ it is
    ->  get(Tag, string, Label)     % a default text
    ;   Label = Tag
    ).

:- pce_group(selection).

selected(C, Val:bool) :<-
    get(C, highlight, Val).

selected(C, Val:bool) :->
    "Pretty selected visualisation"::
    get(C, selected, Old),
    (   Val == Old
    ->  true
    ;   send(C, slot, highlight, Val),
        (   Val == @on
        ->  get(C, pen, Pen),
            send(C, slot, saved_pen, Pen),
            NewPen is Pen + 1,
            send_super(C, pen, NewPen)
        ;   get(C, saved_pen, Pen),
            send_super(C, pen, Pen)
        ),
        (   get(C, tag, Tag),
            Tag \== @nil
        ->  send(Tag, selected, Val)
        ;   true
        ),
        (   undoable
        ->  send(@grapher_undo, prepend,
                 message(C, selected, Old))
        ;   true
        )
    ).

pen(C, P:'0..') :->
    "Set pen (consider selection)"::
    send(C, slot, saved_pen, P),
    (   get(C, highlight, @on),
        NP is P + 1
    ;   NP = P
    ),
    send_super(C, pen, NP).


                 /*******************************
                 *               C              *
                 *******************************/

from_node(C, N:graph_node) :<-
    "Graph-node at `from' side"::
    get(C, from, Img),
    Img \== @nil,
    get(Img, device, N).

to_node(C, N:graph_node) :<-
    "Graph-node at `to' side"::
    get(C, to, Img),
    Img \== @nil,
    get(Img, device, N).

:- pce_end_class(graph_connection).