Construction d'une interface graphique
La réalisation de l'interface graphique d'un programme est un travail
fastidieux si les outils pour le faire ne sont pas assez riches. C'est
le cas avec la bibliothèque Graphics. Le confort
d'utilisation d'un programme provient en partie de son interface. Pour
cela nous allons tout d'abord construire, au dessus de
Graphics, une nouvelle bibliothèque, appelée Upi
et l'utiliser en tant que module simple pour la construction de
l'interface d'une application.
Cette interface graphique manipule des composants. Un
composant est une zone de la fenêtre principale qui peut être
affichée, dans un certain contexte graphique, et traiter des
événements qui lui sont destinés. Il y a principalement deux types de
composants : les composants simples, comme un bouton de confirmation
ou une zone de saisie d'un texte, et les conteneurs qui acceptent
de recevoir dans leur zone d'autres composants. Un composant ne peut
être attaché qu'à un seul conteneur. L'interface d'une application
devient alors un arbre dont la racine correspond au conteneur principal
(la fenêtre graphique), les noeuds sont d'autres conteneurs et les
feuilles des composants simples ou des conteneurs sans
descendant. Cette arborescence facilite la propagation des événements
produits par l'interaction avec l'utilisateur. Si un composant reçoit un
événement, il vérifie si l'un de ses descendants peut le traiter, si oui
il le lui envoie et sinon il effectue l'action associée à cet événement.
Le composant est l'élément essentiel de cette bibliothèque. Nous le
définissons comme un enregistrement qui contient principalement des
informations de taille, un contexte graphique, le composant père et
les composants fils, ainsi que les fonctions d'affichage et de
traitement des événements. Les conteneurs possèdent une fonction de
placement des composants. Pour pouvoir définir le type
component, on construit les types pour le contexte graphique,
les événements et les options de création. Un contexte graphique est
utilisé pour les informations de << styles graphiques >> comme les couleurs
de fond et de tracé, la largeur des traits, le point courant du
composant et les polices de caractères choisies. On définit ensuite
la nature des événements envoyés aux composants. Ceux-ci sont plus
variés que ceux de la bibliothèque Graphics sur lesquels
ils reposent. On intègre un mécanisme simple d'options qui facilite
la spécialisation de contextes graphiques ou de composants. Une
difficulté d'implantation provient du placement d'un composant dans un
conteneur.
La boucle générale de gestion des événements reçoit des événements
physiques par la fonction d'écoute de la bibliothèque
Graphics, détermine si d'autres événements sont conséquence
de ces événements physiques puis les envoie au composant racine. On
décrit ensuite les composants suivants : textes à afficher, boutons,
listes de choix, zones de saisie et composants enrichis.
On montre l'assemblage de composants pour la construction d'interfaces
graphiques, en l'illustrant par un convertisseur Francs/Euros. Les
divers composants de cette application communiquent entre eux en
partageant un état.
Contexte graphique, événements et options
On définit les types de base, et les fonctions de création et de
modification, des contextes graphiques, des événements et des options.
Ce dernier type facilite la paramétrisation des fonctions de création
d'objets graphiques.
Contexte graphique
Le contexte graphique permet de tenir compte des couleurs de fond et
d'encre, de la police de caractère, de la largeur des traits et du
point courant. Le type suivant découle de cette définition.
# 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
};;
La fonction make_default_context crée un nouveau contexte graphique contenant
des valeurs par défaut1.
# let
default_font
=
"fixed"
let
default_font_size
=
1
2
let
make_default_context
()
=
{
bcol
=
Graphics.white;
fcol
=
Graphics.black;
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>
Les fonctions d'accès aux champs permettent de récupérer les différentes valeurs d'un contexte graphique sans connaître la représentation du type.
# 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>
Les fonctions de modification des champs reposent sur le même modèle.
# 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>
On peut ainsi créer de nouveaux contextes, avoir accès aux différents champs d'un contexte
et modifier un des champs d'une valeur de type g_context.
La fonction use_gc applique à la fenêtre graphique les
informations du contexte graphique.
# 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>
Certaines informations, comme la couleur du fond, ne sont pas
directement exploitables par la bibliothèque Graphics et
n'apparaissent pas dans la fonction use_gc.
Événements
La bibliothèque Graphics ne contient qu'un nombre limité
d'événements d'interaction : clic souris, déplacement de souris
et appui de touche. On désire enrichir la nature des événements
survenant dans l'interaction en intégrant des événements propres aux
composants. Pour cela on définit le type rich_event :
# type
rich_event
=
MouseDown
|
MouseUp
|
MouseDrag
|
MouseMove
|
MouseEnter
|
MouseExit
|
Exposure
|
GotFocus
|
LostFocus
|
KeyPress
|
KeyRelease;;
Pour pouvoir engendrer de tels événements, il est nécessaire de
conserver un historique des derniers événements produits. Les
événements MouseDown et MouseMove correspondent
respectivement aux événements de la souris (clic et déplacement)
gérés par Graphics. Les autres événements souris sont
créés en fonction soit de l'avant dernier événement (MouseUp)
ou du dernier composant ayant traité un événement physique
(MouseExit). L'événement Exposure correspond à une
demande de réaffichage du composant. La notion de focus
exprime l'attention particulière d'un composant à un type
d'événement. Typiquement, la saisie d'un texte dans un composant
ayant accaparé le focus du clavier indique qu'il est le seul à
traiter les événements KeyPress et KeyRelease. Un
événement MouseDown sur un composant <<saisie de texte>> lui
donnera le focus clavier en le retirant du composant qui le possédait
éventuellement.
La création de ces nouveaux événements est contrôlée par la boucle de
gestion des événements, décrite page ??.
Options
Une interface graphique a besoin d'une règle pour le passage et le
décodage des options de création des objets graphiques (composants,
contextes graphiques). Si l'on veut créer un contexte graphique avec
des couleurs spécifiques, il est actuellement nécessaire de construire
un contexte graphique avec les valeurs par défaut puis d'appeler les
deux fonctions de modification des champs de couleur sur ce
contexte. Dans le cas d'objets graphiques plus complexes, cela peut
devenir très vite fastidieux. Ces options doivent pouvoir être
étendues ce qui permet d'augmenter les composants de la
bibliothèque. Il y a besoin d'un type somme << extensible >>. Le seul
fourni par Objective CAML est le type exn pour les
exceptions. Comme il est préférable pour la clarté des programmes de
n'utiliser ce type que pour de vraies exceptions, on simule un type
somme extensible par des faux constructeurs représentés par des
chaînes de caractères. On définit le type opt_val pour les
valeurs des options. Une option devient un couple dont le premier
élément est le nom de l'option et le deuxième sa valeur. Le type
lopt regroupe une liste d'options.
# type
opt_val
=
Copt
of
Graphics.color
|
Sopt
of
string
|
Iopt
of
int
|
Bopt
of
bool;;
# type
lopt
=
(string
*
opt_val)
list
;;
Les fonctions de décodage prennent en entrée une liste
d'options, un nom d'option et une valeur par défaut. Si le nom appartient à la liste alors la
valeur associée est retournée, sinon c'est la valeur par défaut.
On ne décrit que les fonctions de décodage des options entières et booléennes,
les autres reposent
sur le même modèle.
# exception
OptErr;;
exception OptErr
# let
theInt
lo
name
default
=
try
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
=
try
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>
On peut donc écrire une fonction de mise à jour d'un contexte graphique en passant une
liste d'options de la manière suivante :
# 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>
Cela permet de ne pas tenir compte de l'ordre des options passées.
# let
dc
=
make_default_context
()
in
set_gc
dc
[
"Foreground"
,
Copt
Graphics.blue;
"Background"
,
Copt
Graphics.yellow]
;
dc;;
- : g_context =
{bcol=16776960; fcol=255; font="fixed"; font_size=12; lw=1; x=0; y=0}
On obtient un système assez souple qui malheureusement échappe en partie au système
de types. Le nom d'une option est du type string et rien n'empêche de
construire un nom inexistant. La conséquence est
alors de ne pas tenir compte de sa valeur.
Composants et conteneurs
Le composant est la brique essentielle de cette bibliothèque.
On désire avoir la possibilité de créer des composants et de facilement
les assembler pour construire des interfaces.
Ils doivent pouvoir s'afficher, savoir qu'un événement leur est
destiné et traiter cet événement. Quand ils sont conteneurs, ils doivent
pouvoir recevoir d'autres composants ou en retirer.
On suppose qu'un composant simple ne peut être ajouté qu'à un seul conteneur.
Création de composants
Une valeur de type component possède une taille (w
et h), une position absolue dans la fenêtre principale
(x et y), un contexte graphique pour l'affichage
(gc), un indicateur pour savoir s'il est un conteneur
(container), un père s'il est attaché à un conteneur
(father), une liste de ses fils
(sons) et quatre fonctions permettant le placement d'autres
composants (layout), son affichage (display),
l'appartenance d'un point à sa zone (mem) et une fonction de
traitement d'un événement (listener) qui retourne
true si l'événement est traité et false sinon. Le
paramètre de listener prend un état enrichi (type
rich_status) qui contient le nom de l'événement, l'état de
l'événement physique provenant de Graphics, les informations
sur le focus clavier et le focus général, ainsi que le
dernier composant ayant traité un événement. On obtient les
déclarations mutuellement récursives suivantes :
# 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
father
:
component
list;
mutable
sons
:
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};;
On accède aux champs informatifs d'un composant par les fonctions
suivantes.
# 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>
Les trois fonctions suivantes vont définir le comportement par défaut
d'un composant. La fonction d'appartenance (in_rect) vérifie
que la coordonnée passée est bien dans le rectangle défini par les
coordonnées du composant. La fonction d'affichage par défaut
(display_rect) remplit le rectangle du composant par la
couleur de fond de son contexte graphique. Le placement par défaut
(direct_layout) est celui du positionnement relatif du
composant dans le conteneur. Les options acceptées sont "PosX" et
"PosY" correspondant aux positions relatives du composant dans le
conteneur.
# 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>
Il est maintenant possible de définir un composant grâce à la fonction
create_component qui prend une largeur et une hauteur
et qui utilise les trois fonctions précédentes.
# let
create_component
iw
ih
=
let
dc
=
{info=
"Anonymous"
;
x=
0
;
y=
0
;
w=
iw;
h=
ih;
gc
=
make_default_context()
;
container
=
false;
father
=
[];
sons
=
[];
layout_options
=
[];
layout
=
(fun
a
b
->
());
display
=
(fun
()
->
());
mem
=
(fun
s
->
false);
listener
=
(fun
s
->
false);}
in
dc.
layout
<-
direct_layout
dc;
dc.
mem
<-
in_rect
dc;
dc.
display
<-
display_rect
dc;
dc
;;
val create_component : int -> int -> component = <fun>
On définit alors le composant vide suivant :
# let
empty_component
=
create_component
0
0
;;
Celui-ci est utilisé comme valeur par défaut pour la construction de
valeurs contenant au moins un composant comme, par exemple, une valeur
de type rich_status.
Ajout de composants
La difficulté de l'ajout d'un composant à un conteneur est le
positionnement du composant dans le conteneur. Le champ
layout contient la fonction de placement. Elle prend un
composant (un fils) et une liste d'options et calcule les nouvelles
coordonnées du composant fils dans le conteneur. Différentes options
peuvent être utilisées selon chaque fonction de placement. On détaille
plusieurs fonctions de placement lors de la définition des conteneurs
panel (voir infra, page ??). On décrit
ici uniquement la mécanique de propagation de l'affichage, du
changement de coordonnées et du traitement des événements. Cette
propagation d'actions utilise intensivement la fonction
List.iter qui applique une fonction à tous les éléments d'une
liste.
La fonction change_coord applique un changement relatif de
coordonnées à un composant et à tous ses fils.
# 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.
sons;;
val change_coord : component -> int * int -> unit = <fun>
La fonction add_component vérifie que les conditions d'ajout
sont bien remplies, puis raccroche père (c) et fils
(c1). La liste des options de placement est conservée dans
le composant fils ce qui permet de la réutiliser en cas de
modification de la règle de placement du père. La liste d'options
passée à cette fonction concerne les options de la fonction de
placement. Il y a trois cas d'échec : le composant fils a déjà un
père, le père n'est pas un conteneur et la taille du fils est trop
grande.
# let
add_component
c
c1
lopt
=
if
c1.
father
<>
[]
then
failwith
"add_component : yet a father"
else
if
not
(is_container
c
)
then
failwith
"add_component : not a container"
else
if
(c1.
x
+
c1.
w
>
c.
w)
||
(c1.
y
+
c1.
h
>
c.
h)
then
failwith
"add_component : bad position"
else
c.
layout
c1
lopt;
c1.
layout_options
<-
lopt;
List.iter
(fun
s
->
change_coord
s
(c1.
x,
c1.
y))
c1.
sons;
c.
sons
<-
c1::c.
sons;
c1.
father
<-
[
c]
;;
val add_component : component -> component -> lopt -> unit = <fun>
Le retrait d'un composant à un niveau de l'arbre, réalisé par la
fonction suivante, entraîne une modification des liens entre père et
fils, mais aussi une modification des coordonnées du fils et de ses
descendants :
# let
remove_component
c
c1
=
c.
sons
<-
List.filter
((!=
)
c1)
c.
sons;
c1.
father
<-
List.filter
((!=
)
c)
c1.
father;
List.iter
(fun
s
->
change_coord
s
(-
c1.
x,
-
c1.
y))
c1.
sons;
c1.
x
<-
0
;
c1.
y
<-
0
;;
val remove_component : component -> component -> unit = <fun>
Le changement de la fonction de placement d'un conteneur dépend de
l'existence de fils du conteneur. Dans le cas sans descendance, la
modification est immédiate. Dans l'autre cas il faut d'abord enlever
les fils du conteneur, modifier sa fonction de placement, puis
rajouter les composants enlevés avec les mêmes options qu'au premier
placement.
# let
set_layout
f
c
=
if
c.
sons
=
[]
then
c.
layout
<-
f
else
let
ls
=
c.
sons
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>
C'est pour cela que la liste d'options de placement d'un composant est conservée.
Si la liste des options n'est pas reconnue par la nouvelle fonction de placement,
celle-ci utilise les
valeurs par défaut de ses options.
L'affichage d'un composant doit être propagé à ses fils pour les
conteneurs. Un conteneur est affiché en arrière plan par rapport à
ses fils. L'ordre d'affichage des fils importe peu car leur
intersection est toujours vide.
# let
rec
display
c
=
c.
display
();
List.iter
(fun
cx
->
display
cx
)
c.
sons;;
val display : component -> unit = <fun>
Cette fonction peut être directement appliquée à un composant pour le visualiser.
Gestion des événements
La gestion des événements physiques (clic souris, appui d'une touche,
déplacement de la souris) utilise la fonction
Graphics.wait_next_event (voir page ??)
qui retourne un état physique (de type Graphics.status) suite
à une action de l'utilisateur. Cet état physique est utilisé pour
calculer un état enrichi (de type rich_status) contenant la
nature de l'événement (type rich_event), l'état physique, les
composants possédant le focus clavier et le focus général
ainsi que le dernier composant ayant traité avec succès un tel état.
Le focus général correspond à un composant prenant tous les
événements.
On décrit les fonctions de manipulation des états enrichis, la
propagation de ces états aux composants pour leur traitement, la
création de ces états et la boucle principale de gestion des
événements.
Fonctions sur les états
Les fonctions suivantes consultent les valeurs de positionnement
souris et de focus. Les fonctions sur les focus
nécessitent un paramètre supplémentaire : le composant gagnant ou
perdant le focus.
# let
get_event
e
=
e.
re;;
# 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 des événements
Un état enrichi est envoyé à un composant pour son traitement. De la
même manière que pour l'affichage, les composants fils ont priorité
sur leur père pour le traitement d'un événement souris simple. Ils
sont devant leur père et ils ne se recouvrent pas entre eux. Quand un
composant reçoit l'état associé à un événement, il regarde
s'il existe un descendant pour le traiter. Si c'est le cas, le
descendant renvoie true et sinon, false. Dans ce
dernier cas le composant ancêtre essaie de le traiter par la fonction
de son champ listener.
Les états provenant d'une action clavier sont propagés
différemment. Le composant ancêtre regarde s'il possède le
focus clavier, si oui il traite l'événement et sinon. il le propage
vers ses fils.
Certains états sont produits par le traitement d'un événement
premier (par exemple : la prise de focus par un composant entraîne
sa perte par d'autres composants). De tels états sont traités
immédiatement par le composant cible. Il en est de même pour les
entrées et sorties de la souris de la zone d'un composant.
La fonction send_event prend une valeur de type
rich_status et un composant, elle retourne un booléen indiquant
si l'événement a été traité ou non.
# 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.
sons
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.
sons
|
_
->
c.
listener
rs;;
val send_event : rich_status -> component -> bool = <fun>
Il est à noter que la hiérarchie des composants est bien un arbre et
non un graphe avec cycle. Ce qui garantit que la fonction récursive
send_event ne bouclera pas.
Création d'événements
On différencie deux types d'événements : ceux produits par une action
physique (comme un clic souris) et ceux qui découlent d'une action
liée à l'historique (comme la sortie du curseur de la souris
de la zone graphique d'un composant). On définira, en conséquence,
deux fonctions de création d'états enrichis.
La fonction qui traite les premiers construit un état enrichi à partir
de deux états physiques :
# let
compute_rich_event
s0
s1
=
if
s0.
Graphics.button
<>
s1.
Graphics.button
then
(* bouton *)
begin
if
s0.
Graphics.button
then
MouseDown
else
MouseUp
end
else
if
s1.
Graphics.keypressed
then
KeyPress
(* clé *)
else
if
(s0.
Graphics.mouse_x
<>
s1.
Graphics.mouse_x
)
||
(* déplace *)
(s0.
Graphics.mouse_y
<>
s1.
Graphics.mouse_y
)
then
begin
if
s1.
Graphics.button
then
MouseDrag
else
MouseMove
end
else
raise
Not_found;;
val compute_rich_event : Graphics.status -> Graphics.status -> rich_event =
<fun>
La fonction qui crée d'autres événements utilisent les deux
derniers états enrichis :
# let
send_new_events
res0
res1
=
if
res0.
key_focus
<>
res1.
key_focus
then
begin
ignore(send_event
{res1
with
re
=
LostFocus}
res0.
key_focus);
ignore(send_event
{res1
with
re
=
GotFocus}
res1.
key_focus)
end;
if
(res0.
last
<>
res1.
last)
&&
((
res1.
re
=
MouseMove)
||
(res1.
re
=
MouseDrag))
then
begin
ignore(send_event
{res1
with
re
=
MouseExit}
res0.
last);
ignore(send_event
{res1
with
re
=
MouseEnter}
res1.
last
)
end;;
val send_new_events : rich_status -> rich_status -> unit = <fun>
On définit une valeur initiale pour le type rich_event. Elle est
employée pour initialiser l'historique de la boucle d'événements.
# 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
}
;;
Boucle d'événements
La boucle d'événements gère l'ensemble des interactions sur un
composant, en général le conteneur ancêtre de tous les composants de
l'interface. Elle prend en entrée deux booléens, indiquant le
réaffichage de l'interface après chaque traitement d'un événement
physique (b_disp) et la gestion du déplacement de la souris
(b_motion). Le dernier argument (OCnamec), est le
composant principal, racine de l'arbre des composants.
# let
loop
b_disp
b_motion
c
=
let
res0
=
ref
initial_re
in
try
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
in
let
res1
=
{!
res0
with
stat
=
s}
in
try
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
->
()
done
with
e
->
raise
e;;
val loop : bool -> bool -> component -> unit = <fun>
La seule manière de sortir de cette boucle est qu'une des actions de traitement d'un événement déclenche une exception.
Fonctions de test
On définit les deux fonctions suivantes, pour créer à la main des états correspondants aux événements souris
et clavier.
# 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>
On pourra donc simuler l'envoi d'un événement souris pour les tests de l'interface en utilisant cette
fonction.
Définition de composants
Les différents mécanismes d'affichage, de modification de coordonnées
et de propagation d'événements sont en place. Il reste maintenant à
définir des composants utiles et faciles à manipuler. On peut classer
les composants en trois catégories :
-
les composants simples ne traitant pas les
événements (comme les textes à afficher);
- les composants simples traitant des événements, comme les champs de saisie;
- les conteneurs et les variantes de placement.
La communication de valeurs entre deux composants ou entre un
composant et l'application s'effectue par modification physique d'une
donnée partagée. Le partage est réalisé en créant des fermetures qui
contiennent dans leur environnement les valeurs à modifier. De plus
comme le comportement d'un composant peut varier à la suite du
traitement d'un événement, ils conservent aussi dans leur fermeture de
traitement un état interne. Par exemple la fonction de traitement d'une
zone de saisie a accès au texte en cours d'écriture. Pour cela on
écrit les composants de la manière suivante :
-
définition d'un type pour l'état interne du composant;
- déclaration des fonctions de manipulation de cet état;
- écriture des fonctions d'affichage, d'appartenance d'un point
au composant et de
traitement des événements;
- réalisation de la fonction de création du composant qui associe
ces fermetures aux champs du composant;
- test du composant en simulant le déclenchement d'événements.
Les fonctions de création prennent une liste d'options pour paramétrer
le contexte graphique. Le calcul de la taille d'un composant à sa
création a besoin d'utiliser le contexte graphique du composant sur le
fenêtre graphique pour connaître la taille du texte à afficher.
On détaille l'implantation des composants suivants :
-
texte simple (label)
- conteneur simple (panel)
- bouton simple (button)
- liste de choix (choice)
- champ de saisie (textfield)
- composant enrichi (border)
Composant label
Le composant le plus simple, que l'on appelle un label, affiche
une chaîne de caractères à l'écran. Il ne traite pas d'événement.
On décrit tout d'abord sa fonction d'affichage puis sa fonction de
création.
L'affichage doit tenir compte des couleurs d'encre et de fond et des
polices de caractères. C'est le rôle de la fonction
display_init qui efface la zone graphique du composant et
sélectionne la couleur de l'encre et la position du point courant. La
fonction display_label affiche la chaîne passée en paramètre
juste après l'appel à 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>
Comme ce composant est fort simple, il n'est pas nécessaire de créer
un état interne. Seule la fonction
display_label connaît la chaîne à afficher qui est passée à la fonction de création.
# 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;
u.
info
<-
"Label"
;
u.
gc
<-
gc;
u;;
val create_label : string -> (string * opt_val) list -> component = <fun>
Si l'on désire changer les couleurs de ce composant, il est nécessaire d'intervenir directement sur
son contexte graphique.
L'affichage du label l1 suivant est représenté à la 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
gris1]
;;
Figure 13.1 : Affichage d'un label
Composant panel, conteneur et placement
On appelle panel un panneau graphique qui peut être un
conteneur. La fonction de création par défaut est très simple, elle
reprend principalement la fonction générale de création de composants
en acceptant de plus un booléen indiquant s'il est un conteneur ou
non. Les fonctions d'appartenance à la zone du panel et d'affichage
sont celles par défaut de la fonction create_component.
# let
create_panel
b
w
h
lopt
=
let
u
=
create_component
w
h
in
u.
container
<-
b;
u.
info
<-
if
b
then
"Panel container"
else
"Panel"
;
let
gc
=
make_default_context
()
in
set_gc
gc
lopt;
u.
gc
<-
gc;
u;;
val create_panel :
bool -> int -> int -> (string * opt_val) list -> component = <fun>
Le point délicat des conteneurs provient du placement des
composants. On définit deux nouvelles fonctions de placement :
center_layout et grid_layout.
La première, center_layout place un composant au centre
d'un conteneur :
# 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>
La seconde, grid_layout découpe un conteneur en grille où
chaque case a la même taille. Les options de placement sont
"Col" pour le numéro de la colonne et "Row" pour le
numéro de a ligne.
# 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"
else
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 =
<fun>
Il est bien sûr possible d'en définir d'autres. On peut donc
particulariser un conteneur en modifiant sa fonction de placement
(set_layout). La figure 13.2 montre un panel, déclaré comme conteneur, dans lequel deux labels ont été
ajoutés et correspond au programme suivant :
Figure 13.2 : Affichage d'un panel
# let
l2
=
create_label
"Passwd : "
[
"Font"
,
courier_bold_24;
"Background"
,
Copt
gris1]
;;
# let
p1
=
create_panel
true
1
5
0
8
0
[
"Background"
,
Copt
gris2]
;;
# set_layout
(grid_layout
(1
,
2
)
p1)
p1;;
# add_component
p1
l1
[
"Row"
,
Iopt
1
]
;;
# add_component
p1
l2
[
"Row"
,
Iopt
0
]
;;
Comme les composants ont besoin d'au moins un père pour s'intégrer
dans l'interface, et que la bibliothèque Graphics ne possède
qu'une seule fenêtre, on définit une fenêtre principale qui est un
conteneur.
# let
open_main_window
w
h
=
Graphics.close_graph();
Graphics.open_graph
(":0 "
^
(string_of_int
w)^
"x"
^
(string_of_int
h));
let
u
=
create_component
w
h
in
u.
container
<-
true;
u.
info
<-
"Fenêtre principale"
;
u;;
val open_main_window : int -> int -> component = <fun>
Composant button
Un bouton simple ou button est un composant qui d'une part
affiche un texte dans sa zone graphique et réagit au clic souris. Pour
cela il conserve un état, valeur de type button_state, qui
contient son texte et sa fonction de traitement du clic souris.
# type
button_state
=
{
txt
:
string;
mutable
action
:
button_state
->
unit
}
;;
La création d'un état est effectuée par la fonction
create_bs. La fonction set_bs_action modifie la
fonction d'action et la fonction get_bs_text récupère le
texte d'un bouton.
# 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>
La fonction d'affichage est similaire à celle des labels à la
différence près que le texte provient de l'état du bouton. La fonction
d'écoute par défaut déclenche la fonction d'action par l'appui d'un
bouton souris.
# 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 =
<fun>
Tout est prêt pour définir la fonction de création de boutons simples :
# 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;
u.
info
<-
"Button"
;
u.
gc
<-
gc;
u,
bs;;
val create_button :
string -> (string * opt_val) list -> component * button_state = <fun>
Celle-ci retourne un couple dont le premier élément est le bouton créé et le deuxième
l'état interne de ce bouton. Cela est particulièrement utile si l'on désire modifier
la fonction d'action de celui-ci.
La figure 13.3 crée un panel auquel est ajouté un bouton. On associe
une fonction d'action qui affiche la chaîne contenue dans le bouton sur la sortie standard.
Figure 13.3 : Affichage d'un bouton et réaction au clic souris
# let
b,
bs
=
create_button
"Validation"
[
"Font"
,
courier_bold_24;
"Background"
,
Copt
gris1]
;;
# let
p2
=
create_panel
true
1
5
0
6
0
[
"Background"
,
Copt
gris2]
;;
# set_bs_action
bs
(fun
bs
->
print_string
(
(get_bs_text
bs)^
"..."
);
print_newline());;
# set_layout
(center_layout
p2)
p2;;
# add_component
p2
b
[];;
À la différence des labels, un composant bouton sait réagir à
un événement souris. Pour le tester on envoie l'événement << clic
souris >> en position centrale du panel p2, qui est
répercuté au bouton, ce qui déclenche l'action associée à ce dernier :
# send_event
(make_click
MouseDown
7
5
3
0
)
p2;;
Validation...
- : bool = true
et retourne la valeur true indiquant que l'événement a bien été traité.
Composant choice
Les listes de choix (ou choice) permet de sélectionner un des
choix proposés par un clic souris. Il existe toujours un choix
courant. Un clic souris sur un autre choix fait changer le choix
courant et déclenche une action. On utilise la même technique que
pour les boutons simples. On commence par définir l'état d'une liste
de choix :
# type
choice_state
=
{
mutable
ind
:
int;
values
:
string
array;
mutable
sep
:
int;
mutable
height
:
int;
mutable
action
:
choice_state
->
unit
}
;;
L'indice ind indique la chaîne à marquer rangée dans
values. Les champs sep et height exprimés
en pixels correspondent respectivement à la séparation entre deux
choix et à la hauteur de chaque choix. La fonction d'action prend en
entrée un tel état et peut s'aiguiller selon l'indice.
On définit maintenant la fonction de création d'un état et la fonction de
modification du traitement.
# 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>
L'affichage donne la liste de tous les choix et souligne le choix
courant en inverse vidéo. La fonction de traitement des événements
déclenche la fonction de traitement de l'état au relâchement du bouton
de souris.
# 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)
done;
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
e.
re
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 =
<fun>
La création d'une liste de choix prend une liste de chaînes de
caractères et une liste d'options pour retourner le composant ainsi
que son état.
# 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
=
Array.map
(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
;
u.
info
<-
"Choice "
^
(string_of_int
(Array.length
cs.
values));
u.
gc
<-
gc;
u,
cs;;
val create_choice :
string list -> (string * opt_val) list -> component * choice_state = <fun>
Les trois images de la figure 13.4 montre un panel
auquel a été ajouté une liste de choix. On associe une fonction
d'action qui affiche sur la sortie standard la chaîne correspondant au
choix indiqué dans le button. Chaque image fait suite à un clic
souris simulé par le programme suivant.
Figure 13.4 : Affichage d'une liste de choix et sélection
# let
c,
cs
=
create_choice
[
"Helium"
;
"Gallium"
;
"Pentium"
]
[
"Font"
,
courier_bold_24;
"Background"
,
Copt
gris1]
;;
# let
p3
=
create_panel
true
1
1
0
1
1
0
[
"Background"
,
Copt
gris2]
;;
# set_cs_action
cs
(fun
cs
->
print_string
(
(get_cs_text
cs)^
"..."
);
print_newline());;
# set_layout
(center_layout
p3)
p3;;
# add_component
p3
c
[];;
Là aussi nous pouvons le tester directement en envoyant plusieurs événements.
Cet envoi modifie la sélection, comme dans l'image du centre de la figure 13.4.
# send_event
(make_click
MouseUp
6
0
5
5
)
p3;;
Gallium...
- : bool = true
De même l'événement suivant envoyé sélectionne le premier élément de la liste de choix
# send_event
(make_click
MouseUp
6
0
9
0
)
p3;;
Helium...
- : bool = true
Composant textfield
Un champ de saisie, ou textfield, est une zone permettant
d'écrire du texte sur une ligne. Le texte peut s'afficher de gauche à
droite ou de droite à gauche comme pour une calculatrice. De plus un
curseur indique la position du prochain caractère à entrer. On
définit un état un peu plus complexe. Il comprend le texte en cours de
saisie, la direction de la saisie, l'information sur le curseur,
l'information sur l'affichage des caractères, et la fonction d'action.
# 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
}
;;
La création d'un tel état demande le texte initial, le nombre de
caractères de la zone de saisie et la direction de saisie.
# 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>
Les fonctions suivantes permettent de modifier certains champs et de
retourner le texte affiché.
# 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);;
La fonction set_tfs_text modifie le text de l'état tfs du
composant tf
par la chaîne 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>
L'affichage tient compte des informations sur l'écho des caractères et
sur la visibilité du curseur. La fonction display_textfield
appelle la fonction display_cursor qui souligne la position
du curseur.
# 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>
La fonction d'écoute des événements est plus complexe pour ce type de
composant. En effet il est nécessaire de gérer le déplacement de la
chaîne saisie selon la direction indiquée à la création du composant.
La prise de focus s'effectue par un clic souris dans la zone de
saisie.
# let
listener_text_field
u
tfs
e
=
match
e.
re
with
MouseDown
->
take_key_focus
e
u
;
true
|
KeyPress
->
(
if
Char.code
(get_key
e)
>=
3
2
then
begin
(
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
)
else
(
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
);
)
end
else
(
(
match
Char.code
(get_key
e)
with
1
3
->
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>
La fonction de création des champs de saisie reprend le même schéma
de construction que pour les composants déjà vus.
# 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
;
u.
info
<-
"TextField"
;
u.
gc
<-
gc;
u,
tfs;;
val create_text_field :
string ->
int -> bool -> (string * opt_val) list -> component * textfield_state =
<fun>
La création retourne un composant et un état pour les champs de saisie.
On teste la création des champs de saisie de la
figure 13.5.
# let
tf1,
tfs1
=
create_text_field
"dupneu"
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
1
4
0
8
0
[
"Background"
,
Copt
gris2]
;;
# 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 : Affichage de champs de saisie
Enrichissement des composants
À partir des composants de base décrits précédemment, il est
possible d'en construire de nouveaux comme par exemple des composants
dont les bords sont mis en relief comme pour la calculatrice graphique
de la page ??. La solution choisie pour ce rendu
consiste à créer un panel plus grand que le composant, de le
remplir d'une certaine manière et d'ajouter le composant désiré en le
plaçant au centre. On définit tout d'abord le type de l'état d'un
bord.
# type
border_state
=
{mutable
relief
:
string;
mutable
line
:
bool;
mutable
bg2
:
Graphics.color;
mutable
size
:
int};;
La fonction de création prend une liste d'options et construit un état.
# let
create_border_state
lopt
=
{relief
=
theString
lopt
"Relief"
"Flat"
;
line
=
theBool
lopt
"Outlined"
false;
bg2
=
theColor
lopt
"Background2"
Graphics.black;
size
=
theInt
lopt
"Border_size"
2
};;
val create_border_state : (string * opt_val) list -> border_state = <fun>
On reprend le tracé de bord utilisé pour les boîtes de la figure 5.6 (page ??)
en définissant les options "Top", "Bot" et "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)
|]
in
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)
|]
in
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 =
<fun>
La fonction de création d'un bord prend un composant et une liste d'options et
construit un panel contenant ce composant.
# 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>
On teste alors la construction de composants avec bord sur le label
et le champ de saisie tf1 définis dans les autres tests. Le
résultat est représenté à la 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
Graphics.red;
"Border_size"
,
Iopt
4
]
;;
# let
p5
=
create_panel
true
1
4
0
8
0
[
"Background"
,
Copt
gris2]
;;
# 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 : Affichage de composants enrichis
Création de la bibliothèque Upi
Les éléments essentiels de notre bibliothèque sont maintenant écrits.
Toutes les déclarations2 de type et de valeur de
cette section peuvent être regroupées dans un même fichier. Cette
bibliothèque ne contient alors qu'un seul module. Si le fichier est
appelé upi.ml on obtient un module de nom Upi. Le
lien entre nom de fichier et nom de module est décrit au chapitre
14.
La compilation de ce fichier produit le fichier d'interface compilée
upi.cmi et le fichier de byte-code upi.cmo ou de
code natif upi.cmx selon le compilateur utilisé. Dans le cas
du compilateur de byte-code on écrit la ligne suivante :
ocamlc -c upi.ml
Pour être utilisée au niveau du toplevel, il est nécessaire de
charger le byte-code de notre nouvelle bibliothèque par la
directive #load "upi.cmo";; en ayant pris soin d'avoir
préalablement chargé la bibliothèque
Graphics. Le module Upi
# open Upi;;
# create_component;;
- : int -> int -> Upi.component = <fun>
Le type du résultat de cette fonction est Upi.component, le
chapitre 14 reviendra sur ce point.
Exemple : un convertisseur Francs/Euros
On se propose de construire un convertisseur Francs/Euros en
utilisant cette nouvelle bibliothèque. La conversion des monnaies
est du niveau de difficulté de la règle de trois. La construction
de l'interface illustrera la nécessaire communication entre composants.
Pour la période d'adaptation aux deux monnaies, on désire pouvoir faire
les conversions dans les deux sens. Voici les composants choisis :
-
une liste à 2 choix pour le sens de la conversion ;
- deux champs de saisie pour l'entrée des valeurs et pour
l'affichage de la conversion ;
- un bouton simple pour la demande du calcul ;
- deux labels pour indiquer la nature de chaque champ de saisie.
Ces différents composants sont affichés à la figure 13.7.
La communication entre les composants est réalisée le partage d'un
état. On définit pour cela le type etat_conv qui contient
les champs pour les francs (a), les euros (b), le sens
de la conversion (sens) et les coefficients de conversion
(fa et fb).
# type
etat_conv
=
{
mutable
a:
float;
mutable
b:
float;
mutable
sens
:
bool;
fa
:
float;
fb
:
float
}
;;
On définit l'état initial :
# let
e
=
6
.
5
5
9
5
7
0
7
4
let
fe
=
{
a
=
0
.
0
;
b=
0
.
0
;
sens
=
true;
fa
=
e;
fb
=
1
./.
e};;
La fonction de conversion retourne un résultat flottant selon le sens
de la conversion.
# let
calcule
fe
=
if
fe.
sens
then
fe.
b
<-
fe.
a
/.
fe.
fa
else
fe.
a
<-
fe.
b
/.
fe.
fb;;
val calcule : etat_conv -> unit = <fun>
Le clic souris sur la liste à deux choix modifie le sens de la conversion.
Les textes des choix sont "->"
et "<-"
.
# let
action_sens
fe
cs
=
match
get_cs_text
cs
with
"->"
->
fe.
sens
<-
true
|
"<-"
->
fe.
sens
<-
false
|
_
->
failwith
"action_sens"
;;
val action_sens : etat_conv -> choice_state -> unit = <fun>
L'action associée au bouton simple entraîne le calcul et l'affichage
du résultat dans un des deux champs de saisie. Pour cela les deux
champs de saisie sont aussi passés en paramètre.
# let
action_go
fe
tf_fr
tf_eu
tfs_fr
tfs_eu
x
=
if
fe.
sens
then
let
r
=
float_of_string
(get_tfs_text
tfs_fr)
in
fe.
a
<-
r;
calcule
fe;
let
sr
=
Printf.sprintf
"%.2f"
fe.
b
in
set_tfs_text
tf_eu
tfs_eu
sr
else
let
r
=
float_of_string
(get_tfs_text
tfs_eu)
in
fe.
b
<-
r;
calcule
fe;
let
sr
=
Printf.sprintf
"%.2f"
fe.
a
in
set_tfs_text
tf_fr
tfs_fr
sr;;
val action_go :
etat_conv ->
component -> component -> textfield_state -> textfield_state -> 'a -> unit =
<fun>
Il reste à construire l'interface. La fonction suivante prend une largeur, une hauteur et un état d'un convertisseur et retourne le conteneur principal avec les trois composants actifs.
# let
create_conv
w
h
fe
=
let
gris1
=
(Graphics.rgb
1
2
0
1
2
0
1
2
0
)
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
gris1]
and
l2
=
create_label
"Euros"
[
"Font"
,
courier_bold_24;
"Background"
,
Copt
gris1]
and
c,
cs
=
create_choice
[
"->"
;
"<-"
]
[
"Font"
,
courier_bold_18]
and
tf1,
tfs1
=
create_text_field
"0"
1
0
false
[
"Font"
,
courier_bold_18]
and
tf2,
tfs2
=
create_text_field
"0"
1
0
false
[
"Font"
,
courier_bold_18]
and
b,
bs
=
create_button
" Go "
[
"Font"
,
courier_bold_24]
in
let
gc
=
get_gc
m
in
set_gc_bcol
gc
gris1;
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
gris2;
"Background2"
,
Copt
Graphics.black]
in
set_cs_action
cs
(action_sens
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
]
;
m,
bs,
tf1,
tf2;;
val create_conv :
int -> int -> etat_conv -> component * button_state * component * component =
<fun>
La boucle de gestion d'événements est lancée sur le conteneur
m construit ci-dessous. Son affichage est représenté à la
figure 13.7.
# let
(m,
c,
t1,
t2)
=
create_conv
4
2
0
1
5
0
fe
;;
# display
m
;;
Figure 13.7 : Affichage du convertisseur
Un clic sur la liste à deux choix, modifie le texte affiché et change le
sens de la conversion car toutes les fermetures de traitement
d'événements partagent le même état.
Pour en faire plus
Les fermetures permettent d'enregistrer des traitements auprès des
composants graphiques. Néanmoins il est impossible de << réouvrir >>
ces fermetures pour étendre un traitement. Il est nécessaire de
redéfinir complètement un nouveau traitement. Nous discuterons des
possibilités d'extension des traitements au chapitre
16 où nous comparons les modèles
fonctionnel et objet.
Dans notre application, plusieurs enregistrement possèdent des champs
de même nom (par exemple txt). La dernière déclaration masque
les précédentes. Il devient dès lors difficile d'utiliser
directement le nom des champs. C'est pourquoi, pour chaque type
décrit, nous avons déclaré les fonctions de création et de
manipulation des valeurs de ce type. Une autre possibilité aurait été
de découper notre bibliothèque en plusieurs modules. À ce moment là
les champs d'enregistrements auraient pu être discriminés par le nom
du module. Néanmoins, grâce aux fonctions de création, on peut
utiliser pleinement la bibliothèque. Le chapitre
14 revient sur le masquage de types en introduisant les
types abstraits de données. Ce masquage garantit par ailleurs une
meilleure sûreté d'exécution. Il évite une modification directe de
certains champs sensibles, comme les relations de filiation entre
composants ce qui empêche de construire un graphe circulaire.
Il y a plusieurs points possibles d'amélioration de cette
bibliothèque.
Un intérêt de la définition des composants est de pouvoir en écrire
bien d'autres. En particulier il est relativement facile de créer des
composants de forme quelconque en utilisant des fonctions particulière
pour l'appartenance et l'affichage. On pourra ainsi faire des boutons
elliptiques ou en forme de gouttes d'eau.
Les quelques algorithmes de placement présentés ne permettent pas
toujours un assemblage aisé. On peut donc ajouter des grilles dont les
cases sont de hauteur ou largeur variables. De même il peut être
nécessaire d'effectuer un placement de composants les uns à coté des
autres tant qu'il y a la place. Enfin la possibilité de changer la
taille d'un conteneur, en le répercutant sur ses fils, doit être
prévue.