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)  2003-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_grapher,
   36          [ grapher/1,                  % +Message
   37            grapher/2                   % +Grapher, +Message
   38          ]).   39:- set_prolog_flag(generate_debug_info, false).   40:- use_module(library(pce)).   41:- use_module(library(pce_util)).   42:- use_module(library(pce_tagged_connection)).   43:- use_module(library(print_graphics)).   44:- use_module(library(lists)).   45
   46
   47/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   48The pce_grapher library is created  to   provide  graph visualisation in
   49Prolog programs. Operations on  the  grapher   are  undoable  to support
   50backtracing Prolog predicates. In its simple mode one predicate is used:
   51grapher/1. The argument is either a single   action or (more commonly) a
   52list of actions. Actions in  the  simple   mode  of  operation are given
   53below. Please study the source for more complicated operations.
   54
   55        * node(Node [, Image])
   56        Add named node to the graph if it is not already there.  If
   57        Image is provided it must be an XPCE graphical and will be used
   58        instead of the default small circle.  If Node already exists and
   59        Image is provided the image is changed.  Examples:
   60
   61                node(amsterdam)
   62                node(amsterdam, box(7,7))
   63                node(amsterdam, bitmap('amsterdam.gif'))
   64
   65        * arc(From, To)
   66          arc(From, To, Label)
   67          arc(From, To, Option ...)
   68        Add an arc between two nodes.  If one of the two nodes is not
   69        in the graph it is added to the graph.  If Label is present the
   70        given label is added to the link.  Options are of the form
   71        Name := Value where the options below are provided.  Options
   72        may be in any order but must follow the From and To.
   73
   74                + label := Atom
   75                  As arc(From, To, Label)
   76                + pen := Integer
   77                  Thickness of the drawing pen.  Default is 1.  Must
   78                  be zero or more.
   79                + colour := Colour
   80                  Colour of the link.  Default is black.  Colours can
   81                  be specified by name or as '#RRGGBB' where RR, GG and
   82                  BB are the hexadecimal red, green and blue components.
   83                  Colournames can be found using the ?- manpce. tool using
   84                  "File/Demo programs" and selecting one of "Colours" or
   85                  "HSV Colours"
   86                + arrows := Arrows
   87                  Where Arrows is one of none, first, second or both with
   88                  the obvious meaning.
   89
   90        * selected(Node [, Boolean])
   91          selected(From, To, [, Boolean])
   92        Select (highlight) a node or link.  Default is to select the
   93        object,  Using @off for Boolean the object is deselected.
   94
   95        * selection(Node)
   96        Deselect all nodes and relations and select the specified Node.
   97
   98        * selection(Nodes)
   99        Deselect all nodes and relations and select the members of the
  100        given list of nodes.
  101
  102        * selection(@nil)
  103        Deselect all nodes.
  104
  105        * clear
  106        Remove everything.  This operation cannot be undone.
  107
  108        * step
  109        Wait and display a menu to single step, fast-forward or abort.
  110        If the stepper-mode is fast_forward or Prolog is in the tracer
  111        the step operation is ignored.
  112
  113        * mode(Mode)
  114        If Mode is `step', the step operation will stop.  If `fast_forward'
  115        it will simply be a no-op.
  116
  117        * persist
  118        Normally used at the end of an action to make a non-backtrackable
  119        change.
  120
  121EXAMPLES
  122========
  123
  124Assume  we  have  a   predicate    train(From,   To,   Train)  providing
  125train-connections  between  named  stations  with  a  named  train.  The
  126following draws the initial graph and if it   exists resets it to a sane
  127state.
  128
  129  train_graph :-
  130          findall(arc(From, To), train(From, To, _), Arcs),
  131          grapher([ clear,              % Clear the graph
  132                    mode(step),         % Use single stepping
  133                    Arcs,               % Add the graphs
  134                    persist             % Do not allow backtracing
  135                  ]).
  136
  137To change the circle from the station of departure to a box and select
  138it, do:
  139
  140        grapher([ node(Departure, box(7,7)),
  141                  selection(Departure)
  142                ])
  143
  144To visualise transition from Here to Next  using a given Train and wait,
  145use the call below. Arrows := second adds an arrow to the link.
  146
  147        grapher([ arc(Here, Next, Train, arrows := second),
  148                  selection(Next),      % Select Next
  149                  step                  % Single step
  150                ])
  151
  152The exmple above draws the entire station graph before searching a path.
  153This graph can also be built incrementally.  In this case we initialise
  154the system using:
  155
  156        grapher([ clear,
  157                  node(Departure, box(7,7)),
  158                  persist,              % persist this
  159                  selection(Departure)
  160                ])
  161
  162and we draw the steps using the call   below. Note that we first add the
  163link, make it persistent, then add the   train information (which can be
  164undone), select our location and wait for the user.
  165
  166        grapher([ arc(Here, Next),      % Add arc
  167                  persist,              % ... persistent
  168                  arc(Here, Next, Train, arrows := second),
  169                  selection(Next),      % Select Next
  170                  step                  % Single step
  171                ])
  172
  173
  174PROBLEMS
  175========
  176
  177Besides being written in a hurry and not  yet well tested there are some
  178integration problems with this code that make it less ideal.
  179
  180        * Backtracking and cuts
  181        If the choicepoint of grapher/1 is destroyed using a cut the
  182        current implementation cannot undo if backtracking happens at
  183        a higher level.  The current SWI-Prolog implementation doesn't
  184        give a sensible way to avoid that problem.
  185
  186        * Tracing
  187        Although this module is locked as a system module, it is not
  188        unlikely to make debugging harder due to the extra choicepoints
  189        created.
  190
  191        * Undo
  192        Not all operations can be undo and the undo isn't very relyable
  193        if arbitrary operations are executed on the grapher.  Notably
  194        using an undoable operation followed by `clear' will cause troubles
  195        if the action is actually undone.  Use `clear' only at initialisation.
  196
  197        * Abort
  198        Is quite likely to fail from time to time.  This must be fixed in
  199        the XPCE/SWI-Prolog interaction.
  200- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  201
  202:- pce_global(@grapher, make_grapher). :- pce_global(@grapher_undo,
  203                  new(var('chain*', grapher_undo, @nil))).
  204:- pce_global(@grapher_app, make_grapher_app).  205
  206make_grapher_app(A) :-
  207    new(A, application(grapher)),
  208    send(A, kind, service).
  209
  210make_grapher(G) :-
  211    send(new(G, grapher), open),
  212    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.

  220grapher(Message) :-
  221    grapher(@grapher, Message).
  222
  223grapher(G, Message) :-
  224    append(Actions, [persist], Message),
  225    !,
  226    actions(Actions, G),
  227    send(G, flush).
  228grapher(G, Message) :-
  229    new(Undo, chain),
  230    (   send(@grapher_undo, assign, Undo),
  231        call_cleanup(actions(Message, G),
  232                     send(@grapher_undo, assign, @nil))
  233    ;   send(Undo, for_all,
  234             message(@arg1, execute)),
  235        fail
  236    ),
  237    notrace(send(G, flush)).
  238
  239actions([], _) :- !.
  240actions([H|T], G) :-
  241    !,
  242    actions(H, G),
  243    actions(T, G).
  244actions(persist, _) :-
  245    !,
  246    send(@grapher_undo, clear).
  247actions(step, G) :-
  248    !,
  249    (   tracing
  250    ->  true
  251    ;   get(G, mode, fast_forward)
  252    ->  true
  253    ;   notrace(get(G, prompt_step, Action)),
  254        (   Action == forward
  255        ->  true
  256        ;   Action == fast_forward
  257        ->  send(G, mode, fast_forward)
  258        ;   Action == abort
  259        ->  abort
  260        )
  261    ).
  262actions(Msg, G) :-
  263    notrace(send(G, Msg)).
  264
  265undoable :-
  266    \+ get(@grapher_undo, '_value', @nil).
  267
  268                 /*******************************
  269                 *         GRAPHER WINDOW       *
  270                 *******************************/
  271
  272resource(forward,      image, image('16x16/vcr_forward.xpm')).
  273resource(fast_forward, image, image('16x16/vcr_fast_forward.xpm')).
  274resource(layout,       image, image('16x16/graph.xpm')).
  275resource(abort,        image, library('trace/icons/abort.xpm')).
  276
  277
  278:- pce_begin_class(grapher, picture,
  279                   "Picture showing graph").
  280:- use_class_template(print_graphics).
  281
  282variable(nodes,     hash_table := new(hash_table), get,
  283         "Id --> node table").
  284variable(new_nodes, chain := new(chain),           get,
  285         "Nodes added since last ->layout").
  286variable(layouting, bool := @off, get,
  287         "Layout is in progress").
  288variable(mode,      {step,fast_forward} := step,   both,
  289         "Mode of operation").
  290
  291class_variable(size,    size,  size(400,400)).
  292
  293initialise(G, Label:[name], Size:[size]) :->
  294    default(Label, 'SWI-Prolog Grapher', TheLabel),
  295    send_super(G, initialise, TheLabel, Size),
  296    send(G, application, @grapher_app),
  297    send(G, create_popup).
  298
  299:- pce_group(arcs).
  300
  301arc(G, From:from=name, To:to=name,
  302    Label:label=[name]*,
  303    Pen:pen=[int],
  304    Colour:colour=[colour],
  305    Arrows:arrows=[{first,second,both}]) :->
  306    "Add an arc with parameters"::
  307    get(G, node, From, @on, FN),
  308    get(G, node, To, @on, TN),
  309    get(FN, connect, TN, C),
  310    (   Arrows \== @default,
  311        \+ get(C, from_node, FN)
  312    ->  reverse_arrows(Arrows, Arrs)
  313    ;   Arrs = Arrows
  314    ),
  315    if_provided(C, label,  Label),  % textual or graphics label
  316    if_provided(C, pen,    Pen),    % thickness of the line
  317    if_provided(C, colour, Colour), % colour of the line
  318    if_provided(C, arrows, Arrs).   % arrows at its ends
  319
  320reverse_arrows(second, first).
  321reverse_arrows(first,  second).
  322reverse_arrows(both,   both).
  323
  324if_provided(_, _, @default) :- !.
  325if_provided(Obj, Method, Value) :-
  326    Msg =.. [Method,Value],
  327    (   undoable
  328    ->  get(Obj, Method, Old),
  329        send(@grapher_undo, prepend,
  330             message(Obj, Method, Old))
  331    ;   true
  332    ),
  333    send(Obj, Msg).
  334
  335:- pce_group(nodes).
  336
  337node(G, Name:label=name, Img:image=[image|graphical]) :->
  338    "Find/create a new node"::
  339    get(G, node, Name, @on, Img, _Node).
  340
  341node(G, Name:label=name, Create:create=[bool], Img:image=[image|graphical],
  342     Node:graph_node) :<-
  343    "Find/create a new node"::
  344    get(G, nodes, Nodes),
  345    (   get(Nodes, member, Name, Node)
  346    ->  (   Img == @default
  347        ->  true
  348        ;   send(Node, image, Img)
  349        )
  350    ;   Create == @on
  351    ->  get(G, create_node, Name, Img, Node),
  352        send(G, append, Node),
  353        (   undoable
  354        ->  send(@grapher_undo, prepend,
  355                 message(Node, destroy))
  356        ;   true
  357        )
  358    ).
  359
  360to_node(G, From:[name|graph_node], Node:graph_node) :<-
  361    "Convert to a node"::
  362    (   atom(From)
  363    ->  get(G, node, From, Node)
  364    ;   Node = From
  365    ).
  366
  367create_node(_G, Name:label=name, Img:image=[image|graphical],
  368            Node:graph_node) :<-
  369    "Create a new node from with given label"::
  370    new(Node, graph_node(Name, Img)).
  371
  372:- pce_group(highlight).
  373
  374%       ->selected: From, Selected
  375%       ->selected: From, To, Selected
  376
  377selected(G, From:name, To:[bool|name], Selected:[bool]) :->
  378    "Highlight node or connection"::
  379    default(Selected, @on, Val),
  380    get(G, node, From, FN),
  381    (   atom(To)                    % an arc
  382    ->  default(Selected, @on, Val),
  383        get(G, node, To, TN),
  384        get(FN, connected, TN, C),
  385        send(C, selected, Val)
  386    ;   default(To, @on, Val)
  387    ->  send(FN, selected, Val)
  388    ).
  389
  390selection(G, Obj:'name|graphical|chain*') :->
  391    "Set selection (using undo)"::
  392    (   undoable
  393    ->  get(G, selection, Old),
  394        send(@grapher_undo, prepend,
  395             message(G, selection, Old))
  396    ;   true
  397    ),
  398    (   Obj == @nil
  399    ->  send_super(G, selection, Obj)
  400    ;   atom(Obj)
  401    ->  get(G, node, Obj, Node),
  402        send_super(G, selection, Node)
  403    ;   get(Obj, map, ?(G, to_node, @arg1), Nodes),
  404        send_super(G, selection, Nodes)
  405    ).
  406
  407flash(G, From:name, To:[name], Time:[real]) :->
  408    "Highlight for some time"::
  409    default(Time, 0.2, Delay),
  410    send(G, selected, From, To, @on),
  411    send(timer(Delay), delay),
  412    send(G, selected, From, To, @off).
  413
  414:- pce_group(part).
  415
  416append(G, N:'name|graph_node') :->
  417    "Display node at computed position"::
  418    (   atom(N)
  419    ->  get(G, create_node, N, Node)
  420    ;   Node = N
  421    ),
  422    send(G, place_random, Node),
  423    send(G, display, Node),
  424    get(Node, name, Name),
  425    send(G?nodes, append, Name, Node),
  426    send(G?new_nodes, append, Node).
  427
  428deleted_node(G, N:graph_node) :->
  429    "Node was deleted; update <-nodes"::
  430    get(N, name, Name),
  431    send(G?nodes, delete, Name),
  432    send(G?new_nodes, delete_all, N).
  433
  434clear(G) :->
  435    "Really destroy all nodes and arcs"::
  436    send_super(G, clear, destroy).
  437
  438:- pce_group(layout).
  439
  440place_random(G, N:graphical) :->
  441    "Place N at random location (first in middle)"::
  442    get(N?area, size, size(W, H)),
  443    get(G, visible, area(X, Y, PW, PH)),
  444    (   send(G?graphicals, empty)
  445    ->  GX is X +(PW-W)//2,
  446        GY is Y +(PH-H)//2
  447    ;   B is 10,                    % Border
  448        GX is X + B + random(PW-W-2*B),
  449        GY is Y + B + random(PH-H-2*B)
  450    ),
  451    send(N, set, GX, GY).
  452
  453layout(D, All:all=[bool], Animate:animate=[bool]) :->
  454    "Produce automatic layout"::
  455    send(D, slot, layouting, @on),
  456    call_cleanup(layout(D, All, Animate),
  457                 send(D, slot, layouting, @off)).
  458
  459layout(D, All, Animate) :-
  460    new(Nodes, chain),
  461    send(D?graphicals, for_all,
  462         if(message(@arg1, instance_of, graph_node),
  463            message(Nodes, append, @arg1))),
  464    get(D, visible, Area),
  465    (   All == @on
  466    ->  MoveOnly = @default,
  467        send(D, save_positions, Nodes)
  468    ;   get(D, new_nodes, MoveOnly),
  469        send(D, save_positions, MoveOnly)
  470    ),
  471    (   MoveOnly \== @default,
  472        send(MoveOnly, empty)
  473    ->  true
  474    ;   Animate == @off
  475    ->  send(Nodes?head, layout, 2, 40,
  476             iterations := 200,
  477             area := Area,
  478             network := Nodes,
  479             move_only := MoveOnly)
  480    ;   Steps = 50,                 % Animated move
  481        Interations is 200//50,
  482        (   between(1, Steps, _),
  483            send(Nodes?head, layout, 2, 40,
  484                 iterations := Interations,
  485                 area := Area,
  486                 network := Nodes,
  487                 move_only := MoveOnly),
  488            (   get(D, request_compute, @nil)
  489            ->  true                % No object has been moved
  490            ;   send(D, flush),
  491                sleep(0.01),
  492                fail
  493            )
  494        ;   true
  495        )
  496    ->  true
  497    ),
  498    send(D?new_nodes, clear).
  499
  500save_positions(_D, For:chain) :->
  501    "Save positions if undoable"::
  502    (   undoable
  503    ->  chain_list(For, List),
  504        (   member(Gr, List),
  505            get(Gr, position, P),
  506            send(@grapher_undo, prepend, message(Gr, position, P)),
  507            fail
  508        ;   true
  509        )
  510    ;   true
  511    ).
  512
  513compute(D) :->
  514    "Incorporate layout of new nodes"::
  515    (   get(D, layouting, @off),
  516        get(D, new_nodes, New),
  517        \+ send(New, empty)
  518    ->  send(D, layout, animate := @off)
  519    ;   true
  520    ),
  521    send_super(D, compute).
  522
  523reset(D) :->
  524    "Extend graceful recovery reset after a crash"::
  525    send_super(D, reset),
  526    send(D, slot, layouting, @off).
  527
  528:- pce_group(event).
  529
  530create_popup(G) :->
  531    send(G, popup, new(P, popup)),
  532    new(NonEmpty, not(message(G?graphicals, empty))),
  533    send_list(P, append,
  534              [ menu_item(layout,
  535                          message(G, layout, @on),
  536                          condition := NonEmpty),
  537                gap,
  538                menu_item(print,
  539                          message(G, print),
  540                          condition := NonEmpty),
  541                menu_item(copy_graph,
  542                          message(G, copy_graph),
  543                          condition := @pce?window_system == windows),
  544                menu_item(clear,
  545                          message(G, clear),
  546                          condition := NonEmpty)
  547              ]).
  548
  549step(G) :->
  550    "Step for next action"::
  551    send(G, flush),
  552    (   get(G, mode, step)
  553    ->  get(G, prompt_step, Action),
  554        (   Action == forward
  555        ->  true
  556        ;   Action == fast_forward
  557        ->  send(G, mode, fast_forward)
  558        ;   Action == abort
  559        ->  abort
  560        )
  561    ;   true
  562    ).
  563
  564prompt_step(G, Reply:{forward,fast_forward,abort}) :<-
  565    "Prompt for single step operation"::
  566    send(@display, synchronise),
  567    new(D, dialog('Step grapher')),
  568    send(D, gap, size(0,0)),
  569    send(D, border, size(3,3)),
  570    send(D, append,
  571         new(F, button(forward, message(D, return, forward)))),
  572    send(D, append,
  573         new(FF, button(fast_forward, message(D, return, fast_forward)))),
  574    send(D, append,
  575         new(L, button(layout, message(G, layout, @on)))),
  576    send(D, append,
  577         new(A, button(abort, message(D, return, abort)))),
  578    send(F,  label, image(resource(forward))),
  579    send(FF, label, image(resource(fast_forward))),
  580    send(A,  label, image(resource(abort))),
  581    send(L,  label, image(resource(layout))),
  582    (   true
  583    ->  send(D?tile, border, 0),    % Dubious.  Why is there a tile?
  584        send(D, create),
  585        get(D, area, area(_,_,DW,DH)),
  586        get(G, visible, area(X,Y,W,H)),
  587        DX is X+W-DW,
  588        DY is Y+H-DH,
  589        send(D, do_set, DX, DY),
  590        send(G, display, D),
  591        get(D, confirm, Reply)
  592    ;   get(D, frame, Frame),
  593        send(Frame, kind, popup),
  594        send(Frame, create),
  595        get(Frame, area, area(_,_,W,H)),
  596        get(G, area, area(_,_,DW,DH)),
  597        get(G, display_position, point(X,Y)),
  598        FX is X+DW-W,
  599        FY is Y+DH-H,
  600        send(D, transient_for, G?frame),
  601        send(D, modal, transient),
  602        get(D, confirm, point(FX, FY), Reply)
  603    ),
  604    send(D, destroy).
  605
  606:- pce_group(clipboard).
  607
  608
  609copy_graph(Canvas) :->
  610    "Export to the Windows clipboard"::
  611    new(MF, win_metafile),
  612    get(Canvas?graphicals, copy, Graphicals),
  613    send(Graphicals, for_all,
  614         if(message(@arg1, instance_of, window),
  615            message(Graphicals, delete, @arg1))),
  616    send(MF, draw_in, Graphicals),
  617    send(@display, selection_owner, MF,
  618         primary,                   % which
  619         @receiver,                 % fetch object
  620         message(@receiver, free),  % loose selection
  621         emf),
  622    send(Canvas, report, status, 'Placed graph on clipboard').
  623
  624:- pce_end_class(grapher).
  625
  626
  627                 /*******************************
  628                 *             NODES            *
  629                 *******************************/
  630
  631:- pce_begin_class(graph_node(name), device,
  632                   "Node in a graph").
  633
  634variable(highlight, bool := @off, get, "Selected state").
  635
  636:- pce_global(@graph_node_format, make_graph_node_format).  637
  638make_graph_node_format(F) :-
  639    new(F, format(horizontal, 1, @on)),
  640    send(F, row_sep, 0),
  641    send(F, adjustment, vector(center)).
  642
  643:- pce_global(@graph_north_handle, new(handle(w/2, 0, graph, north))).
  644:- pce_global(@graph_south_handle, new(handle(w/2, h, graph, south))).
  645:- pce_global(@graph_west_handle,  new(handle(0, h/2, graph, west))).
  646:- pce_global(@graph_east_handle,  new(handle(w, h/2, graph, east))).
  647
  648initialise(N, Name:name, Image:[image|graphical]) :->
  649    "Create from Name and Image"::
  650    send_super(N, initialise),
  651    send(N, name, Name),
  652    send(N, format, @graph_node_format),
  653    (   Image == @default
  654    ->  get(N, default_image, Img)
  655    ;   send(Image, instance_of, image)
  656    ->  new(Img, bitmap(Image))
  657    ;   Img = Image
  658    ),
  659    send(N, prepare_image, Img),
  660    send(N, display, Img),
  661    send(N, display, text(Name)).
  662
  663device(N, Dev:device*) :->
  664    "Chance device (admin)"::
  665    (   Dev == @nil,
  666        get(N, device, Old),
  667        send(Old, instance_of, grapher)
  668    ->  send(Old, deleted_node, N)
  669    ;   true
  670    ),
  671    send_super(N, device, Dev).
  672
  673default_image(_N, Img:graphical) :<-
  674    "Default node image"::
  675    new(Img, circle(7)),
  676    send(Img, pen, 2).
  677
  678prepare_image(_N, Img:graphical) :->
  679    "Prepare image for creating connections"::
  680    send_list(Img, handle,
  681              [ @graph_north_handle,
  682                @graph_south_handle,
  683                @graph_west_handle,
  684                @graph_east_handle
  685              ]),
  686    send(Img, name, image).
  687
  688image(N, Img:graphical) :->
  689    get(N, image, Old),
  690    (   undoable
  691    ->  send(@grapher_undo, prepend,
  692             message(N, image, Old))
  693    ;   true
  694    ),
  695    send(Old, device, @nil),
  696    (   get_chain(Old, connections, List),
  697        member(C, List),
  698        get(C, from, From),
  699        get(C, to, To),
  700        (   Old == From
  701        ->  send(C, relate, Img, To)
  702        ;   send(C, relate, From, Img)
  703        ),
  704        fail
  705    ;   true
  706    ),
  707    send(N, prepare_image, Img),
  708    send(N, display, Img),
  709    send(Img, hide).                % make top one
  710
  711:- pce_group(part).
  712
  713image(N, Img:graphical) :<-
  714    get(N, member, image, Img).
  715
  716label(N, Label:text) :<-
  717    get(N, member, text, Label).
  718
  719:- pce_group(connect).
  720
  721connect(N, To:graph_node, C:graph_connection) :<-
  722    "Return existing/create connection"::
  723    (   get(N, connected, To, C)
  724    ->  true
  725    ;   new(C, graph_connection(N, To))
  726    ).
  727
  728connect(N, To:graph_node, Label:[name]) :->
  729    "Create connection with attributes"::
  730    get(N, connect, To, C),
  731    send(C, label, Label).
  732
  733connected(N, To:graph_node, Link:[link], FN:[name], TN:[name],
  734          C:graph_connection) :<-
  735    "Find connection between two nodes"::
  736    get(N, image, FromImg),
  737    get(To, image, ToImg),
  738    get(FromImg, connected, ToImg, Link, FN, TN, C).
  739
  740:- pce_group(selected).
  741
  742selected(N, Val:bool) :<-
  743    get(N, highlight, Val).
  744
  745selected(N, Val:bool) :->
  746    "Pretty selected visualisation"::
  747    get(N, selected, Old),
  748    (   Val == Old
  749    ->  true
  750    ;   send(N, slot, highlight, Val),
  751        send(N?graphicals, for_all,
  752             message(@arg1, selected, Val)),
  753        (   undoable
  754        ->  send(@grapher_undo, prepend,
  755                 message(N, selected, Old))
  756        ;   true
  757        )
  758    ).
  759
  760:- pce_group(event).
  761
  762:- pce_global(@graph_node_recogniser, make_graph_node_recogniser).  763:- pce_global(@graph_node_popup, make_graph_node_popup).  764
  765make_graph_node_recogniser(G) :-
  766    new(C, move_gesture(left)),
  767    new(P, popup_gesture(@receiver?popup)),
  768    new(G, handler_group(P, C)).
  769
  770make_graph_node_popup(P) :-
  771    Node = @arg1,
  772    new(P, popup),
  773    send_list(P, append,
  774              [ menu_item(delete,
  775                          message(Node, destroy))
  776              ]).
  777
  778event(N, Ev:event) :->
  779    (   send_super(N, event, Ev)
  780    ->  true
  781    ;   send(@graph_node_recogniser, event, Ev)
  782    ).
  783
  784popup(_, Popup:popup) :<-
  785    "Popup menu for the node"::
  786    Popup = @graph_node_popup.
  787
  788:- pce_end_class(graph_node).
  789
  790
  791                 /*******************************
  792                 *             LINK             *
  793                 *******************************/
  794
  795:- pce_global(@graph_link, new(link(graph, graph, @default,
  796                                    graph_connection))).
  797
  798:- pce_begin_class(graph_connection, tagged_connection,
  799                   "Connection between two nodes").
  800
  801variable(highlight, bool := @off, get, "Selected state").
  802variable(saved_pen, int*,         get, "Pen saved over selection").
  803
  804class_variable(label_font, font, italic).
  805
  806initialise(C, From:graph_node, To:graph_node,
  807           Link:[link], FH:[name], TH:[name]) :->
  808    "Create connection between two graph nodes"::
  809    default(Link, @graph_link, TheLink),
  810    get(From, image, IF),
  811    get(To, image, TF),
  812    send_super(C, initialise, IF, TF, TheLink, FH, TH).
  813
  814label(C, Label:[name|graphical]*) :->
  815    "Label the arc"::
  816    (   Label == @default           % @default: leave as is
  817    ->  true
  818    ;   Label == @nil               % @nil: no label
  819    ->  send(C, tag, @nil)
  820    ;   atom(Label)                 % atom: opaque italic text
  821    ->  get(C, label_font, Font),
  822        send(C, tag, new(T, text(Label, center, Font))),
  823        send(T, background, @default)
  824    ;   send(C, tag, Label)         % graphical: use as label
  825    ).
  826
  827label(C, Label:'name|graphical*') :<-
  828    "Current label"::
  829    get(C, tag, Tag),
  830    (   Tag == @nil
  831    ->  Label = @nil
  832    ;   get(Tag, class_name, text)  % dubious.  Should _know_ it is
  833    ->  get(Tag, string, Label)     % a default text
  834    ;   Label = Tag
  835    ).
  836
  837:- pce_group(selection).
  838
  839selected(C, Val:bool) :<-
  840    get(C, highlight, Val).
  841
  842selected(C, Val:bool) :->
  843    "Pretty selected visualisation"::
  844    get(C, selected, Old),
  845    (   Val == Old
  846    ->  true
  847    ;   send(C, slot, highlight, Val),
  848        (   Val == @on
  849        ->  get(C, pen, Pen),
  850            send(C, slot, saved_pen, Pen),
  851            NewPen is Pen + 1,
  852            send_super(C, pen, NewPen)
  853        ;   get(C, saved_pen, Pen),
  854            send_super(C, pen, Pen)
  855        ),
  856        (   get(C, tag, Tag),
  857            Tag \== @nil
  858        ->  send(Tag, selected, Val)
  859        ;   true
  860        ),
  861        (   undoable
  862        ->  send(@grapher_undo, prepend,
  863                 message(C, selected, Old))
  864        ;   true
  865        )
  866    ).
  867
  868pen(C, P:'0..') :->
  869    "Set pen (consider selection)"::
  870    send(C, slot, saved_pen, P),
  871    (   get(C, highlight, @on),
  872        NP is P + 1
  873    ;   NP = P
  874    ),
  875    send_super(C, pen, NP).
  876
  877
  878                 /*******************************
  879                 *               C              *
  880                 *******************************/
  881
  882from_node(C, N:graph_node) :<-
  883    "Graph-node at `from' side"::
  884    get(C, from, Img),
  885    Img \== @nil,
  886    get(Img, device, N).
  887
  888to_node(C, N:graph_node) :<-
  889    "Graph-node at `to' side"::
  890    get(C, to, Img),
  891    Img \== @nil,
  892    get(Img, device, N).
  893
  894:- pce_end_class(graph_connection)