Author: Christian.Queinnec@lip6.fr

## 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 = 12
     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 150 80 ["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 150 60 ["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 75 30) 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 110 110  ["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 60 55 ) 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 60 90 ) 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)  >= 32 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
                   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>

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 140 80 ["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 140 80 ["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.55957074
     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 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 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" 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]
     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 420 150 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.