This 
section describes three libraries residing in
<pcehome>/prolog/lib/plot to deal with 
plotting graphs and barcharts.
The library library(plot/axis) defines the class plot_axis 
to draw an X- or Y-axis. The class deals with computing the layout, 
placing rule-marks, values and labels as well as translation between 
coordinates and real values. Normally this class is used together with
plotter, plot_axis does not rely on other library classes 
and may therefore be used independent of the remainder of the plotting 
infrastructure.
We start with a small example from the library itself, creating the picture below.
?- [library('plot/axis')].
% library('plot/axis') compiled into plot_axis 0.03 sec, 27,012 bytes
?- send(new(P, picture), open),
           send(P, display,
                plot_axis(x, 0, 100, @default, 400, point(40, 320))),
           send(P, display,
                plot_axis(y, 0, 500, @default, 300, point(40, 320))).
 
| Figure 24 : A picture showing two axis | 
Below is a reference to the important methods of this class. The sources to the class itself are a good example of complicated and advanced layout computations and delaying of these until they are really needed.
<-translate'.<-location, 
returning the value along the axis from a pixel coordinate.
Besides the principal methods below, the following methods are 
available for changing attributes of an existing axis: ->origin,
->low, ->high, ->step, ->small_step 
(interval for rule-marks without a value), ->length 
and ->type: {x,y}.
The library library(plot/plotter) defines the classes plotter 
and plot_graph for displaying graphs. Class plotter is a 
subclass of device. The 
example below plots the function
Y = sine(X)
:- use_module(library('plot/plotter')).
:- use_module(library(autowin)).
plot_function :-
        plot_function(X:sin(X)).
plot_function(Template) :-
        To is 2*pi,
        PlotStep is To/100,
        Step is pi/4,
        new(W, auto_sized_picture('Plotter demo')),
        send(W, display, new(P, plotter)),
        send(P, axis, new(X, plot_axis(x, 0, To, Step, 300))),
        send(P, axis, plot_axis(y, -1, 1, @default, 200)),
        send(X, format, '%.2f'),
        send(P, graph, new(G, plot_graph)),
        plot_function(0, To, PlotStep, Template, G),
        send(W, open).
plot_function(X, To, _, _, _) :-
        X >= To, !.
plot_function(X, To, Step, Template, G) :-
        copy_term(Template, X:Func),
        Y is Func,
        send(G, append, X, Y),
        NewX is X + Step,
        plot_function(NewX, To, Step, Template, G).
 
| Figure 25 : Plotter showing sine function | 
Graphs themselves are instances of class plot_graph, a subclass of path. Instead of normal point objects, the points are represented using the subclass plot_point that attaches the real values to the physical coordinates. Methods:
poly (default), straight lines are drawn between the 
points. Using smooth, the curve is interpolated (see path 
for details) and using points_only, no lines is painted, 
just the marks. Using the mark argument the user may specify 
marks to be drawn at each control-point.The library(plot/barchart) 
library draws simple bar-charts. It is based on the plotter and plot_axis 
classes, adding simple bars, grouped bars and stacked bars. Below is an 
example from
library(plot/demo) showing all active XPCE, 
classes, where active is defined that more than 250 instances are 
created. The code, except for the calculation parts is show below.
 
| Figure 26 : Classes of XPCE with > 250 instances created | 
barchart :-
        barchart(vertical).
barchart(HV) :-
        new(W, picture),
        active_classes(Classes),
        length(Classes, N),
        required_scale(Classes, Scale),
        send(W, display, new(BC, bar_chart(HV, 0, Scale, 200, N))),
        forall(member(class(Name, Created, Freed), Classes),
               send(BC, append,
                    bar_group(Name,
                              bar(created, Created, green),
                              bar(freed, Freed, red)))),
        send(W, open).
member: construct makes the 
type-conversion system translate a bar-name into a bar. If the bar is 
somewhere in the middle, the remaining bars are compacted again.Bars can either be displayed directly on a bar_chart, or as part of a stack or group. Stacked bars are used to indicate composition of a value, while grouped bars often indicate development or otherwise related values for the same object.
->message and ->drag_message), 
these are the lowest and highest values that can be set by the user.<-value 
is forwarded over the code.->message and ->drag_message.A subclass of dialog_group that can be used to associate one or more buttons or other controllers with a bar or bar_stack. This association is achieved by simply creating an instance of this class. Figure 27 shows both associated buttons and a stacked bar.
 
| Figure 27 : Stacked bars with associated buttons |