Web presentation has attractive features. It is well accepted, standardised (if you stick to the basics) and network-transparent. Many people think you need a web-server like Apache with some sort of server-scripting (CGI) to realise a server. This is not true. Any application capable of elementary TCP/IP communication can easily act as a web-server.
Using XPCE for this task may be attractive for a number of reasons.
We start with a small demo, illustrating frames and text.
 
| Figure 28 : Mozilla showing XPCE generated figure | 
:- module(my_httpd,
          [ go/1
          ]).
:- use_module(library(pce)).
:- use_module(library('http/httpd')).
:- use_module(library('http/html_write')).
:- use_module(library('draw/importpl')).
%       Create server at Port
go(Port) :-
        new(_, my_httpd(Port)).
:- pce_begin_class(my_httpd, httpd, "Demo Web server").
->request is sent after the super-class has 
received a complete request header. We get the `path' and have a Prolog 
predicate generating the replies.
request(HTTPD, Request:sheet) :->
        "A request came in."::
        get(Request, path, Path),
        reply(Path, HTTPD).
:- discontiguous
        reply/2.
->reply_html takes <Module>:<DCGRuleSet> 
to formulate a reply. This uses the html_write library, converting a 
complex Prolog term into a formatted HTML document. The complex term can 
invoke additional DCG rulesets, providing nicely structured 
content-generation.
reply('/', HTTPD) :- !,
        send(HTTPD, reply_html, my_httpd:frames).
frames -->
        html(html([ head(title('Demo')),
                    frameset([cols('25%,75%')],
                             [ frame([ src('/index'),
                                       name(index)
                                     ]),
                               frame([ src('/blank'),
                                       name(body)
                                     ])
                             ])
                  ])).
reply('/blank', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:blank).
blank -->
        page(title('Blank'),
             []).
reply('/index', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:index).
index -->
        page(title('Index'),
             [ a([ href('/text'), target(body) ],
                 [ 'Show text' ]),
               br([]),
               a([ href('/picture'), target(body) ],
                 [ 'Show picture' ])
             ]).
reply('/text', HTTPD) :-
        send(HTTPD, reply_html, my_httpd:text).
text -->
        page(title('Text'),
             [ p(['Just showing a little text'])
             ]).
Reply a graphical object. The server translates the graphical to a GIF or JPEG bitmap and provides the proper HTTP reply header. You can also embed graphicals into the HTML structures used above.
The drawing itself is exported from the demo program PceDraw and turned into an XPCE graphical using the support library draw/importpl.
reply('/picture', HTTPD) :-
        make_picture(Gr),
        send(HTTPD, reply, Gr, 'image/gif').
make_picture(Dev) :-
        new(Dev, device),
        drawing(xpcenetscape, Drawing),
        realise_drawing(Dev, Drawing).
%       Drawing imported from PceDraw
drawing(xpcenetscape,
        [ compound(new(A, figure),
                   drawing([ display(box(137, 74)+radius(17),
                                     point(0, 0)),
                             display(text('XPCE', center, normal),
                                     point(52, 30))
                           ]),
                   point(163, 183)),
          compound(new(B, figure),
                   drawing([ display(box(137, 74)+radius(17),
                                     point(0, 0)),
                             display(text('Netscape', center, normal),
                                     point(42, 30))
                           ]),
                   point(350, 183)),
          connect(connection(A,
                             B,
                             handle(w, h/2, link, east),
                             handle(0, h/2, link, west)) +
                    arrows(both))
        ]).
:- pce_end_class(my_httpd).
The library library(http/httpd) defines the class httpd. 
This subclass of socket 
deals with most of the HTTP protocol details, breaking down HTTP 
requests and encapsulating responses with the proper headers. The class 
itself is an abstract class, a subclass needs to be created and 
some of the virtual methods needs to be refined to arrive at a 
useful application.
<-peer_name' 
and sending ->free to the socket if you want to 
restrict access.->input after a complete 
request-header is received.
->input decodes the header-fields, places them in Data 
and then calls ->request. The attribute-names in 
the sheet are downcase versions of the case-insensitive request fields 
of the HTTP header. In addition, the following fields are defined:
After decoding the request, the user should compose a response and 
use
->reply or ->reply_html to 
return the response to the client.
->reply_html is 
normally activated at the end of the user's ->request 
implementation. Data is one of:
->reply 
assumes the data has mime-type text/plain.
->save_in'.
Type is the mimi-type returned and tells the browser what to do with the data. This should correspond with the content of Data. For example, you can return a PNG picture from a file using
        send(HTTPD, reply, file('pict.png'), 'image/png'),
Status is used to tell the client in a formal way how the 
request was processed. The default is 200 OK. See the 
methods below for returning other values.
Header is a sheet holding additional name-value pairs. If present, they are simply added to the end of the reply-header. For example if you want to prevent the browser caching the result you can use
        send(HTTPD, reply, ...,
             sheet(attribute('Cache-Control', 'no-cache'))),
library(http/html_write) library to translate Term 
into HTML text using DCG rules and then invokes ->reply 
using the Type
text/html. Status and Header are 
passed unmodified to ->reply.
In addition to the principal methods above, a number of methods are defined for dealing with abnormal replies such as denying permission, etc.
403 Forbidden message. What may 
be provided to indicate what is forbidden. Default is the path from the 
current
<-request.Basic. Realm tells the user for 
which service permission is requested. On all subsequence contacts from 
this client to this server the ->request data 
contains the user and
password fields. The demo implementation of ->request 
in
httpd contains the following example code:
request(S, Header:sheet) :->
        "Process a request.  The argument is the header"::
        (   get(Header, path, '/no')
        ->  send(S, forbidden, '/no')
        ;   get(Header, path, '/maybe')
        ->  (   get(Header, value, user, jan),
                get(Header, value, password, test)
            ->  send(S, reply, 'You hacked me')
            ;   send(S, authorization_required)
            )
        ;   send(S, reply, 'Nice try')
        ).
404 Not Found message, using the request-path 
as default for What.301 Moved Permanently. Normally the client 
will retry the request using the URL returned in Where.500 Internal Server using `What as 
additional information to the user. This is the default reply if ->request 
fails or raised an exception.