/* 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).