Previous Contents Next

Constructing a Graphical Interface

The implementation of a graphical interface for a program is a tedious job if the tools at your disposal are not powerful enough, as this is the case with the Graphics library. The user-friendliness of a program derives in part from its interface. To ease the task of creating a graphical interface we will start by creating a new library called Awi which sits on top of Graphics and then we will use it as a simple module to help us construct the interface for an application.

This graphical interface manipulates components. A component is a region of the main window which can be displayed in a certain graphical context and can handle events that are sent to it. There are basically two kinds of components: simple components, such as a confirmation button or a text entry field, and containers which allow other components to be placed within them. A component can only be attached to a single container. Thus the interface of an application is built as a tree whose root corresponds to the main container (the graphics window), the nodes are also containers and the leaves are simple components or empty containers. This treelike structure helps us to propagate events arising from user interaction. If a container receives an event it checks whether one of its children can handle it, if so then it sends the event to that child, otherwise it deals with the event using its own handler.

The component is the essential element in this library. We define it as a record which contains details of size, a graphic context, the parent and child components along with functions for display and for handling events. Containers include a function for displaying their components. To define the component type, we build the types for the graphics context, for events and for initialization options. A graphical context is used to contain the details of ``graphical styles'' such as the colors of the background and foreground, the size of the characters, the current location of the component and the fonts that have been chosen. Then must we define the kinds of events which can be sent to the component. These are more varied than those in the Graphics library on which they are based. We include a simple option mechanism which helps us to configure graphics contexts or components. One implementation difficulty arises in positioning components within a container.

The general event handling loop receives physical events from the input function of the Graphics library, decides whether other events should be generated as a result of these physical events, and then sends them to the root container. We shall consider the following components: text display, buttons, list boxes, input regions and enriched components. Next we will show how the components are assembled to construct graphical interfaces, illustrating this with a program to convert between Francs and Euros. The various components of this application communicate with each other over a shared piece of state.

Graphics Context, Events and Options

Let's start by defining the base types along with the functions to initialize and modify graphics contexts, events and options. There is also an option type to help us parametrize the functions which create graphical objects.

Graphics Context

The graphics context allows us to keep track of the foreground and background colors, the font, its size, the current cursor position, and line width. This results in the following type.

type g_context = {
mutable bcol : Graphics.color;
mutable fcol : Graphics.color;
mutable font : string;
mutable font_size : int;
mutable lw : int;
mutable x : int;
mutable y : int };;

The make_default_context function creates a new graphics context containing default values 1.

# let default_font = "fixed"
let default_font_size = 12
let make_default_context () =
{ bcol = Graphics.white; fcol =;
font = default_font;
font_size = default_font_size;
lw = 1;
x = 0; y = 0;};;
val default_font : string = "fixed"
val default_font_size : int = 12
val make_default_context : unit -> g_context = <fun>

Access functions for the individual fields allow us to retrieve their values without knowing the implementation of the type itself.

# let get_gc_bcol gc = gc.bcol
let get_gc_fcol gc = gc.fcol
let get_gc_font gc = gc.font
let get_gc_font_size gc = gc.font_size
let get_gc_lw gc = gc.lw
let get_gc_cur gc = (gc.x,gc.y);;
val get_gc_bcol : g_context -> Graphics.color = <fun>
val get_gc_fcol : g_context -> Graphics.color = <fun>
val get_gc_font : g_context -> string = <fun>
val get_gc_font_size : g_context -> int = <fun>
val get_gc_lw : g_context -> int = <fun>
val get_gc_cur : g_context -> int * int = <fun>

The functions to modify those fields work on the same principle.

# let set_gc_bcol gc c = gc.bcol <- c
let set_gc_fcol gc c = gc.fcol <- c
let set_gc_font gc f = gc.font <- f
let set_gc_font_size gc s = gc.font_size <- s
let set_gc_lw gc i = gc.lw <- i
let set_gc_cur gc (a,b) = gc.x<- a; gc.y<-b;;
val set_gc_bcol : g_context -> Graphics.color -> unit = <fun>
val set_gc_fcol : g_context -> Graphics.color -> unit = <fun>
val set_gc_font : g_context -> string -> unit = <fun>
val set_gc_font_size : g_context -> int -> unit = <fun>
val set_gc_lw : g_context -> int -> unit = <fun>
val set_gc_cur : g_context -> int * int -> unit = <fun>

We can thus create new contexts, and read and write various fields of a value of the g_context type.

The use_gc function applies the data of a graphic context to the graphical window.

# let use_gc gc =
Graphics.set_color (get_gc_fcol gc);
Graphics.set_font (get_gc_font gc);
Graphics.set_text_size (get_gc_font_size gc);
Graphics.set_line_width (get_gc_lw gc);
let (a,b) = get_gc_cur gc in Graphics.moveto a b;;
val use_gc : g_context -> unit = <fun>

Some data, such as the background color, are not directly used by the Graphics library and do not appear in the use_gc function.


The Graphics library only contains a limited number of interaction events: mouse click, mouse movement and key press. We want to enrich the kind of event that arises from interaction by integrating events arising at the component level. To this end we define the type rich_event:

# type rich_event =
MouseDown | MouseUp | MouseDrag | MouseMove
| MouseEnter | MouseExit | Exposure
| GotFocus | LostFocus | KeyPress | KeyRelease;;

To create such events it is necessary to keep a history of previous events. The MouseDown and MouseMove events correspond to mouse events (clicking and moving) which are created by Graphics. Other mouse events are created by virtue of either the previous event MouseUp, or the last component which handled a physical event MouseExit. The Exposure event corresponds to a request to redisplay a component. The concept of focus expresses that a given component is interested in a certain kind of event. Typically the input of text to a component which has grabbed the focus means that this component alone will handle KeyPress and KeyRelease events. A MouseDown event on a text input component hands over the input focus to it and takes it away from the component which had it before.

These new events are created by the event handling loop described on page ??.


A graphical interface needs rules for describing the creation options for graphical objects (components, graphics contexts). If we wish to create a graphics context with a certain color it is currently necessary to construct it with the default values and then to call the two functions to modify the color fields in that context. In the case of more complex graphic objects this soon becomes tedious. Since we want to extend these options as we build up the components of the library, we need an ``extensible'' sum type. The only one provided by Objective CAML is the exn type used for exceptions. Because usingexn for handling options would affect the clarity of our programs we will only use this type for real exceptions. Instead, we will simulate an extensible sum type using pseudo constructors represented by character strings. We define the type opt_val for the values of these options. An option is a tuple whose first element is the name of the option and the second its value. The lopt type encompasses a list of such options.

# type opt_val = Copt of Graphics.color | Sopt of string
| Iopt of int | Bopt of bool;;
# type lopt = (string * opt_val) list ;;

The decoding functions take as input a list of options, an option name and a default value. If the name belongs to the list then the associated value is returned, if not then we get the default value. We show here only the decoding functions for integers and booleans, the others work on the same principle.

# exception OptErr;;
exception OptErr
# let theInt lo name default =
match List.assoc name lo with
Iopt i -> i
| _ -> raise OptErr
with Not_found -> default;;
val theInt : ('a * opt_val) list -> 'a -> int -> int = <fun>
# let theBool lo name default =
match List.assoc name lo with
Bopt b -> b
| _ -> raise OptErr
with Not_found -> default;;
val theBool : ('a * opt_val) list -> 'a -> bool -> bool = <fun>

We can now write a function to create a graphics context using a list of options in the following manner:

# let set_gc gc lopt =
set_gc_bcol gc (theColor lopt "Background" (get_gc_bcol gc));
set_gc_fcol gc (theColor lopt "Foreground" (get_gc_fcol gc));
set_gc_font gc (theString lopt "Font" (get_gc_font gc));
set_gc_font_size gc (theInt lopt "FontSize" (get_gc_font_size gc));
set_gc_lw gc (theInt lopt "LineWidth" (get_gc_lw gc));;
val set_gc : g_context -> (string * opt_val) list -> unit = <fun>

This allows us to ignore the order in which the options are passed in.

# let dc = make_default_context () in
set_gc dc [ "Foreground", Copt;
"Background", Copt Graphics.yellow];
- : g_context =
{bcol=16776960; fcol=255; font="fixed"; font_size=12; lw=1; x=0; y=0}

This results in a fairly flexible system which unfortunately partially evades the type system. The name of an option is of the type string and nothing prevents the construction of a nonexistant name. The result is simply that the value is ignored.

Components and Containers

The component is the essential building block of this library. We want to be able to create components and then easily assemble them to construct interfaces. They must be able to display themselves, to recognize an event destined for them, and to handle that event. Containers must be able to receive events from other components or to hand them on. We assume that a component can only be added to one container.

Construction of Components

A value of type component has a size (w and h), an absolute position in the main window (x and y), a graphics context used when it is displayed (gc), a flag to show whether it is a container (container), a parent - if it is itself attached to a container (parent), a list of child components (children) and four functions to handle positioning of components. These control how children are positioned within a component (layout), how the component is displayed (display), whether any given point is considered to be within the area of the component (mem) and finally a function for event handling (listener) which returns true if the event was handled and false otherwise. The parameter of the listener is of type (type rich_status) and contains the name of the event the lowlevel event information coming from the Graphics module, information on the keyboard focus and the general focus, as well as the last component to have handled an event. So we arrive at the following mutually recursive declarations:

# type component =
{ mutable info : string;
mutable x : int; mutable y : int;
mutable w :int ; mutable h : int;
mutable gc : g_context;
mutable container : bool;
mutable parent : component list;
mutable children : component list;
mutable layout_options : lopt;
mutable layout : component -> lopt -> unit;
mutable display : unit -> unit;
mutable mem : int * int -> bool;
mutable listener : rich_status -> bool }
and rich_status =
{ re : rich_event;
stat : Graphics.status;
mutable key_focus : component;
mutable gen_focus : component;
mutable last : component};;

We access the data fields of a component with the following functions.

# let get_gc c = c.gc;;
val get_gc : component -> g_context = <fun>
# let is_container c = c.container;;
val is_container : component -> bool = <fun>

The following three functions define the default behavior of a component. The function to test whether a given mouse position applies to a given component (in_rect) checks that the coordinate is within the rectangle defined by the coordinates of the component. The default display function (display_rect) fills the rectangle of the component with the background color found in the graphic context of that component. The default layout function (direct_layout) places components relatively within their containers. Valid options are "PosX" and "PosY", corresponding to the coordinates relative to the container.

# let in_rect c (xp,yp) =
(xp >= c.x) && (xp < c.x + c.w) && (yp >= c.y) && (yp < c.y + c.h) ;;
val in_rect : component -> int * int -> bool = <fun>
# let display_rect c () =
let gc = get_gc c in
Graphics.set_color (get_gc_bcol gc);
Graphics.fill_rect c.x c.y c.w c.h ;;
val display_rect : component -> unit -> unit = <fun>
# let direct_layout c c1 lopt =
let px = theInt lopt "PosX" 0
and py = theInt lopt "PosY" 0 in
c1.x <- c.x + px; c1.y <- c.y + py ;;
val direct_layout :
component -> component -> (string * opt_val) list -> unit = <fun>

It is now possible to define a component using the function create_component which takes width and height as parameters and uses the three preceding functions.

# let create_component iw ih =
let dc =
x=0; y=0; w=iw; h=ih;
gc = make_default_context() ;
container = false;
parent = []; children = [];
layout_options = [];
layout = (fun a b -> ());
display = (fun () -> ());
mem = (fun s -> false);
listener = (fun s -> false);}
dc.layout <- direct_layout dc;
dc.mem <- in_rect dc;
dc.display <- display_rect dc;
dc ;;
val create_component : int -> int -> component = <fun>

We then define the following empty component:

# let empty_component = create_component 0 0 ;;
This is used as a default value when we construct values which need to contain at least one component (for example a value of type rich_status).

Adding Child Components

The difficult part of adding a component to a container is how to position the component within the container. The layout field contains this positioning function. It takes a component (a child) and a list of options and calculates the new coordinates of the child within the container. Different options can be used according to the positioning function. We describe several layout functions when we talk about about the panel component (see below, page ??). Here we simply describe the mechanism for propagating the display function through the tree of components, coordinate changes, and propagating events. The propagation of actions makes intensive use of the List.iter function, which applies a function to all the elements of a list.

The function change_coord applies a relative change to the coordinates of a component and those of all its children.

# let rec change_coord c (dx,dy) =
c.x <- c.x + dx; c.y <- c.y + dy;
List.iter (fun s -> change_coord s (dx,dy) ) c.children;;
val change_coord : component -> int * int -> unit = <fun>

The add_component function checks that the conditions for adding a component have been met and then joins the parent (c) and the child (c1). The list of positioning options is retained in the child component, which allows us to reuse them when the positioning function of the parent changes. The list of options passed to this function are those used by the positioning function. There are three conditions which need to be prohibited: the child component is already a parent, the parent is not a container or the child is too large for parent

# let add_component c c1 lopt =
if c1.parent <> [] then failwith "add_component: already a parent"
if not (is_container c ) then
failwith "add_component: not a container"
if (c1.x + c1.w > c.w) || (c1.y + c1.h > c.h)
then failwith "add_component: bad position"
c.layout c1 lopt;
c1.layout_options <- lopt;
List.iter (fun s -> change_coord s (c1.x,c1.y)) c1.children;
c.children <- c1::c.children;
c1.parent <- [c] ;;
val add_component : component -> component -> lopt -> unit = <fun>

The removal of a component from some level in the tree, implemented by the following function, entails both a change to the link between the parent and the child and also a change to the coordinates of the child and all its own children:

# let remove_component c c1 =
c.children <- List.filter ((!=) c1) c.children;
c1.parent <- List.filter ((!=) c) c1.parent;
List.iter (fun s -> change_coord s (- c1.x, - c1.y)) c1.children;
c1.x <- 0; c1.y <- 0;;
val remove_component : component -> component -> unit = <fun>

A change to the positioning function of a container depends on whether it has any children. If it does not the change is immediate. Otherwise we must first remove the children of the container, modify the container's positioning function and then add the components back in with the same options used when they were originally added.

# let set_layout f c =
if c.children = [] then c.layout <- f
let ls = c.children in
List.iter (remove_component c) ls;
c.layout <- f;
List.iter (fun s -> add_component c s s.layout_options) ls;;
val set_layout : (component -> lopt -> unit) -> component -> unit = <fun>
This is why we kept the list of positioning options. If the list of options is not recognized by the new function it uses the defaults.

When a component is displayed, the display event must be propagated to its children. The container is displayed behind its children. The order of display of the children is unimportant because they never overlap.

# let rec display c =
c.display ();
List.iter (fun cx -> display cx ) c.children;;
val display : component -> unit = <fun>

Event Handling

The handling of physical events (mouse click, key press, mouse movement) uses the Graphics.wait_next_event function (see page ??) which returns a physical status (of type Graphics.status) following any user interaction. This physical status is used to calculate a rich status (of type rich_status) containing the event type (of type rich_event), the physical status, the components possessing the keyboard focus and the general focus along with the last component which successfully handled such an event. The general focus is a component which accepts all events.

Next we describe the functions for the manipulating of rich events, the propagation of this status information to components for them to be handled, the creation of the information and the main event-handling loop.

Functions used on Status

The following functions read the values of the mouse position and the focus. Functions on focus need a further parameter: the component which is capturing or losing that focus.

# let get_event e =;;
# let get_mouse_x e = e.stat.Graphics.mouse_x;;
# let get_mouse_y e = e.stat.Graphics.mouse_y;;
# let get_key e = e.stat.Graphics.key;;

# let has_key_focus e c = e.key_focus == c;;
# let take_key_focus e c = e.key_focus <- c;;
# let lose_key_focus e c = e.key_focus <- empty_component;;
# let has_gen_focus e c = e.gen_focus == c;;
# let take_gen_focus e c = e.gen_focus <- c;;
# let lose_gen_focus e c = e.gen_focus <- empty_component;;

Propagation of Events

A rich event is sent to a component to be handled. Analogous to the display mechanism discussed earlier, child components have priority over their parents for handling simple mouse movement. If a component receives status information associated with an event, it looks to see if it has a child which can handle it. If so, the child returns true otherwise false. If no child can handle the event, the parent component tries to use the function in its own listener field.

Status information coming from keyboard activity is propagated differently. The parent component looks to see if it possesses the keyboard focus, and if so it handles the event, otherwise it propagates to its children.

Some events are produced as a result of handling an initial event. For example, if one component captures the focus, then this means another has lost it. Such events are handled immediately by the target component. This is the same with the entry and exit events caused when the mouse is moved between different components.

The send_event function takes a value of type rich_status and a component. It returns a boolean indicating whether the event was handled or not.

# let rec send_event rs c =
match get_event rs with
MouseDown | MouseUp | MouseDrag | MouseMove ->
if c.mem(get_mouse_x rs, get_mouse_y rs) then
if List.exists (fun sun -> send_event rs sun) c.children then true
else ( if c.listener rs then (rs.last <-c; true) else false )
else false
| KeyPress | KeyRelease ->
if has_key_focus rs c then
( if c.listener rs then (rs.last<-c; true)
else false )
else List.exists (fun sun -> send_event rs sun) c.children
| _ -> c.listener rs;;
val send_event : rich_status -> component -> bool = <fun>

Note that the hierarchical structure of the components is really a tree and not a cyclic graph. This guarantees that the recursion in the send_event function cannot cause an infinite loop.

Event Creation

We differentiate between two kinds of events: those produced by a physical action (such as a mouse click) and those which arise from some action linked with the previous history of the system (such as the movement of the mouse cursor out of the screen area occupied by a component). As a result we define two functions for creating rich events.

The function which deals with the former kind constructs a rich event out of two sets of physical status information:

# let compute_rich_event s0 s1 =
if s0.Graphics.button <> s1.Graphics.button then
if s0.Graphics.button then MouseDown else MouseUp
else if s1.Graphics.keypressed then KeyPress
else if (s0.Graphics.mouse_x <> s1.Graphics.mouse_x ) ||
(s0.Graphics.mouse_y <> s1.Graphics.mouse_y ) then
if s1.Graphics.button then MouseDrag else MouseMove
else raise Not_found;;
val compute_rich_event : Graphics.status -> Graphics.status -> rich_event =

The function creating the latter kind of event uses the last two rich events:

# let send_new_events res0 res1 =
if res0.key_focus <> res1.key_focus then
ignore(send_event {res1 with re = LostFocus} res0.key_focus);
ignore(send_event {res1 with re = GotFocus} res1.key_focus)
if (res0.last <> res1.last) &&
(( = MouseMove) || ( = MouseDrag)) then
ignore(send_event {res1 with re = MouseExit} res0.last);
ignore(send_event {res1 with re = MouseEnter} res1.last )
val send_new_events : rich_status -> rich_status -> unit = <fun>

We define an initial value for the rich_event type. This is used to initialize the history of the event loop.

# let initial_re =
{ re = Exposure;
stat = { Graphics.mouse_x=0; Graphics.mouse_y=0;
Graphics.key = ' ';
Graphics.button = false;
Graphics.keypressed = false };
key_focus = empty_component;
gen_focus = empty_component;
last = empty_component } ;;

Event Loop

The event loop manages the sequence of interactions with a component, usually the ancestor component for all the components of the interface. It is supplied with two booleans indicating whether the interface should be redisplayed after every physical event has been handled (b_disp) and whether to handle mouse movement (b_motion). The final argument (c), is the root of the component tree.

# let loop b_disp b_motion c =
let res0 = ref initial_re in
display c;
while true do
let lev = [Graphics.Button_down; Graphics.Button_up;
Graphics.Key_pressed] in
let flev = if b_motion then (Graphics.Mouse_motion) :: lev
else lev in
let s = Graphics.wait_next_event flev
let res1 = {!res0 with stat = s} in
let res2 = {res1 with
re = compute_rich_event !res0.stat res1.stat} in
ignore(send_event res2 c);
send_new_events !res0 res2;
res0 := res2;
if b_disp then display c
with Not_found -> ()
with e -> raise e;;
val loop : bool -> bool -> component -> unit = <fun>
The only way out of this loop is when one of the handling routines raises an exception.

Test Functions

We define the following two functions to create by hand status information corresponding to mouse and keyboard events.

# let make_click e x y =
{re = e;
stat = {Graphics.mouse_x=x; Graphics.mouse_y=y;
Graphics.key = ' '; Graphics.button = false;
Graphics.keypressed = false};
key_focus = empty_component;
gen_focus = empty_component;
last = empty_component}

let make_key e ch c =
{re = e;
stat = {Graphics.mouse_x=0; Graphics.mouse_y=0;
Graphics.key = c; Graphics.button = false;
Graphics.keypressed = true};
key_focus = empty_component;
gen_focus = empty_component;
last = empty_component};;
val make_click : rich_event -> int -> int -> rich_status = <fun>
val make_key : rich_event -> 'a -> char -> rich_status = <fun>

We can now simulate the sending of a mouse event to a component for test purposes.

Defining Components

The various mechanisms for display, coordinate change and, propagating event are now in place. It remains for us to define some components which are both useful and easy to use. We can classify components into the following three categories: Values are passed between components, or between a component and the application by modification of shared data. The sharing is implemented by closures which contain in their environment the data to be modified. Moreover, as the behavior of the component can change as a result of event handling, components also contain an internal state in the closures of their handling functions. For example the handling function for an input field has access to text while it is being written. To this end we implement components in the following manner: Creation functions take a list of options to configure the graphics context. The calculation of the size of a component when it is created needs to make use of graphics context of the graphical window in order to determine the width of the text to be displayed.

We describe the implementation of the following components:

The Label Component

The simplest component, called a label, displays a string of characters on the screen. It does not handle events. We will start by describing the display function and then the creation function.

Display must take account of the foreground and background colors and the character font. It is the job of the display_init function to erase the graphical region of the component, select the foreground color and position the cursor. The function display_label displays the string passed as a parameter immediately after the call to display_init.

# let display_init c =
Graphics.set_color (get_gc_bcol (get_gc c)); display_rect c ();
let gc= get_gc c in
use_gc gc;
let (a,b) = get_gc_cur gc in
Graphics.moveto (c.x+a) (c.y+b)
let display_label s c () =
display_init c; Graphics.draw_string s;;
val display_init : component -> unit = <fun>
val display_label : string -> component -> unit -> unit = <fun>

As this component is very simple it is not necessary to create any internal state. Only the function display_label knows the string to be displayed, which is passed by the creation function.

# let create_label s lopt =
let gc = make_default_context () in set_gc gc lopt; use_gc gc;
let (w,h) = Graphics.text_size s in
let u = create_component w h in
u.mem <- (fun x -> false); u.display <- display_label s u; <- "Label"; u.gc <- gc;
val create_label : string -> (string * opt_val) list -> component = <fun>

If we wish to change the colors of this component, we need to manipulate its graphic context directly.

The display of label l1 below is depicted in figure 13.1.

# let courier_bold_24 = Sopt "*courier-bold-r-normal-*24*"
and courier_bold_18 = Sopt "*courier-bold-r-normal-*18*";;
# let l1 = create_label "Login: " ["Font", courier_bold_24;
"Background", Copt gray1];;

Figure 13.1: Displaying a label.

The panel Component, Containers and Layout

A panel is a graphical area which can be a container. The function which creates a panel is very simple. It augments the general function for creating components with a boolean indicating whether it is a container. The functions for testing location within the panel and for display are those assigned by default in the create_component function.

# let create_panel b w h lopt =
let u = create_component w h in
u.container <- b; <- if b then "Panel container" else "Panel";
let gc = make_default_context () in set_gc gc lopt; u.gc <- gc;
val create_panel :
bool -> int -> int -> (string * opt_val) list -> component = <fun>

The tricky part with containers lies in the positioning of their child components. We define two new layout functions: center_layout and grid_layout. The first, center_layout places a component at the center of a container:

# let center_layout c c1 lopt =
c1.x <- c.x + ((c.w -c1.w) /2); c1.y <- c.y + ((c.h -c1.h) /2);;
val center_layout : component -> component -> 'a -> unit = <fun>

The second, grid_layout divides a container into a grid where each box has the same size. The layout options in this case are "Col" for the column number and "Row" for the row number.

# let grid_layout (a, b) c c1 lopt =
let px = theInt lopt "Col" 0
and py = theInt lopt "Row" 0 in
if (px >= 0) && (px < a) && ( py >=0) && (py < b) then
let lw = c.w /a
and lh = c.h /b in
if (c1.w > lw) || (c1.h > lh) then
failwith "grid_placement: too big component"
c1.x <- c.x + px * lw + (lw - c1.w)/2;
c1.y <- c.y + py * lh + (lh - c1.h)/2;
else failwith "grid_placement: bad position";;
val grid_layout :
int * int -> component -> component -> (string * opt_val) list -> unit =
It is clearly possible to define more. One can also customize a container by changing its layout function (set_layout). Figure 13.2 shows a panel, declared as a container, in which two labels have been added and which corresponds to the following program:

Figure 13.2: A panel component.

# let l2 = create_label "Passwd: " ["Font", courier_bold_24;
"Background", Copt gray1] ;;
# let p1 = create_panel true 150 80 ["Background", Copt gray2] ;;
# set_layout (grid_layout (1,2) p1) p1;;
# add_component p1 l1 ["Row", Iopt 1];;
# add_component p1 l2 ["Row", Iopt 0];;

Since the components need at least one parent so that they can be integrated into the interface, and since the Graphics library only supports one window, we must define a principle window which is a container.

# let open_main_window w h =
Graphics.open_graph (" "^(string_of_int w)^"x"^(string_of_int h));
let u = create_component w h in
u.container <- true; <- "Main Window";
val open_main_window : int -> int -> component = <fun>

The Button Component

A button is a component which displays a text in its graphical region and reacts to mouse clicks which occur there. To support this behavior it retains a piece of state, a value of type button_state, which contains the text and the mouse handling function.

# type button_state =
{ txt : string; mutable action : button_state -> unit } ;;

The function create_bs creates this state. The set_bs_action function changes the handling function and the function get_bs_text retrieves the text of a button.

# let create_bs s = {txt = s; action = fun x -> ()}
let set_bs_action bs f = bs.action <- f
let get_bs_text bs = bs.txt;;
val create_bs : string -> button_state = <fun>
val set_bs_action : button_state -> (button_state -> unit) -> unit = <fun>
val get_bs_text : button_state -> string = <fun>

The display function is similar to that used by labels with the exception that the text derives this time from the state information belonging to the button. By default the listening function activates the action function when a mouse button is pressed.

# let display_button c bs () =
display_init c; Graphics.draw_string (get_bs_text bs)
let listener_button c bs e = match get_event e with
MouseDown -> bs.action bs; c.display (); true
| _ -> false;;
val display_button : component -> button_state -> unit -> unit = <fun>
val listener_button : component -> button_state -> rich_status -> bool =

We now have all we need to define the creation function for simple buttons:

# let create_button s lopt =
let bs = create_bs s in
let gc = make_default_context () in
set_gc gc lopt; use_gc gc;
let w,h = Graphics.text_size (get_bs_text bs) in
let u = create_component w h in
u.display <- display_button u bs;
u.listener <- listener_button u bs; <- "Button";
u.gc <- gc;
val create_button :
string -> (string * opt_val) list -> component * button_state = <fun>
This returns a tuple of which the first element is the button which has been created and the second is the internal state of the button. The latter value is particularly useful if we want to change the action function of the button since the button state is not accessible via the button function.

Figure 13.3 shows a panel to which a button has been added. We have associated an action function which displays the string contained by the button on the standard output.

Figure 13.3: Button display and reaction to a mouseclick.

# let b,bs = create_button "Validation" ["Font", courier_bold_24;
"Background", Copt gray1];;
# let p2 = create_panel true 150 60 ["Background", Copt gray2];;
# set_bs_action bs (fun bs -> print_string ( (get_bs_text bs)^ "...");
# set_layout (center_layout p2) p2;;
# add_component p2 b [];;

In contrast to labels, a button component knows how to react to a mouse click. To test this feature we send the event ``mouse click'' to a central position on the panel p2, which is occupied by the button. This causes the action associated with the button to be carried out:

# send_event (make_click MouseDown 75 30) p2;;
- : bool = true
and returns the value true showing that the event has indeed been handled.

The choice Component

The choice component allows us to select one of the choices offered using a mouse click. There is always a current choice. A mouse click on another choice causes the current choice to change and causes an action to be carried out. We use the same technique we used previously for simple buttons. We start by defining the state needed by a choice list:

# type choice_state =
{ mutable ind : int; values : string array; mutable sep : int;
mutable height : int; mutable action : choice_state -> unit } ;;
The index ind shows which string is to be highlighted in the list of values. The sep and height fields describe in pixels the distance between two choices and the height of a choice. The action function takes an argument of type choice_state as an input and does its job using the index.

We now define the function to create a set of status information and the function to change to way it is handled.

# let create_cs sa = {ind = 0; values = sa; sep = 2;
height = 1; action = fun x -> ()}
let set_cs_action cs f = cs.action <- f
let get_cs_text cs = cs.values.(cs.ind);;
val create_cs : string array -> choice_state = <fun>
val set_cs_action : choice_state -> (choice_state -> unit) -> unit = <fun>
val get_cs_text : choice_state -> string = <fun>

The display function shows the list of all the possible choices and accentuates the current choice in inverse video. The event handling function reacts to a release of the mouse button.

# let display_choice c cs () =
display_init c;
let (x,y) = Graphics.current_point()
and nb = Array.length cs.values in
for i = 0 to nb-1 do
Graphics.moveto x (y + i*(cs.height+ cs.sep));
Graphics.draw_string cs.values.(i)
Graphics.set_color (get_gc_fcol (get_gc c));
Graphics.fill_rect x (y+ cs.ind*(cs.height+ cs.sep)) c.w cs.height;
Graphics.set_color (get_gc_bcol (get_gc c));
Graphics.moveto x (y + cs.ind*(cs.height + cs.sep));
Graphics.draw_string cs.values.(cs.ind) ;;
val display_choice : component -> choice_state -> unit -> unit = <fun>

# let listener_choice c cs e = match with
MouseUp ->
let x = e.stat.Graphics.mouse_x
and y = e.stat.Graphics.mouse_y in
let cy = c.y in
let i = (y - cy) / ( cs.height + cs.sep) in
cs.ind <- i; c.display ();
cs.action cs; true
| _ -> false ;;
val listener_choice : component -> choice_state -> rich_status -> bool =

To create a list of possible choices we take a list of strings and a list of options, and we return the component itself along with its internal state.

# let create_choice lc lopt =
let sa = (Array.of_list (List.rev lc)) in
let cs = create_cs sa in
let gc = make_default_context () in
set_gc gc lopt; use_gc gc;
let awh = (Graphics.text_size) cs.values in
let w = Array.fold_right (fun (x,y) -> max x) awh 0
and h = Array.fold_right (fun (x,y) -> max y) awh 0 in
let h1 = (h+cs.sep) * (Array.length sa) + cs.sep in
cs.height <- h;
let u = create_component w h1 in
u.display <- display_choice u cs;
u.listener <- listener_choice u cs ; <- "Choice "^ (string_of_int (Array.length cs.values));
u.gc <- gc;
val create_choice :
string list -> (string * opt_val) list -> component * choice_state = <fun>

The sequence of three pictures in figure 13.4 shows a panel to which a list of choices has been added. To it we have bound an action function which displays the chosen string to the standard output. The pictures arise from mouse clicks simulated by the following program.

Figure 13.4: Displaying and selecting from a choice list.

# let c,cs = create_choice ["Helium"; "Gallium"; "Pentium"]
["Font", courier_bold_24;
"Background", Copt gray1];;
# let p3 = create_panel true 110 110 ["Background", Copt gray2];;
# set_cs_action cs (fun cs -> print_string ( (get_cs_text cs)^"...");
# set_layout (center_layout p3) p3;;
# add_component p3 c [];;

Here also we can test the component straight away by sending several events. The following changes the selection, as is shown in the central picture in figure 13.4.

# send_event (make_click MouseUp 60 55 ) p3;;
- : bool = true

The sending of the following event selects the first element in the choice list

# send_event (make_click MouseUp 60 90 ) p3;;
- : bool = true

The textfield Component

The text input field, or textfield, is an area which enables us to input a text string. The text can be aligned to the left or (typically for a calculator) the right. Furthermore a cursor shows where the next character will be entered. Here we need a more complex internal state. This includes the text which is being entered, the direction of the justification, a description of the cursor, a description of how the characters are displayed and the action function.

# type textfield_state =
{ txt : string;
dir : bool; mutable ind1 : int; mutable ind2 : int; len : int;
mutable visible_cursor : bool; mutable cursor : char;
mutable visible_echo : bool; mutable echo : char;
mutable action : textfield_state -> unit } ;;

To create this internal state we need the initial text, the number of characters available for the text input field and the justification of the text.

# let create_tfs txt size dir =
let l = String.length txt in
(if size < l then failwith "create_tfs");
let ind1 = if dir then 0 else size-1-l
and ind2 = if dir then l else size-1 in
let n_txt = (if dir then (txt^(String.make (size-l) ' '))
else ((String.make (size-l) ' ')^txt )) in
{txt = n_txt; dir=dir; ind1 = ind1; ind2 = ind2; len=size;
visible_cursor = false; cursor = ' '; visible_echo = true; echo = ' ';
action= fun x -> ()};;
val create_tfs : string -> int -> bool -> textfield_state = <fun>

The following functions allow us to access various fields, including the displayed text.

# let set_tfs_action tfs f = tfs.action <- f
let set_tfs_cursor b c tfs = tfs.visible_cursor <- b; tfs.cursor <- c
let set_tfs_echo b c tfs = tfs.visible_echo <- b; tfs.echo <- c
let get_tfs_text tfs =
if tfs.dir then String.sub tfs.txt tfs.ind1 (tfs.ind2 - tfs.ind1)
else String.sub tfs.txt (tfs.ind1+1) (tfs.ind2 - tfs.ind1);;

The set_tfs_text function changes the text within the internal state tfs of the component tf with the string txt.

# let set_tfs_text tf tfs txt =
let l = String.length txt in
if l > tfs.len then failwith "set_tfs_text";
String.blit (String.make tfs.len ' ') 0 tfs.txt 0 tfs.len;
if tfs.dir then (String.blit txt 0 tfs.txt 0 l;
tfs.ind2 <- l )
else ( String.blit txt 0 tfs.txt (tfs.len -l) l;
tfs.ind1 <- tfs.len-l-1 );
tf.display ();;
val set_tfs_text : component -> textfield_state -> string -> unit = <fun>

Display operations must take account of how the character is echoed and the visibility of the cursor. The display_textfield function calls the display_cursor function which shows where the cursor is.

# let display_cursor c tfs =
if tfs.visible_cursor then
( use_gc (get_gc c);
let (x,y) = Graphics.current_point() in
let (a,b) = Graphics.text_size " " in
let shift = a * (if tfs.dir then max (min (tfs.len-1) tfs.ind2) 0
else tfs.ind2) in
Graphics.moveto (c.x+x + shift) (c.y+y);
Graphics.draw_char tfs.cursor);;
val display_cursor : component -> textfield_state -> unit = <fun>
# let display_textfield c tfs () =
display_init c;
let s = String.make tfs.len ' '
and txt = get_tfs_text tfs in
let nl = String.length txt in
if (tfs.ind1 >= 0) && (not tfs.dir) then
Graphics.draw_string (String.sub s 0 (tfs.ind1+1) );
if tfs.visible_echo then (Graphics.draw_string (get_tfs_text tfs))
else Graphics.draw_string (String.make (String.length txt) tfs.echo);
if (nl > tfs.ind2) && (tfs.dir)
then Graphics.draw_string (String.sub s tfs.ind2 (nl-tfs.ind2));
display_cursor c tfs;;
val display_textfield : component -> textfield_state -> unit -> unit = <fun>

The event-listener function for this kind of component is more complex. According to the input direction (left or right justified) we may need to move the string which has already been input. Capture of focus is achieved by a mouse click in the input zone.

# let listener_text_field u tfs e =
match with
MouseDown -> take_key_focus e u ; true
| KeyPress ->
( if Char.code (get_key e) >= 32 then
( if tfs.dir then
( ( if tfs.ind2 >= tfs.len then (
String.blit tfs.txt 1 tfs.txt 0 (tfs.ind2-1);
tfs.ind2 <- tfs.ind2-1) );
tfs.txt.[tfs.ind2] <- get_key e;
tfs.ind2 <- tfs.ind2 +1 )
( String.blit tfs.txt 1 tfs.txt 0 (tfs.ind2);
tfs.txt.[tfs.ind2] <- get_key e;
if tfs.ind1 >= 0 then tfs.ind1 <- tfs.ind1 -1
else (
( match Char.code (get_key e) with
13 -> tfs.action tfs
| 9 -> lose_key_focus e u
| 8 -> if (tfs.dir && (tfs.ind2 > 0))
then tfs.ind2 <- tfs.ind2 -1
else if (not tfs.dir) && (tfs.ind1 < tfs.len -1)
then tfs.ind1 <- tfs.ind1+1
| _ -> ()
))); u.display(); true
| _ -> false;;
val listener_text_field :
component -> textfield_state -> rich_status -> bool = <fun>

The function which creates text entry fields repeats the same pattern we have seen in the previous components.

# let create_text_field txt size dir lopt =
let tfs = create_tfs txt size dir
and l = String.length txt in
let gc = make_default_context () in
set_gc gc lopt; use_gc gc;
let (w,h) = Graphics.text_size (tfs.txt) in
let u = create_component w h in
u.display <- display_textfield u tfs;
u.listener <- listener_text_field u tfs ; <- "TextField"; u.gc <- gc;
val create_text_field :
string ->
int -> bool -> (string * opt_val) list -> component * textfield_state =

This function returns a tuple consisting of the component itself, and the internal state of that component. We can test the creation of the component in figure 13.5 as follows:

# let tf1,tfs1 = create_text_field "jack" 8 true ["Font", courier_bold_24];;
# let tf2,tfs2 = create_text_field "koala" 8 false ["Font", courier_bold_24];;
# set_tfs_cursor true '_' tfs1;;
# set_tfs_cursor true '_' tfs2;;
# set_tfs_echo false '*' tfs2;;
# let p4 = create_panel true 140 80 ["Background", Copt gray2];;
# set_layout (grid_layout (1,2) p4) p4;;
# add_component p4 tf1 ["Row", Iopt 1];;
# add_component p4 tf2 ["Row", Iopt 0];;

Figure 13.5: Text input component.

Enriched Components

Beyond the components described so far, it is also possible to construct new ones, for example components with bevelled edges such as those in the calculator on page ??. To create this effect we construct a panel larger than the component, fill it out in a certain way and add the required component to the center.

# type border_state =
{mutable relief : string; mutable line : bool;
mutable bg2 : Graphics.color; mutable size : int};;

The creation function takes a list of options and constructs an internal state.

# let create_border_state lopt =
{relief = theString lopt "Relief" "Flat";
line = theBool lopt "Outlined" false;
bg2 = theColor lopt "Background2";
size = theInt lopt "Border_size" 2};;
val create_border_state : (string * opt_val) list -> border_state = <fun>

We define the profile of the border used in the boxes of figure 5.6 (page ??) by defining the options "Top", "Bot" and "Flat".

# let display_border bs c1 c () =
let x1 = c.x and y1 = c.y in
let x2 = x1+c.w-1 and y2 = y1+c.h-1 in
let ix1 = c1.x and iy1 = c1.y in
let ix2 = ix1+c1.w-1 and iy2 = iy1+c1.h-1 in
let border1 g = Graphics.set_color g;
Graphics.fill_poly [| (x1,y1);(ix1,iy1);(ix2,iy1);(x2,y1) |] ;
Graphics.fill_poly [| (x2,y1);(ix2,iy1);(ix2,iy2);(x2,y2) |]
let border2 g = Graphics.set_color g;
Graphics.fill_poly [| (x1,y2);(ix1,iy2);(ix2,iy2);(x2,y2) |] ;
Graphics.fill_poly [| (x1,y1);(ix1,iy1);(ix1,iy2);(x1,y2) |]
display_rect c ();
if bs.line then (Graphics.set_color (get_gc_fcol (get_gc c));
draw_rect x1 y1 c.w c.h);
let b1_col = get_gc_bcol ( get_gc c)
and b2_col = bs.bg2 in
match bs.relief with
"Top" -> (border1 b1_col; border2 b2_col)
| "Bot" -> (border1 b2_col; border2 b1_col)
| "Flat" -> (border1 b1_col; border2 b1_col)
| s -> failwith ("display_border: unknown relief: "^s)
val display_border : border_state -> component -> component -> unit -> unit =

The function which creates a border takes a component and a list of options, it constructs a panel containing that component.

# let create_border c lopt =
let bs = create_border_state lopt in
let p = create_panel true (c.w + 2 * bs.size)
(c.h + 2 * bs.size) lopt in
set_layout (center_layout p) p;
p.display <- display_border bs c p;
add_component p c []; p;;
val create_border : component -> (string * opt_val) list -> component = <fun>

Now we can test creating a component with a border on the label component and the text entry field tf1 defined by in our previous tests. The result is show in figure 13.6.

# remove_component p1 l1;;
# remove_component p4 tf1;;
# let b1 = create_border l1 [];;
# let b2 = create_border tf1 ["Relief", Sopt "Top";
"Background", Copt;
"Border_size", Iopt 4];;
# let p5 = create_panel true 140 80 ["Background", Copt gray2];;
# set_layout (grid_layout (1,2) p5) p5;;
# add_component p5 b1 ["Row", Iopt 1];;
# add_component p5 b2 ["Row", Iopt 0];;

Figure 13.6: An enriched component.

Setting up the Awi Library

The essential parts of our library have now been written. All declarations 2 of types and values which we have seen so far in this section can be grouped together in one file. This library consists of one single module. If the file is called then we get a module called Awi. The link between the name of the file and that of the module is described in chapter 14.

Compiling this file will produce a compiled interface file awi.cmi and, depending on the compiler being used, the bytecode itself awi.cmo or else the native machine code awi.cmx. To use the bytecode compiler we enter the following command
ocamlc -c
To use it at the interactive toplevel, we need to load the bytecode of our new library with the command #load "awi.cmo";; having also previously ensured that we have loaded the Graphics library. We can then start calling functions from the module to create and work with components.
# open Awi;;
# create_component;;
- : int -> int -> Awi.component = <fun>
The result type of this function is Awi.component, chapter 14 explains more about this.

Example: A Franc-Euro Converter

We will now build a currency converter between Francs and Euros using this new library. The actual job of conversion is trivial, but the construction of the interface will show how the components communicate with each other. While we are getting used to the new currency we need to convert in both directions. Here are the components we have chosen: These different components are shown in figure 13.7.

Communication between the components is implemented by sharing state. For this purpose we define the type state_conv which hold the fields for francs (a), euros (b), the direction in which the conversion is to be performed (dir) and the conversion factors (fa and fb).

# type state_conv =
{ mutable a:float; mutable b:float; mutable dir : bool;
fa : float; fb : float } ;;

We define the initial state as follows:

# let e = 6.55957074
let fe = { a =0.0; b=0.0; dir = true; fa = e; fb = 1./. e};;

The conversion function returns a floating result following the direction of the conversion.

# let calculate fe =
if fe.dir then fe.b <- fe.a /. fe.fa else fe.a <- fe.b /. fe.fb;;
val calculate : state_conv -> unit = <fun>

A mouse click on the list of two choices changes the direction of the conversion. The text of the choice strings is "->" and "<-".

# let action_dir fe cs = match get_cs_text cs with
"->" -> fe.dir <- true
| "<-" -> fe.dir <- false
| _ -> failwith "action_dir";;
val action_dir : state_conv -> choice_state -> unit = <fun>

The action associated with the simple button causes the calculation to be performed and displays the result in one of the two text entry fields. For this to be possible we pass the two text entry fields as parameters to the action.

# let action_go fe tf_fr tf_eu tfs_fr tfs_eu x =
if fe.dir then
let r = float_of_string (get_tfs_text tfs_fr) in
fe.a <- r; calculate fe;
let sr = Printf.sprintf "%.2f" fe.b in
set_tfs_text tf_eu tfs_eu sr
let r = float_of_string (get_tfs_text tfs_eu) in
fe.b <- r; calculate fe;
let sr = Printf.sprintf "%.2f" fe.a in
set_tfs_text tf_fr tfs_fr sr;;
val action_go :
state_conv ->
component -> component -> textfield_state -> textfield_state -> 'a -> unit =

It now remains to build the interface. The following function takes a width, a height and a conversion state and returns the main container with the three active components.

# let create_conv w h fe =
let gray1 = (Graphics.rgb 120 120 120) in
let m = open_main_window w h
and p = create_panel true (w-4) (h-4) []
and l1 = create_label "Francs" ["Font", courier_bold_24;
"Background", Copt gray1]
and l2 = create_label "Euros" ["Font", courier_bold_24;
"Background", Copt gray1]
and c,cs = create_choice ["->"; "<-"] ["Font", courier_bold_18]
and tf1,tfs1 = create_text_field "0" 10 false ["Font", courier_bold_18]
and tf2,tfs2 = create_text_field "0" 10 false ["Font", courier_bold_18]
and b,bs = create_button " Go " ["Font", courier_bold_24]
let gc = get_gc m in
set_gc_bcol gc gray1;
set_layout (grid_layout (3,2) m ) m;
let tb1 = create_border tf1 []
and tb2 = create_border tf2 []
and bc = create_border c []
and bb =
create_border b
["Border_size", Iopt 4; "Relief", Sopt "Bot";
"Background", Copt gray2; "Background2", Copt]
set_cs_action cs (action_dir fe);
set_bs_action bs (action_go fe tf1 tf2 tfs1 tfs2);
add_component m l1 ["Col",Iopt 0;"Row",Iopt 1];
add_component m l2 ["Col",Iopt 2;"Row",Iopt 1];
add_component m bc ["Col",Iopt 1;"Row",Iopt 1];
add_component m tb1 ["Col",Iopt 0;"Row",Iopt 0];
add_component m tb2 ["Col",Iopt 2;"Row",Iopt 0];
add_component m bb ["Col",Iopt 1;"Row",Iopt 0];
val create_conv :
int ->
int -> state_conv -> component * button_state * component * component =

The event handling loop is started on the container m constructed below. The resulting display is shown in figure 13.7.

# let (m,c,t1,t2) = create_conv 420 150 fe ;;
# display m ;;

Figure 13.7: Calculator window.

One click on the choice list changes both the displayed text and the direction of the conversion because all the event handling closures share the same state.

Where to go from here

Closures allow us to register handling methods with graphical components. It is however impossible to ``reopen'' these closures to extend an existing handler with additional behavior. We need to define a completely new handler. We discuss the possibilities for extending handlers in chapter 16 where we compare the functional and object-oriented paradigms.

In our application many of the structures declared have fields with identical names (for example txt). The last declaration masks all previous occurences. This means that it becomes difficult to use the field names directly and this is why we have declared a set of access functions for every type we have defined. Another possibility would be to cut our library up into several modules. From then on field names could be disambiguated by using the module names. Nonetheless, with the help of the access functions, we can already make full use of the library. Chapter 14 returns to the topic of type overlaying and introduces abstract data types. The use of overlaying can, among other things, increase robustness by preventing the modification of sensitive data fields, such as the parent child relationships between the components which should not allow the construction of a circular graph.

There are many possible ways to improve this library.

One criterion in our design for components was that it should be possible to write new ones. It is fairly easy to create components of an arbitrary shape by using new definitions of the mem and display functions. In this way one could create buttons which have an oval or tear-shaped form.

The few layout algorithms presented are not as helpful as they could be. One could add a grid layout whose squares are of variable size and width. Or maybe we want to place components alongside each other so long as there is enough room. Finally we should anticipate the possibility that a change to the size of a component may be propagated to its children.

Previous Contents Next