1% This file is part of the Attempto Parsing Engine (APE).
    2% Copyright 2008-2013, Attempto Group, University of Zurich (see http://attempto.ifi.uzh.ch).
    3%
    4% The Attempto Parsing Engine (APE) is free software: you can redistribute it and/or modify it
    5% under the terms of the GNU Lesser General Public License as published by the Free Software
    6% Foundation, either version 3 of the License, or (at your option) any later version.
    7%
    8% The Attempto Parsing Engine (APE) is distributed in the hope that it will be useful, but WITHOUT
    9% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
   10% PURPOSE. See the GNU Lesser General Public License for more details.
   11%
   12% You should have received a copy of the GNU Lesser General Public License along with the Attempto
   13% Parsing Engine (APE). If not, see http://www.gnu.org/licenses/.
   14
   15
   16:- module(drs_to_html, [
   17	drs_to_html/2,
   18	drs_to_html_nocontainer/2,
   19	header/2,
   20	header/1,
   21	footer/1
   22	]).

Visualize a DRS using HTML and CSS

author
- Kaarel Kaljurand
version
- 2008-03-16

*/

   32% Operators used in the DRS.
   33:- op(400, fx, -).   34:- op(400, fx, ~).   35:- op(500, xfx, =>).   36:- op(500, xfx, v).
 drs_to_html(+Drs:term, -DrsHtml:atom) is det
Arguments:
Drs- is Attempto DRS
DrsHtml- is the DRS formatted in HTML (with HTML header and footer)
   44drs_to_html(Drs, DrsHtml) :-
   45	copy_term(Drs, DrsCopy),
   46	numbervars(DrsCopy, 0, _),
   47	DrsCopy = drs(Dom, Conds),
   48
   49	header(Header),
   50	footer(Footer),
   51	with_output_to(atom(CondsHtml), format_condlist(Conds)),
   52	!,
   53	format(atom(DrsHtml), '~w<table class="drs"><tr><td><div class="dom">~W</div>~w</td></tr></table>~w~n',
   54		[Header, Dom, [numbervars(true)], CondsHtml, Footer]).
   55
   56
   57drs_to_html(_, 'ERROR').
 drs_to_html_nocontainer(+Drs:term, -DrsHtml:atom) is det
Arguments:
Drs- is Attempto DRS
DrsHtml- is the DRS formatted in HTML
   65drs_to_html_nocontainer(Drs, DrsHtml) :-
   66	copy_term(Drs, DrsCopy),
   67	numbervars(DrsCopy, 0, _),
   68	DrsCopy = drs(Dom, Conds),
   69
   70	with_output_to(atom(CondsHtml), format_condlist(Conds)),
   71	!,
   72	format(atom(DrsHtml), '<table class="drs"><tr><td><div class="dom">~W</div>~w</td></tr></table>~n',
   73		[Dom, [numbervars(true)], CondsHtml]).
   74
   75drs_to_html_nocontainer(_, 'ERROR').
 format_condlist(+CondList:list) is det
Arguments:
CondList- is a list of DRS conditions
   82format_condlist([]).
   83
   84format_condlist([Condition | CondList]) :-
   85	format_condition(Condition),
   86	format_condlist(CondList).
 format_condition(+Condition:term) is det
Arguments:
Condition- is a DRS condition
   93format_condition(-drs(Dom, Conds)) :-
   94	!,
   95	format('<table><tr><td class="op">&not;</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
   96	format_condlist(Conds),
   97	format('</td></tr></table>', []).
   98
   99format_condition(~drs(Dom, Conds)) :-
  100	!,
  101	format('<table><tr><td class="op">&sim;</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  102	format_condlist(Conds),
  103	format('</td></tr></table>', []).
  104
  105format_condition(can(drs(Dom, Conds))) :-
  106	!,
  107	format('<table><tr><td class="op">&diams;</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  108	format_condlist(Conds),
  109	format('</td></tr></table>', []).
  110
  111format_condition(must(drs(Dom, Conds))) :-
  112	!,
  113	format('<table><tr><td class="op">&#x25a0;</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  114	format_condlist(Conds),
  115	format('</td></tr></table>', []).
  116
  117format_condition(should(drs(Dom, Conds))) :-
  118	!,
  119	format('<table><tr><td class="op">SHOULD</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  120	format_condlist(Conds),
  121	format('</td></tr></table>', []).
  122
  123format_condition(may(drs(Dom, Conds))) :-
  124	!,
  125	format('<table><tr><td class="op">MAY</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  126	format_condlist(Conds),
  127	format('</td></tr></table>', []).
  128
  129format_condition(question(drs(Dom, Conds))) :-
  130	!,
  131	format('<table><tr><td class="op">QUESTION</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  132	format_condlist(Conds),
  133	format('</td></tr></table>', []).
  134
  135format_condition(command(drs(Dom, Conds))) :-
  136	!,
  137	format('<table><tr><td class="op">COMMAND</td><td><div class="dom">~W</div>', [Dom, [numbervars(true)]]),
  138	format_condlist(Conds),
  139	format('</td></tr></table>', []).
  140
  141format_condition(Conds) :-
  142	is_list(Conds),
  143	!,
  144	format('<table><tr><td>', []),
  145	format_condlist(Conds),
  146	format('</td></tr></table>', []).
  147
  148format_condition(Label:drs(Dom, Conds)) :-
  149	!,
  150	format('<table><tr><td class="op">~W : </td><td><div class="dom">~W</div>', [Label, [numbervars(true)], Dom, [numbervars(true)]]),
  151	format_condlist(Conds),
  152	format('</td></tr></table>', []).
  153
  154format_condition(drs(Dom1, Conds1) v drs(Dom2, Conds2)) :-
  155	!,
  156	format('<table><tr><td><div class="dom">~W</div>', [Dom1, [numbervars(true)]]),
  157	format_condlist(Conds1),
  158	format('</td><td class="op">&or;</td><td><div class="dom">~W</div>', [Dom2, [numbervars(true)]]),
  159	format_condlist(Conds2),
  160	format('</td></tr></table>', []).
  161
  162format_condition(drs(Dom1, Conds1) => drs(Dom2, Conds2)) :-
  163	!,
  164	format('<table><tr><td><div class="dom">~W</div>', [Dom1, [numbervars(true)]]),
  165	format_condlist(Conds1),
  166	format('</td><td class="op">&rArr;</td><td><div class="dom">~W</div>', [Dom2, [numbervars(true)]]),
  167	format_condlist(Conds2),
  168	format('</td></tr></table>', []).
  169
  170format_condition(Condition-Id) :-
  171	!,
  172	format('~W<br/>', [Condition-Id, [numbervars(true)]]).
  173
  174format_condition(_, 'ERROR').
 header(+Title:atom, -Header:atom) is det
 header(-Header:atom) is det
Arguments:
Title- is the content for the title-element in the HTML-header
Header- is an HTML header

Generate an HTML-header.

  185header(Header) :-
  186	header('', Header).
  187
  188header(Title, Header) :-
  189	with_output_to(atom(Header), format('<?xml version="1.0" encoding="UTF-8"?>
  190<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
  191<html xmlns="http://www.w3.org/1999/xhtml">
  192<head>
  193<title>~w</title>
  194<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
  195<style type="text/css">
  196div.dom { background-color: #ace; margin-bottom: 0.5em }
  197table.drs { font-family: monospace; padding: 0.4em 0.4em 0.4em 0.4em; border: 1px solid black; margin-bottom: 2em; background-color: #eee; border-collapse: collapse }
  198td { vertical-align: top; padding: 0.3em 0.3em 0.3em 0.3em; border: 1px solid black }
  199td.op { vertical-align: middle; font-size: 110%; border: none }
  200</style>
  201</head>
  202<body>', [Title])).
 footer(-Footer:atom) is det
Arguments:
Footer- is an HTML footer

Generate an HTML-footer.

  211footer('</body>\n</html>')