yap-6.3/packages/sgml/RDF/rdf_diagram.pl

/*  $Id$

    Part of SWI-Prolog SGML/XML parser

    Author:  Jan Wielemaker
    E-mail:  jan@swi.psy.uva.nl
    WWW:     http://www.swi.psy.uva.nl/projects/SWI-Prolog/
    Copying: LGPL-2.  See the file COPYING or http://www.gnu.org

    Copyright (C) 1990-2002 SWI, University of Amsterdam. All rights reserved.
*/

:- module(rdf_diagram,
	  [ rdf_diagram_from_file/1	% +File
	  ]).
:- use_module(library(pce)).
:- use_module(library(pce_tagged_connection)).
:- use_module(library(autowin)).
:- use_module(library(pce_report)).
:- use_module(library(print_graphics)).
:- use_module(library(rdf_parser)).	% get access to declared namespaces


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This file defines the class rdf_diagram, a   window capable of showing a
set of triples.

The predicate rdf_diagram_from_file(+File) is a   simple demo and useful
tool to show RDF from simple RDF files.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */


		 /*******************************
		 *	    SIMPLE ENTRY	*
		 *******************************/

%	rdf_diagram_from_file(+File)
%	
%	Show the triples from File in a window.

rdf_diagram_from_file(File) :-
	absolute_file_name(File,
			   [ access(read),
			     extensions([rdf,rdfs,owl,''])
			   ], AbsFile),
	load_rdf(AbsFile, Triples,
		 [ expand_foreach(true)
		 ]),
	new(D, rdf_diagram(string('RDF diagram for %s', File))),
	send(new(report_dialog), below, D),
	send(D, triples, Triples),
	send(D, open).


		 /*******************************
		 *	CLASS RDF-DIAGRAM	*
		 *******************************/

:- pce_begin_class(rdf_diagram, auto_sized_picture,
		   "Show set of RDF triples in a window").
:- use_class_template(print_graphics).

variable(auto_layout,	bool := @on, both, "Automatically layout on resize").
variable(type_in_node,  bool := @on, both, "Display type inside node").

initialise(D, Label:[name]) :->
	send_super(D, initialise, Label),
	send(D, scrollbars, both),
	send(D, fill_popup),
	send(D, resize_message,
	     if(and(D?auto_layout == @on,
		    D?focus_recogniser == @nil),
		message(D, layout))).

fill_popup(D) :->
	send(D, popup, new(P, popup)),
	send_list(P, append,
		  [ menu_item(layout, message(D, layout)),
		    gap,
		    menu_item(print, message(D, print))
		  ]).

:- pce_group(triples).

append(D, Triple:prolog) :->
	"Append and rdf(Subject, Predicate, Object) triple"::
	(   subject_name(Triple, SubjectName),
	    get(D, resource, SubjectName, Subject),
	    (   get(D, type_in_node, @on),
		is_type(Triple)
	    ->  object_resource(Triple, ObjectName),
		send(Subject, type, ObjectName)
	    ;   predicate_name(Triple, PredName),
		(   object_resource(Triple, ObjectName)
		->  get(D, resource, ObjectName, Object)
		;   object_literal(Triple, Literal)
		->  get(D, literal, Literal, Object)
		),
		send(Subject, connect, PredName, Object)
	    )
	->  true
	;   term_to_atom(Triple, Atom),
	    ignore(send(D, report, error,
			'Failed to display triple: %s', Atom))
	).
	
triples(D, Triples:prolog) :->
	"Show disgram from Prolog triples"::
	send(D, clear),
	forall(member(T, Triples),
	       send(D, append, T)),
	send(D, layout).

resource(D, Resource:name) :->
	"Add Resource to diagram"::
	get(D, resource, Resource, @on, _).

resource(D, Resource:name, Create:[bool], Subject:rdf_resource) :<-
	"Get reference for a subject or create one"::
	(   get(D, member, Resource, Subject)
	->  true
	;   Create \== @off,
	    get(D, create_resource, Resource, Subject),
	    send(D, display, Subject, D?visible?center)
	).

literal(D, Value:prolog, Gr:rdf_literal) :<-
	"Display a literal.  Don't try to re-use"::
	(   literal_name(Value, Name),
	    get(D, member, Name, Gr)
	->  true
	;   get(D, create_literal, Value, Gr),
	    send(D, display, Gr, D?visible?center)
	).


create_resource(D, Resource:name, Subject:rdf_resource) :<-
	"Create visualisation of Resource"::
	new(Subject, rdf_resource(Resource, D)).


create_literal(_D, Value:prolog, Gr:rdf_literal) :<-
	"Create visualisation of literal"::
	new(Gr, rdf_literal(Value)).


node_label(_D, Resource:name, Label:name) :<-
	"Generate label to show for a node"::
	local_name(Resource, Label).


:- pce_group(layout).

layout(D) :->
	"Produce automatic layout"::
	new(Nodes, chain),
	send(D?graphicals, for_all,
	     if(message(@arg1, instance_of, rdf_any),
		message(Nodes, append, @arg1))),
	send(Nodes?head, layout, 2, 40,
	     iterations := 200,
	     area := D?visible,
	     network := Nodes).

copy_layout(D, From:rdf_diagram, Subst:prolog) :->
	"Copy the layout from another windows"::
	send(D?graphicals, for_some,
	     message(D, copy_location, @arg1, From, prolog(Subst))).

copy_location(_D, Obj:graphical, From:rdf_diagram, Subst:prolog) :->
	"Copy location of a single RDF object"::
	(   send(Obj, instance_of, rdf_any)
	->  (   get(Obj, name, Name),
	        find(From, Name, Subst, FromObj)
	    ->  format('Copied location of ~p from ~p~n', [Obj, FromObj]),
		get(FromObj, center, Center),
		send(Obj, center, Center)
	    )
	;   true
	).
	
find(D, Name, _Subst, Obj) :-
	get(D, member, Name, Obj).
find(D, Name, Subst, Obj) :-
	member(Name=AltName, Subst),
	atom_concat('_:', AltName, FullAltName),
	get(D, member, FullAltName, Obj).
find(D, Name, Subst, _) :-
	format('Cannot find ~w in ~p, Subst =~n', [Name, D]),
	pp(Subst),
	fail.


:- pce_end_class(rdf_diagram).


		 /*******************************
		 *	       SHAPES		*
		 *******************************/

:- pce_begin_class(rdf_connection, tagged_connection,
		   "Represents a triple").

:- pce_global(@rdf_link, new(link(link, link,
				  line(0,0,0,0,second)))).

initialise(C, Gr1:graphical, Gr2:graphical, Pred:name, Ctx:[object]) :->
	"Create from predicate"::
	send_super(C, initialise, Gr1, Gr2, @rdf_link),
	send(C, tag, rdf_label(Pred, italic, Ctx)).

ideal_length(C, Len:int) :<-
	"Layout: compute the desired length"::
	get(C, height, H),
	(   H < 40
	->  get(C, tag, Tag),
	    get(Tag, width, W),
	    Len is W + 30
	;   Len = 40
	).

:- pce_end_class(rdf_connection).

:- pce_begin_class(rdf_any(name), figure,
		   "Represent an RDF resource or literal").

handle(w/2, 0,	 link, north).
handle(w,   h/2, link, east).
handle(w/2, h,	 link, south).
handle(0,   h/2, link, west).

initialise(F, Ref:name) :->
	"Create visualisation"::
	send_super(F, initialise),
	send(F, name, Ref).
	
connect(F, Pred:name, Object:graphical) :->
        new(_C, rdf_connection(F, Object, Pred, F)).

:- pce_global(@rdf_any_recogniser,
	      make_rdf_any_recogniser).
:- pce_global(@rdf_any_popup,
	      make_rdf_any_popup).

make_rdf_any_recogniser(G) :-
	new(M1, move_gesture(left)),
	new(M2, move_network_gesture(left, c)),
	new(P, popup_gesture(@receiver?popup)),
	new(G, handler_group(M1, M2, P)).

popup(_F, Popup:popup) :<-
	"Create popup menu"::
	Popup = @rdf_any_popup.
	
make_rdf_any_popup(Popup) :-
	new(Popup, popup),
	Gr = @arg1,
	send(Popup, append,
	     menu_item(layout, message(Gr, layout))).

event(F, Ev:event) :->
	(   \+ send(Ev, is_a, ms_right_down),
	    send_super(F, event, Ev)
	->  true
	;   send(@rdf_any_recogniser, event, Ev)
	).

node_label(F, Resource:name, Label:name) :<-
	"Return label to use for a resource"::
	get(F, device, Dev),
	(   send(Dev, has_get_method, node_label)
	->  get(Dev, node_label, Resource, Label)
	;   local_name(Resource, Label)
	).

:- pce_end_class(rdf_any).


:- pce_begin_class(move_network_gesture, move_gesture,
		   "Move network of connected graphicals").

variable(outline,	box,	get,
	 "Box used to indicate move").
variable(network,	chain*, both,
	 "Stored value of the network").
variable(origin,	point,  get,
	 "Start origin of network").

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The  gesture maintains  an outline, the selection to  be moved and the
positon  where  the move orginiated.    The outline  itself is given a
normal  move_gesture to make  it move on  dragging.  This move_gesture
should operate on the same button and modifier.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

initialise(G, B:[button_name], M:[modifier]) :->
	send(G, send_super, initialise, B, M),
	send(G, slot, outline, new(Box, box(0,0))),
	send(G, slot, origin, point(0,0)),
	send(Box, texture, dotted),
	send(Box, recogniser, move_gesture(G?button, G?modifier)).

initiate(G, Ev:event) :->
	get(Ev, receiver, Gr),
	get(Gr, device, Dev),
	get(G, outline, Outline),
	get(Gr, network, Network),
	send(G, network, Network),
	new(Union, area(0,0,0,0)),
	send(Network, for_all, message(Union, union, @arg1?area)),
	send(G?origin, copy, Union?position),
	send(Outline, area, Union),
	send(Union, done),
	send(Dev, display, Outline),
	ignore(send(Ev, post, Outline)).

drag(G, Ev) :->
	send(Ev, post, G?outline).


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Terminate.   First undisplay the outline.  Next  calculate by how much
the outline has been dragged and move all objects  of the selection by
this amount.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

terminate(G, Ev:event) :->
	ignore(send(G, drag, Ev)),
	get(G, outline, Outline),
	send(Outline, device, @nil),
	get(Outline?area?position, difference, G?origin, Offset),	
	get(G, network, Network),
	send(Network, for_all, message(@arg1, relative_move, Offset)),
	send(G, network, @nil).

:- pce_end_class(move_network_gesture).



:- pce_begin_class(rdf_label, text,
		   "Label for an RDF relation").

variable(resource, name, get, "Represented predicate").

initialise(L, Pred:name, Font:font, Context:[object]) :->
	(   Context == @default
	->  local_name(Pred, Label)
	;   get(Context, node_label, Pred, Label)
	),
	send_super(L, initialise, Label, center, Font),
	send(L, slot, resource, Pred),
	send(L, background, @default).

:- pce_global(@rdf_label_recogniser,
	      make_rdf_label_recogniser).

make_rdf_label_recogniser(G) :-
	new(G, handler_group),
	send(G, append,
	     handler(area_enter, message(@receiver, identify))),
	send(G, append,
	     handler(area_exit, message(@receiver, report, status, ''))),
	send(G, append, popup_gesture(new(P, popup))),
	send_list(P, append,
		  [ menu_item(copy,
			      message(@display, copy, @arg1?resource))
		  ]).

event(F, Ev:event) :->
	(   send_super(F, event, Ev)
	->  true
	;   send(@rdf_label_recogniser, event, Ev)
	).

identify(L) :->
	send(L, report, status, '%s', L?resource).
	     
:- pce_end_class.



:- pce_begin_class(rdf_resource, rdf_any,
		   "Represent an RDF resource").

initialise(F, Ref:name, Ctx:[object]) :->
	"Create visualisation"::
	send_super(F, initialise, Ref),
	send(F, display, ellipse(100, 50), point(-50,-25)),
	send(F, display, new(T, rdf_label(Ref, normal, Ctx))),
	send(T, center, point(0,0)).

type(F, Type:name) :->
	send(F, display, new(TL, rdf_label(Type, small, F))),
	send(TL, center, point(0,14)),
	get(F, member, ellipse, E),
	send(E, shadow, 2).

identify(F) :->
	send(F, report, status, 'Resource %s', F?name).

:- pce_end_class(rdf_resource).


:- pce_begin_class(rdf_literal, rdf_any,
		   "Represent an RDF literal value").

variable(value,	prolog, get, "Represented literal value").

initialise(F, Value:prolog) :->
	"Create visualisation"::
	send(F, slot, value, Value),
	literal_label(Value, Label),
	atom_concat('__lit:', Label, Id),
	send_super(F, initialise, Id),
	send(F, display, new(B, box)),
	send(B, fill_pattern, colour(grey80)),
	send(B, pen, 0),
	send(F, display, new(T, text(Label, center))),
	send(T, center, point(0,0)),
	send(F, fit).

literal_label(literal(Value0), Value) :- !,
	literal_label(Value0, Value).
literal_label(xml(Value0), Value) :- !,
	literal_label(Value0, Value).
literal_label(Value, Value) :-
	atomic(Value), !.
literal_label(Value, Label) :-
	term_to_atom(Value, Label).

literal_name(Value, Name) :-
	literal_label(Value, Label),
	atom_concat('__lit:', Label, Name).

fit(F) :->
	"Make box fit contents"::
	get(F, member, text, Text),
	get(Text?area, clone, Area),
	send(Area, increase, 3),
	get(F, member, box, Box),
	send(Box, area, Area).

:- pce_end_class(rdf_literal).






		 /*******************************
		 *	    PRIMITIVES		*
		 *******************************/

subject_name(rdf(Name0, _, _), Name) :-
	resource_name(Name0, Name).
predicate_name(rdf(_, Name0, _), Name) :-
	resource_name(Name0, Name).
object_resource(rdf(_, _, Name0), Name) :-
	resource_name(Name0, Name).
object_literal(rdf(_,_,Literal), Literal).


resource_name(Name, Name) :-
	atom(Name), !.
resource_name(rdf:Local, Name) :- !,	% known namespaces
	concat_atom([rdf, :, Local], Name).
resource_name(NS:Local, Name) :- !,
	atom_concat(NS, Local, Name).
resource_name(node(Anon), Name) :-	% Not for predicates
	atom_concat('_:', Anon, Name).

is_type(rdf(_, rdf:type, _)) :- !.	% our parser
is_type(rdf(_, Pred, _)) :-		% our parser
	atom(Pred),
	rdf_name_space(NS),
	atom_concat(NS, type, Pred), !.

%	local_name(+Resource, -Label)
%	
%	Return easy readable local name

local_name(Resource, Local) :-
	sub_atom(Resource, _, _, A, #),
	sub_atom(Resource, _, A, 0, Local),
	\+ sub_atom(Local, _, _, _, #), !.
local_name(Resource, Local) :-
	atom_concat('rdf:', Local, Resource), !.
local_name(Resource, Local) :-
	file_base_name(Resource, Local),
	Local \== ''.
local_name(Resource, Resource).