1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2013, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(rdf_diagram,
   37          [ rdf_diagram_from_file/1     % +File
   38          ]).   39:- use_module(library(pce)).   40:- use_module(library(pce_tagged_connection)).   41:- use_module(library(autowin)).   42:- use_module(library(pce_report)).   43:- use_module(library(print_graphics)).   44:- use_module(library(rdf_parser)).     % get access to declared namespaces
   45
   46
   47/** <module> Show graphical representation of a set of triples
   48
   49This file defines the class rdf_diagram, a   window capable of showing a
   50set of triples.
   51
   52The predicate rdf_diagram_from_file(+File) is a   simple demo and useful
   53tool to show RDF from simple RDF files.
   54*/
   55
   56
   57                 /*******************************
   58                 *          SIMPLE ENTRY        *
   59                 *******************************/
   60
   61%!  rdf_diagram_from_file(+File)
   62%
   63%   Show the triples from File in a window.
   64
   65rdf_diagram_from_file(File) :-
   66    absolute_file_name(File,
   67                       [ access(read),
   68                         extensions([rdf,rdfs,owl,''])
   69                       ], AbsFile),
   70    load_rdf(AbsFile, Triples,
   71             [ expand_foreach(true)
   72             ]),
   73    new(D, rdf_diagram(string('RDF diagram for %s', File))),
   74    send(new(report_dialog), below, D),
   75    send(D, triples, Triples),
   76    send(D, open).
   77
   78
   79                 /*******************************
   80                 *      CLASS RDF-DIAGRAM       *
   81                 *******************************/
   82
   83:- pce_begin_class(rdf_diagram, auto_sized_picture,
   84                   "Show set of RDF triples in a window").
   85:- use_class_template(print_graphics).
   86
   87variable(auto_layout,   bool := @on, both, "Automatically layout on resize").
   88variable(type_in_node,  bool := @on, both, "Display type inside node").
   89
   90initialise(D, Label:[name]) :->
   91    send_super(D, initialise, Label),
   92    send(D, scrollbars, both),
   93    send(D, fill_popup),
   94    send(D, resize_message,
   95         if(and(D?auto_layout == @on,
   96                D?focus_recogniser == @nil),
   97            message(D, layout))).
   98
   99fill_popup(D) :->
  100    send(D, popup, new(P, popup)),
  101    send_list(P, append,
  102              [ menu_item(layout, message(D, layout)),
  103                gap,
  104                menu_item(print, message(D, print))
  105              ]).
  106
  107:- pce_group(triples).
  108
  109append(D, Triple:prolog) :->
  110    "Append and rdf(Subject, Predicate, Object) triple"::
  111    (   subject_name(Triple, SubjectName),
  112        get(D, resource, SubjectName, Subject),
  113        (   get(D, type_in_node, @on),
  114            is_type(Triple)
  115        ->  object_resource(Triple, ObjectName),
  116            send(Subject, type, ObjectName)
  117        ;   predicate_name(Triple, PredName),
  118            (   object_resource(Triple, ObjectName)
  119            ->  get(D, resource, ObjectName, Object)
  120            ;   object_literal(Triple, Literal)
  121            ->  get(D, literal, Literal, Object)
  122            ),
  123            send(Subject, connect, PredName, Object)
  124        )
  125    ->  true
  126    ;   term_to_atom(Triple, Atom),
  127        ignore(send(D, report, error,
  128                    'Failed to display triple: %s', Atom))
  129    ).
  130
  131triples(D, Triples:prolog) :->
  132    "Show disgram from Prolog triples"::
  133    send(D, clear),
  134    forall(member(T, Triples),
  135           send(D, append, T)),
  136    send(D, layout).
  137
  138resource(D, Resource:name) :->
  139    "Add Resource to diagram"::
  140    get(D, resource, Resource, @on, _).
  141
  142resource(D, Resource:name, Create:[bool], Subject:rdf_resource) :<-
  143    "Get reference for a subject or create one"::
  144    (   get(D, member, Resource, Subject)
  145    ->  true
  146    ;   Create \== @off,
  147        get(D, create_resource, Resource, Subject),
  148        send(D, display, Subject, D?visible?center)
  149    ).
  150
  151literal(D, Value:prolog, Gr:rdf_literal) :<-
  152    "Display a literal.  Don't try to re-use"::
  153    (   literal_name(Value, Name),
  154        get(D, member, Name, Gr)
  155    ->  true
  156    ;   get(D, create_literal, Value, Gr),
  157        send(D, display, Gr, D?visible?center)
  158    ).
  159
  160
  161create_resource(D, Resource:name, Subject:rdf_resource) :<-
  162    "Create visualisation of Resource"::
  163    new(Subject, rdf_resource(Resource, D)).
  164
  165
  166create_literal(_D, Value:prolog, Gr:rdf_literal) :<-
  167    "Create visualisation of literal"::
  168    new(Gr, rdf_literal(Value)).
  169
  170
  171node_label(_D, Resource:name, Label:name) :<-
  172    "Generate label to show for a node"::
  173    local_name(Resource, Label).
  174
  175
  176:- pce_group(layout).
  177
  178layout(D) :->
  179    "Produce automatic layout"::
  180    new(Nodes, chain),
  181    send(D?graphicals, for_all,
  182         if(message(@arg1, instance_of, rdf_any),
  183            message(Nodes, append, @arg1))),
  184    send(Nodes?head, layout, 2, 40,
  185         iterations := 200,
  186         area := D?visible,
  187         network := Nodes).
  188
  189copy_layout(D, From:rdf_diagram, Subst:prolog) :->
  190    "Copy the layout from another windows"::
  191    send(D?graphicals, for_some,
  192         message(D, copy_location, @arg1, From, prolog(Subst))).
  193
  194copy_location(_D, Obj:graphical, From:rdf_diagram, Subst:prolog) :->
  195    "Copy location of a single RDF object"::
  196    (   send(Obj, instance_of, rdf_any)
  197    ->  (   get(Obj, name, Name),
  198            find(From, Name, Subst, FromObj)
  199        ->  format('Copied location of ~p from ~p~n', [Obj, FromObj]),
  200            get(FromObj, center, Center),
  201            send(Obj, center, Center)
  202        )
  203    ;   true
  204    ).
  205
  206find(D, Name, _Subst, Obj) :-
  207    get(D, member, Name, Obj).
  208find(D, Name, Subst, Obj) :-
  209    member(Name=AltName, Subst),
  210    atom_concat('_:', AltName, FullAltName),
  211    get(D, member, FullAltName, Obj).
  212find(D, Name, Subst, _) :-
  213    format('Cannot find ~w in ~p, Subst =~n', [Name, D]),
  214    pp(Subst),
  215    fail.
  216
  217
  218:- pce_end_class(rdf_diagram).
  219
  220
  221                 /*******************************
  222                 *             SHAPES           *
  223                 *******************************/
  224
  225:- pce_begin_class(rdf_connection, tagged_connection,
  226                   "Represents a triple").
  227
  228:- pce_global(@rdf_link, new(link(link, link,
  229                                  line(0,0,0,0,second)))).
  230
  231initialise(C, Gr1:graphical, Gr2:graphical, Pred:name, Ctx:[object]) :->
  232    "Create from predicate"::
  233    send_super(C, initialise, Gr1, Gr2, @rdf_link),
  234    send(C, tag, rdf_label(Pred, italic, Ctx)).
  235
  236ideal_length(C, Len:int) :<-
  237    "Layout: compute the desired length"::
  238    get(C, height, H),
  239    (   H < 40
  240    ->  get(C, tag, Tag),
  241        get(Tag, width, W),
  242        Len is W + 30
  243    ;   Len = 40
  244    ).
  245
  246:- pce_end_class(rdf_connection).
  247
  248:- pce_begin_class(rdf_any(name), figure,
  249                   "Represent an RDF resource or literal").
  250
  251handle(w/2, 0,   link, north).
  252handle(w,   h/2, link, east).
  253handle(w/2, h,   link, south).
  254handle(0,   h/2, link, west).
  255
  256initialise(F, Ref:name) :->
  257    "Create visualisation"::
  258    send_super(F, initialise),
  259    send(F, name, Ref).
  260
  261connect(F, Pred:name, Object:graphical) :->
  262    new(_C, rdf_connection(F, Object, Pred, F)).
  263
  264:- pce_global(@rdf_any_recogniser,
  265              make_rdf_any_recogniser).  266:- pce_global(@rdf_any_popup,
  267              make_rdf_any_popup).  268
  269make_rdf_any_recogniser(G) :-
  270    new(M1, move_gesture(left)),
  271    new(M2, move_network_gesture(left, c)),
  272    new(P, popup_gesture(@receiver?popup)),
  273    new(G, handler_group(M1, M2, P)).
  274
  275popup(_F, Popup:popup) :<-
  276    "Create popup menu"::
  277    Popup = @rdf_any_popup.
  278
  279make_rdf_any_popup(Popup) :-
  280    new(Popup, popup),
  281    Gr = @arg1,
  282    send(Popup, append,
  283         menu_item(layout, message(Gr, layout))).
  284
  285event(F, Ev:event) :->
  286    (   \+ send(Ev, is_a, ms_right_down),
  287        send_super(F, event, Ev)
  288    ->  true
  289    ;   send(@rdf_any_recogniser, event, Ev)
  290    ).
  291
  292node_label(F, Resource:name, Label:name) :<-
  293    "Return label to use for a resource"::
  294    get(F, device, Dev),
  295    (   send(Dev, has_get_method, node_label)
  296    ->  get(Dev, node_label, Resource, Label)
  297    ;   local_name(Resource, Label)
  298    ).
  299
  300:- pce_end_class(rdf_any).
  301
  302
  303:- pce_begin_class(move_network_gesture, move_gesture,
  304                   "Move network of connected graphicals").
  305
  306variable(outline,       box,    get,
  307         "Box used to indicate move").
  308variable(network,       chain*, both,
  309         "Stored value of the network").
  310variable(origin,        point,  get,
  311         "Start origin of network").
  312
  313/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  314The  gesture maintains  an outline, the selection to  be moved and the
  315positon  where  the move orginiated.    The outline  itself is given a
  316normal  move_gesture to make  it move on  dragging.  This move_gesture
  317should operate on the same button and modifier.
  318- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  319
  320initialise(G, B:[button_name], M:[modifier]) :->
  321    send(G, send_super, initialise, B, M),
  322    send(G, slot, outline, new(Box, box(0,0))),
  323    send(G, slot, origin, point(0,0)),
  324    send(Box, texture, dotted),
  325    send(Box, recogniser, move_gesture(G?button, G?modifier)).
  326
  327initiate(G, Ev:event) :->
  328    get(Ev, receiver, Gr),
  329    get(Gr, device, Dev),
  330    get(G, outline, Outline),
  331    get(Gr, network, Network),
  332    send(G, network, Network),
  333    new(Union, area(0,0,0,0)),
  334    send(Network, for_all, message(Union, union, @arg1?area)),
  335    send(G?origin, copy, Union?position),
  336    send(Outline, area, Union),
  337    send(Union, done),
  338    send(Dev, display, Outline),
  339    ignore(send(Ev, post, Outline)).
  340
  341drag(G, Ev) :->
  342    send(Ev, post, G?outline).
  343
  344
  345/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  346Terminate.   First undisplay the outline.  Next  calculate by how much
  347the outline has been dragged and move all objects  of the selection by
  348this amount.
  349- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  350
  351terminate(G, Ev:event) :->
  352    ignore(send(G, drag, Ev)),
  353    get(G, outline, Outline),
  354    send(Outline, device, @nil),
  355    get(Outline?area?position, difference, G?origin, Offset),
  356    get(G, network, Network),
  357    send(Network, for_all, message(@arg1, relative_move, Offset)),
  358    send(G, network, @nil).
  359
  360:- pce_end_class(move_network_gesture).
  361
  362
  363
  364:- pce_begin_class(rdf_label, text,
  365                   "Label for an RDF relation").
  366
  367variable(resource, name, get, "Represented predicate").
  368
  369initialise(L, Pred:name, Font:font, Context:[object]) :->
  370    (   Context == @default
  371    ->  local_name(Pred, Label)
  372    ;   get(Context, node_label, Pred, Label)
  373    ),
  374    send_super(L, initialise, Label, center, Font),
  375    send(L, slot, resource, Pred),
  376    send(L, background, @default).
  377
  378:- pce_global(@rdf_label_recogniser,
  379              make_rdf_label_recogniser).  380
  381make_rdf_label_recogniser(G) :-
  382    new(G, handler_group),
  383    send(G, append,
  384         handler(area_enter, message(@receiver, identify))),
  385    send(G, append,
  386         handler(area_exit, message(@receiver, report, status, ''))),
  387    send(G, append, popup_gesture(new(P, popup))),
  388    send_list(P, append,
  389              [ menu_item(copy,
  390                          message(@display, copy, @arg1?resource))
  391              ]).
  392
  393event(F, Ev:event) :->
  394    (   send_super(F, event, Ev)
  395    ->  true
  396    ;   send(@rdf_label_recogniser, event, Ev)
  397    ).
  398
  399identify(L) :->
  400    send(L, report, status, '%s', L?resource).
  401
  402:- pce_end_class.
  403
  404
  405
  406:- pce_begin_class(rdf_resource, rdf_any,
  407                   "Represent an RDF resource").
  408
  409initialise(F, Ref:name, Ctx:[object]) :->
  410    "Create visualisation"::
  411    send_super(F, initialise, Ref),
  412    send(F, display, ellipse(100, 50), point(-50,-25)),
  413    send(F, display, new(T, rdf_label(Ref, normal, Ctx))),
  414    send(T, center, point(0,0)).
  415
  416type(F, Type:name) :->
  417    send(F, display, new(TL, rdf_label(Type, small, F))),
  418    send(TL, center, point(0,14)),
  419    get(F, member, ellipse, E),
  420    send(E, shadow, 2).
  421
  422identify(F) :->
  423    send(F, report, status, 'Resource %s', F?name).
  424
  425:- pce_end_class(rdf_resource).
  426
  427
  428:- pce_begin_class(rdf_literal, rdf_any,
  429                   "Represent an RDF literal value").
  430
  431variable(value, prolog, get, "Represented literal value").
  432
  433initialise(F, Value:prolog) :->
  434    "Create visualisation"::
  435    send(F, slot, value, Value),
  436    literal_label(Value, Label),
  437    atom_concat('_:lit:', Label, Id),
  438    send_super(F, initialise, Id),
  439    send(F, display, new(B, box)),
  440    send(B, fill_pattern, colour(grey80)),
  441    send(B, pen, 0),
  442    send(F, display, new(T, text(Label, center))),
  443    send(T, center, point(0,0)),
  444    send(F, fit).
  445
  446literal_label(literal(Value0), Value) :-
  447    !,
  448    literal_label(Value0, Value).
  449literal_label(xml(Value0), Value) :-
  450    !,
  451    literal_label(Value0, Value).
  452literal_label(Value, Value) :-
  453    atomic(Value),
  454    !.
  455literal_label(Value, Label) :-
  456    term_to_atom(Value, Label).
  457
  458literal_name(Value, Name) :-
  459    literal_label(Value, Label),
  460    atom_concat('_:lit:', Label, Name).
  461
  462fit(F) :->
  463    "Make box fit contents"::
  464    get(F, member, text, Text),
  465    get(Text?area, clone, Area),
  466    send(Area, increase, 3),
  467    get(F, member, box, Box),
  468    send(Box, area, Area).
  469
  470:- pce_end_class(rdf_literal).
  471
  472
  473
  474
  475
  476
  477                 /*******************************
  478                 *          PRIMITIVES          *
  479                 *******************************/
  480
  481subject_name(rdf(Name0, _, _), Name) :-
  482    resource_name(Name0, Name).
  483predicate_name(rdf(_, Name0, _), Name) :-
  484    resource_name(Name0, Name).
  485object_resource(rdf(_, _, Name0), Name) :-
  486    resource_name(Name0, Name).
  487object_literal(rdf(_,_,Literal), Literal).
  488
  489
  490resource_name(Name, Name) :-
  491    atom(Name),
  492    !.
  493resource_name(rdf:Local, Name) :-      % known namespaces
  494    !,
  495    atomic_list_concat([rdf, :, Local], Name).
  496resource_name(NS:Local, Name) :-
  497    !,
  498    atom_concat(NS, Local, Name).
  499resource_name(node(Anon), Name) :-      % Not for predicates
  500    atom_concat('_:', Anon, Name).
  501
  502is_type(rdf(_, rdf:type, _)) :- !.      % our parser
  503is_type(rdf(_, Pred, _)) :-             % our parser
  504    atom(Pred),
  505    rdf_name_space(NS),
  506    atom_concat(NS, type, Pred),
  507    !.
  508
  509%       local_name(+Resource, -Label)
  510%
  511%       Return easy readable local name
  512
  513local_name(Resource, Local) :-
  514    sub_atom(Resource, _, _, A, #),
  515    sub_atom(Resource, _, A, 0, Local),
  516    \+ sub_atom(Local, _, _, _, #),
  517    !.
  518local_name(Resource, Local) :-
  519    atom_concat('rdf:', Local, Resource),
  520    !.
  521local_name(Resource, Local) :-
  522    file_base_name(Resource, Local),
  523    Local \== ''.
  524local_name(Resource, Resource)