Author: Christian.Queinnec@lip6.fr

## Calculatrice graphique

Nous reprenons l'exemple de la calculatrice décrite dans le chapitre précédent sur la programmation impérative (voir page ??). Nous la dotons d'une interface graphique la rendant plus facile à être utilisée comme une calculette de bureau.
L'interface graphique matérialisera l'ensemble des touches (chiffres et fonctions) et une zone de visualisation des résultats. Une touche pourra être activée soit via l'interface graphique (et la souris) soit directement au clavier. La figure 5.9 montre l'interface que l'on désire construire.

> Figure 5.9 : Calculatrice graphique

On réutilise les fonctions de tracé de boîtes décrites à la page ??. On définit le type suivant :

    # type etat_calc =
      { e : etat; t : (box_config * touche * string ) list; v : box_config } ;;

Il permet de conserver l'état de la calculatrice, la liste des boîtes correspondant aux touches et la boîte de visualisation. On désire construire une calculatrice graphique facilement modifiable. On paramètre alors la construction de l'interface par une liste d'associations :

    # let descr_calc =
      [  (Chiffre 0,"0");  (Chiffre 1,"1");    (Chiffre 2,"2");  (Egal, "=");
         (Chiffre 3,"3");  (Chiffre 4,"4");    (Chiffre 5,"5");  (Plus, "+");
         (Chiffre 6,"6");  (Chiffre 7,"7");    (Chiffre 8,"8");  (Moins, "-");
         (Chiffre 9,"9");  (MemoireOut,"RCL"); (Par, "/");       (Fois,  "*");
         (Off,"AC");       (MemoireIn, "STO"); (Clear,"CE/C")
      ] ;;

##### Génération des boîtes des touches

À partir de cette description on construit la liste des boîtes des touches. La fonction `gen_boxes` prend pour paramètres une description (`descr`), le nombre de colonnes (`n`), la séparation entre boîtes (`wsep`), la séparation entre le texte et les bords d'une boîte (`wsepint`) et la taille des bords (`wbord`). Cette fonction retourne la liste des boîtes des touches ainsi que la boîte de visualisation. Pour calculer ces placements, on définit les fonctions auxiliaires `max_xy` de calcul des tailles maximales d'une liste de couples d'entiers et `max_lbox` de calcul des positions maximales d'une liste de boîtes.

    # let gen_xy vals comp o  =
       List.fold_left (fun  a (x,y) -> comp (fst a) x,comp (snd a) y) o vals ;;
    val gen_xy : ('a * 'a) list -> ('b -> 'a -> 'b) -> 'b * 'b -> 'b * 'b = <fun>
    # let max_xy vals = gen_xy vals max (min_int,min_int);;
    val max_xy : (int * int) list -> int * int = <fun>
    # let max_boxl l =
       let bmax (mx,my) b = max mx b.x, max my b.y
       in List.fold_left bmax  (min_int,min_int) l ;;
    val max_boxl : box_config list -> int * int = <fun>

Voici la fonction principale `gen_boxes` de création de l'interface.

    # let gen_boxes  descr n wsep wsepint wbord   =
       let l_l = List.length descr in
       let nb_lig = if l_l mod n = 0 then l_l / n else l_l / n + 1 in
       let ls = List.map (fun (x,y) -> Graphics.text_size y) descr in
       let sx,sy = max_xy  ls in
       let sx,sy= sx+wsepint ,sy+wsepint  in
         let r = ref [] in
           for i=0 to l_l-1 do
             let px = i mod n and py = i / n in
               let b = { x = wsep * (px+1) + (sx+2*wbord) * px  ;
                         y = wsep * (py+1) + (sy+2*wbord) * py ;
                         w = sx; h = sy ; bw = wbord;
                         r=Top;
                         b1_col = grey1;  b2_col = grey3; b_col =grey2}
               in r:= b::!r
           done;
           let mpx,mpy = max_boxl !r in
           let upx,upy = mpx+sx+wbord+wsep,mpy+sy+wbord+wsep in
           let (wa,ha) = Graphics.text_size "        0" in
             let v = { x=(upx-(wa+wsepint +wbord))/2 ; y= upy+ wsep;
                       w=wa+wsepint; h = ha +wsepint; bw = wbord *2; r=Flat ;
                       b1_col = grey1;  b2_col = grey3; b_col =Graphics.black}
             in
               upx,(upy+wsep+ha+wsepint+wsep+2*wbord),v,
               List.map2 (fun b (x,y) -> b,x,y ) (List.rev !r) descr;;
    val gen_boxes :
      ('a * string) list ->
      int ->
      int ->
      int -> int -> int * int * box_config * (box_config * 'a * string) list =
      <fun>

##### Interaction

Comme l'on désire aussi reprendre le squelette proposé page ?? pour l'interaction, on définit les fonctions de gestion du clavier et de la souris qui s'intègrent à ce squelette. La fonction de gestion du clavier est fort simple. Elle passe la traduction du caractère en valeur de type touche à la fonction `transition` de la calculatrice, puis affiche le texte de l'état de la calculatrice.

    # let f_clavier ec c =
       transition ec.e (traduction c);
       draw_string_in_box Right (string_of_int ec.e.vaf) ec.v Graphics.white ;;
    val f_clavier : etat_calc -> char -> unit = <fun>

La gestion de la souris est un peu plus complexe. Elle nécessite de vérifier que la position du clic souris est bien dans une des boîtes des touches. Pour cela on définit tout d'abord la fonction auxiliaire `mem` qui vérifie l'appartenance d'une position à un rectangle.

    # let mem (x,y) (x0,y0,w,h) =
         (x >= x0) && (x< x0+w) && (y>=y0) && ( y<y0+h);;
    val mem : int * int -> int * int * int * int -> bool = <fun>
    # let f_souris ec x y =
       try
         let b,t,s =
           List.find (fun (b,_,_) ->
                        mem (x,y) (b.x+b.bw,b.y+b.bw,b.w,b.h)) ec.t
         in
           transition ec.e t;
           draw_string_in_box Right (string_of_int ec.e.vaf ) ec.v Graphics.white
       with Not_found -> ();;
    val f_souris : etat_calc -> int -> int -> unit = <fun>

La fonction `f_souris` cherche si la position de la souris lors du clic est bien dans une des boîtes correspondant à une touche, si oui elle passe la touche correspondante à la fonction de transition puis affiche le résultat, sinon elle ne fait rien.
La fonction `f_exc` gère les exceptions pouvant se déclencher lors de l'exécution de ce programme.

    # let f_exc ec ex =
      match ex with
       Division_by_zero ->
         transition ec.e Clear;
         draw_string_in_box Right "Div 0"  ec.v (Graphics.red)
     | Touche_non_valide -> ()
     | Touche_off -> raise Fin
     | _  -> raise ex;;
    val f_exc : etat_calc -> exn -> unit = <fun>

Si une division par zéro survient, elle remet dans l'état initial la calculatrice et affiche un message d'erreur à l'écran de la calculatrice. Une touche non valide est simplement ignorée. Enfin l'exception `Touche_off` déclenche l'exception `Fin` de sortie de la boucle du squelette.

##### Initialisation et sortie

L'initialisation de la calculatrice nécessite de calculer la taille de la fenêtre. La fonction suivante engendre les informations graphiques des boîtes à partir d'une association touche-texte et retourne la taille de la fenêtre principale.

    # let create_e t =
         Graphics.close_graph ();
         Graphics.open_graph " 10x10";
         let mx,my,v,lb = gen_boxes t 4 4 5 2 in
         let s = {dce=0; dta = false; doa = Egal; vaf = 0; mem = 0}   in
           mx,my,{e=s; t=lb;v=v};;
    val create_e : (touche * string) list -> int * int * etat_calc = <fun>

La fonction d'initialisation utilise le résultat de la fonction précédente.

    # let f_init mx my ec () =
           Graphics.close_graph();
           Graphics.open_graph (":0 "^(string_of_int mx)^"x"^(string_of_int my));
           Graphics.set_color grey2;
           Graphics.fill_rect 0 0 (mx+1) (my+1);
           List.iter (fun (b,_,_) -> draw_box b) ec.t;
           List.iter
             (fun (b,_,s) -> draw_string_in_box Center s b Graphics.black) ec.t ;
           draw_box ec.v;
           draw_string_in_box Right "hello" ec.v (Graphics.white);;
    val f_init : int -> int -> etat_calc -> unit -> unit = <fun>

Enfin la fonction de sortie ferme la fenêtre graphique.

    # let f_fin e () = Graphics.close_graph();;
    val f_fin : 'a -> unit -> unit = <fun>

La fonction `go`, paramétrée par une description lance la boucle d'interaction.

    # let go descr =
       let mx,my,e = create_e descr in
         squel (f_init mx my e) (f_fin e) (f_clavier e) (f_souris e) (f_exc e);;
    val go : (touche * string) list -> unit = <fun>

L'appel `go descr_calc` correspond à la figure 5.9.