Bonjour,

Toute personne qui programme finit un jour ou l’autre par se demander où héberger son code source en vue de lui donner une bonne visibilité. Les solutions traditionnelles, comme SourceForge, sont aujourd’hui concurrencées par de nombreuses autres plateformes. Je vous propose de vous présenter aujourd’hui GitHub.

GitHub est un service web d’hébergement et de gestion de développement de logiciels qui repose sur l’utilisation du programme Git. C’est un système rapide, léger et simple d’utilisation qui présente au moins deux avantages sur ses concurrents :

• Il est très facile de faire un fork d’un projet.
• Les fichiers peuvent être édités directement sur le site.

Comme la plupart de ses concurrents, GitHub permet aussi d’ajouter un wiki, de la documentation, une mailing list, un bug tracker, et bien d’autres choses.

Pour ceux qui tiennent à jour un blog (plus ou moins régulièrement d’ailleurs), la possibilité d’avoir accès à une pastebin qui se comporte comme un dépôt Git indépendant est une chose vraiment appréciable.

J’aurai l’occasion de vous en reparler prochainement à l’occasion de la présentation, sur ce blog, d’une petite bibliothèque dédiée aux listes doublement chaînées circulaires immutables (pour ceux qui se souviennent, j’ai déjà eu l’occasion de présenter la version mutable sur ce blog).

Yesterday, a pretty young woman told me that writing about programming languages really need to be done in English. Now that I know she reads my humble texts, I have to follow its advice. So now… let’s be a bit more serious.
As you probably know, polymorphic variants are often seen as a light and elegant alternative to OCaml constructors. Yet these two concepts are not completely interchangeable : that is why they coexist in OCaml. Here I describe a possible use of polymorphic variants to refine some function signatures from the OCaml standard library by adding type constraints.

Too simple to be safe ?

To make things clearer, let’s consider the example of floating-point numbers (or simply floats) and their corresponding OCaml type. The core module defines many functions which deal with floats, such as square root (sqrt) and exponential (exp). Both have the same signature :

val sqrt : float -> float
val exp : float -> float

This short signature means that the function receives a floating-point number as argument and returns a floating-point number as result. Now try to remember your math lessons. You should probably know that exponential is defined from R to R+, whereas square root is defined from R+ to R+. In other words, there is no way to compute the square root of strictly negative numbers. As a consequence, we expect the sqrt function to raise an exception when the input value is negative. Actually, instead of raising an exception, the IEEE 754 standard introduces a special float value called NaN (not a number) to handle these cases.

# let x = -3.5;;
val x : float = -3.5
# exp x;;
- : float = 0.0301973834223185
# sqrt x;;
- : float = nan

Due to its special status, NaN is only able to spread again and again through successive computations, so that the final value is always NaN. This is a convenient solution… but we can also try to get more explicit signatures. This can be achieved with polymorphic variants (this is false suspense before true headache).

The strange world of polymorphic variants

Polymorphic variants are quite subtle stuff that I cannot explain in one short sentence. Therefore, people who are not familiar with this concept should refer to the OCaml manual (politeness for RTFM). For the others, the only thing I really expect you to know by heart is that [> `Foo] means « at least `Foo, but maybe something else », whereas [< `Foo | `Bar] means « nothing more than `Foo and `Bar ». This is the key of what we are going to do in this short article. So first, let’s define a new type :

type ‘a t = ‘a * float

The polymorphic parameter will be used to add some flags to the float value. These flags are polymorphic variants. Of course, the whole definition will be left abstract in the module signature. Then we need two functions for building positive and negative numbers floats, and a specialized value for zero :

let zero = (‘Nil, 0.0)
let positive flo = if flo > 0. then (‘Pos, flo) else invalid_arg "positive"
let negative flo = if flo < 0. then (‘Neg, flo) else invalid_arg "negative"

These functions have quite clear signatures :

val zero : [> ‘Nil] t
val positive : float -> [> ‘Pos] t
val negative : float -> [> ‘Neg] t

Note the use of > in the above signatures and try to understand its aim. Then let’s write another function to convert a given t value to floating-point number :

let to_float = snd

And that’s all ! We are now able to make things a bit safer. One example :

let sqrt = function ‘Nil, _ -> zero | ‘Pos, x -> (‘Pos, sqrt x)

This new sqrt function has a fairly explicit (maybe also cryptic) signature :

val sqrt : [< ‘Nil | ‘Pos] t -> [> ‘Nil | ‘Pos] t

It just means that sqrt expects a non-negative float (either `Nil or `Pos) and returns a non-negative float. Wonderful ! Now we can write many more float-related functions :

let exp t = (‘Pos, exp (to_float t))
let log (‘Pos, x) =
  let r = log x in
  if r = 0. then zero
  else if r < 0. then (‘Neg, x) else (‘Pos, x)
let abs t =
  let flo = abs_float (to_float t) in
  if flo = 0. then zero else (‘Pos, flo)

and their signatures :

val exp : [< ‘Neg| ‘Nil | ‘Pos] t -> [> ‘Pos] t
val log : [‘Pos] t -> [> ‘Neg| ‘Nil | ‘Pos] t
val abs : ‘a t -> [> ‘Nil | ‘Pos] t

We cannot do unsafe computations by composing functions anymore. For instance, the following code is rejected at compile time :

let sqrt_log x = sqrt (log x)
                      ^^^^^^^
Error: This expression has type
         ([> `Neg | `Nil | `Pos ] as 'a) t = 'a * float
       but an expression was expected of type
         ([< `Nil | `Pos ] as 'b) t = 'b * float
       The second variant type does not allow tag(s) `Neg

The compiler is complaining because log can return negative values, and sqrt cannot handle them. We should thus write something like this :

type nonneg = [`Nil | `Pos]

let sqrt_log x =
  match log x with
  | `Neg, _ -> None
  | #nonneg, _ as y -> Some (sqrt y)

and we get the following signature :

val sqrt_log : [ `Pos ] t -> [> `Nil | `Pos ] t option

That’s all folks !
Cacophrène

Après un long moment d’absence et de sérieux doutes sur la pérennité de ce blog, je reviens vous parler de LablGTK. Cette fois-ci, je ne vous présenterai pas un autre module de la bibliothèque. Pour célébrer la renaissance de ce blog, à la suite de mon admission en thèse (dans un domaine très éloigné du sujet de ce blog), je vous propose de parler du mécanisme de callback dans LablGTK.

Nous allons aborder dans ce billet une manière automatisée d’associer des fonctions callback à des widgets. Mais, pour partir sur de bonnes bases, nous allons d’abord rappeler ce qu’est une fonction callback.

Le principe d’une fonction callback

Une fonction callback (je ne me risque pas à proposer de traduction) est une fonction qui est communiquée dans un argument passé à une autre fonction. Dans le cas de GTK, un widget interagit avec l’utilisateur en émettant des événements auxquels des fonctions peuvent être associées. Ces dernières, on l’aura compris, ont pour but de répondre à l’événement émis, et donc in fine à l’utilisateur. Par exemple, le code suivant est typique :

let main_window =
  let window = GWindow.window
    ~title:"LablGTK demo"
    ~position:`CENTER
    ~width:640 ~height:480 () in
  window#connect#destroy ~callback:GMain.quit;
  window 

Ce code crée la fenêtre principale d’une application. On y indique également qu’il faut fermer l’application (GMain.quit) lorsque la fenêtre est détruite (ce qui se traduit par la levée de l’événement destroy). Dans ce cas, la fonction GMain.quit est utilisée comme callback.

Séparation de l’interface et du code

Pour construire une application, on recommande généralement de dissocier les éléments de l’interface et les actions associées. Le code est ainsi mieux structuré et plus facile à maintenir. Par exemple, on peut considérer un module GUI qui contient l’ensemble des widgets de l’interface, et divers modules qui définissent les actions associées (copie, collage, zoom, enregistrement, etc.). Malgré des qualités indéniables, cette approche présente au moins deux inconvénients de taille :

• Chaque fois que l’interface est modifiée (par exemple en ajoutant ou en supprimant un widget), le module qui définit l’action correspondante doit être mis à jour pour ajouter ou supprimer un enregistrement de fonction callback et tenir ainsi compte des modifications réalisées en amont.
• Le module qui définit les actions n’est plus autonome : il dépend du module d’interface de l’application, de sorte que sa réutilisation dans un autre contexte devient plus difficile.

Nous allons présenter ici une solution qui résout ces deux problèmes et permet d’automatiser l’enregistrement des fonctions callback.

Automatisation du mécanisme de callback

Quelques nouveaux types

Pour automatiser le mécanisme d’enregistrement des fonctions callback, nous allons commencer par définir des types qui correspondent à une action particulière, comme l’activation d’un élément ou un clic gauche de souris. Ce sont :

class type clickable = 
  object
    method clicked : callback:(unit -> unit) -> GtkSignal.id
  end

class type activatable = 
  object
    method activate : callback:(unit -> unit) -> GtkSignal.id
  end

Notez que l’on pourrait écrire de très nombreux autres types de ce genre, mais ceux-ci sont les plus fréquents car ils couvrent à la fois les barres d’outils et les menus, c’est-à-dire les éléments les plus susceptibles d’être modifiés dans une interface (on peut aussi voir dans ces définitions, quoique d’assez loin, une influence des typeclass de Haskell). On va ensuite définir un type somme pour réunir le tout :

type item =
  | C of clickable
  | A of activatable

Stockage des couples identifiant/données

Nous allons ensuite définir une table de hachage destinée à stocker des identifiants (type string) et des données associées. Ces données sont constituées d’une liste d’objets (item list) et d’une fonction de callback (de type unit -> unit). Comme nous voulons modifier ces valeurs directement, nous allons les stocker sous forme de références :

val table : (string, action list ref * (unit -> unit) ref) Hashtbl.t

Nous allons maintenant définir une fonction register_any qui, étant donné une fonction f, un identifiant id et un widget wid, ajoute f wid (de type item) à la liste des objets associés à l’identifiant id :

let register_any f id wid =
  let item = f wid in
  try
    let items = fst (Hashtbl.find table id) in
    items := item :: !items
  with Not_found -> Hashtbl.add table id (ref [item], ref ignore)

Remarque : vous avez peut-être remarqué que, si l’identifiant n’existe pas dans la table de hachage, les données ajoutées comportent une fonction callback qui ne fait rien (Pervasives.ignore). Elle pourra bien sûr être modifiée par la suite !

Enregistrement des widgets

Nous pouvons ensuite définir des fonctions spécialisées pour les deux types clickable et activatable définis précédemment :

let register_clickable ~id obj = 
  register_any (fun obj -> C (obj#connect :> clickable)) id obj

let register_activatable ~id obj = 
  register_any (fun obj -> A (obj#connect :> activatable)) id obj

Ces fonctions ont la signature suivante :

val register_clickable : id:string ->  -> unit

val register_activatable : id:string ->  -> unit

En d’autres termes, elles reçoivent en entrée un identifiant de type string et un widget dont la méthode connect est un sur-ensemble de la classe clickable (ou activatable, respectivement).

Enregistrement des fonctions de callback

Il faut ensuite écrire une fonction capable d’enregistrer les fonctions callback. Pour simplifier son utilisation, on souhaite qu’elle renvoie en sortie la fonction reçue en entrée :

let register_callback ~id f =
  try snd (Hashtbl.find table id) := f; f with Not_found -> f

Cette fonction est de type :

val register_callback : id:string -> (unit -> unit) -> unit -> unit

Association des fonctions aux widgets

Il ne reste plus qu’à définir la fonction qui associe les callback au lancement de l’application :

let connect_all () =
  Hashtbl.iter (fun _ ({contents = t}, {contents = f}) ->
    List.iter (function
      | C connect -> ignore (connect#clicked ~callback:f)
      | A connect -> ignore (connect#activate ~callback:f)
    ) t
  ) table

Rappel : en OCaml, les références peuvent être vues comme des valeurs de type record avec un champ unique appelé contents. On peut donc filtrer les références en écrivant {contents = x}, où x désigne le contenu de la référence.

Cette fonction présente une signature très simple :

val connect_all : unit -> unit

Utilisation du module dans le programme

L’utilisation de ce module dans un programme se déroule en trois temps :

• Tout d’abord, les éléments de l’interface sont créés et enregistrés avec les fonctions register_clickable ou register_activatable. À cet effet, un identifiant spécifique est nécessaire… mais celui-ci peut être recyclé avantageusement et servir pour les plugins, voire pour la traduction de l’application en plusieurs langues.
• Ensuite, les fonctions callback sont enregistrées avec register_callback et le même identifiant que précédemment. Les modules qui les contiennent restent indépendants du module d’interface. Accessoirement, les équipes de développeurs qui se parlent peu auront moins de surprises lors de la mise en commun de leur code ;-).
• Enfin, au lancement de l’application, on connecte tous les widgets à leurs fonctions respectives à l’aide d’un unique appel à connect_all. On n’oublie personne !

On peut bien entendu imaginer diverses généralisations plus ou moins complexes de ce procédé, notamment au cas des fonctions callback multiples. On aurait alors une table de hachage de type :

val table : (string, action list ref * (unit -> unit) list ref) Hashtbl.t

et la fonction connect_all deviendrait :

let connect_all () =
  Hashtbl.iter (fun _ ({contents = obj_list}, {contents = fun_list}) ->
    List.iter (fun item ->
      let f = match item with
        | C connect -> (fun f -> ignore (connect#clicked ~callback:f))
        | A connect -> (fun f -> ignore (connect#activate ~callback:f))
      in List.iter f fun_list
    ) obj_list
  ) table

Remarque : il commence à y avoir beaucoup d’itérateurs imbriqués. Il faut bien voir qu’il s’agit d’appliquer les fonctions associées à l’identifiant id à chacun des éléments enregistrés.

En conclusion…

D’abord, un lien vers le code complet et l’interface complète.

Il est certain que l’intérêt d’un tel module se ressent surtout dans de moyennes ou grosses applications, dont l’interface est complexe et présente un certain niveau de redondance. Je ne pense pas qu’il soit raisonnable de l’utiliser pour écrire un pong.

Voilà, c’est tout pour ajourd’hui !

Cordialement,
Cacophrène

Après un long moment d’absence, je reviens pour vous parler d’une notion dont l’intérêt m’a été révélé par un article sur le blog de bluestorm. Il s’agit des types fantômes, dont je souhaite vous montrer ici tout le bien. Naturellement, je vais partir d’un cas concret autour de ce que je développe actuellement.

Le contexte

Une application pour microscopistes

Je suis actuellement en train d’écrire les grandes lignes d’un programme destiné à des microscopistes amateurs, dont il existe déjà une version en Visual Basic (à réécrire et faire évoluer). Ce programme doit permettre de mettre en forme des images pour un forum en leur ajoutant un cartouche contenant diverses informations utiles (échelle, type de matériel, coloration éventuelle, etc.). Je vous donne une image ci-dessous pour vous faire une idée. Une caractéristique importante de ce logiciel réside dans sa capacité à dessiner des échelles à partir d’une relation entre un nombre X de pixels et une taille Y en micromètres, déterminée sur une image étalon.

Spores d’helvelle après coloration.
Objectif Zeiss Planapo 100/1.3

Image d’étalon

Une image étalon est une photo dont les éléments ont une taille connue, prise dans les mêmes conditions qu’une image classique. Le plus souvent, il s’agit d’une « règle » dont les graduations sont espacées de 10 µm (la bagatelle de 100 graduations dans un millimètre…). Le programme charge l’image d’étalon, l’analyse à la manière d’un outil de reconnaissance de caractères (en beaucoup plus simple !), et en déduit la taille d’une graduation, exprimée en pixels. De son côté, l’utilisateur indique la taille réelle correspondante, en micromètres cette fois-ci (cf. l’image ci-dessous).

Image d’étalon (1 graduation correspond à 10 µm).
Objectif Zeiss Plan Neofluar 63/1.25

Manipulation d’images

Pour automatiser la reconnaissance des graduations, on souhaite implémenter l’algorithme suivant (plutôt une recette de cuisine) :

• Charger l’image en couleur (24 bits).
• La transformer en niveaux de gris.
• Augmenter la luminosité pour éclaircir le fond.
• Passer en noir et blanc.
• Effacer les poussières pour uniformiser le fond.
• Reboucher les trous dans les traits de graduations.
• Mesurer les traits de graduation et les espaces qu’ils délimitent.
• En déduire la taille d’une graduation (un espace + un trait).

Pour y parvenir, nous allons utiliser LablGTK et CamlImages, deux bibliothèques qui dialoguent plutôt bien. Nous allons nous fixer comme objectif d’écrire un type picture polymorphe. Nous nous en servirons pour distinguer les images en couleur (24 bits), en niveaux de gris et en noir et blanc. Les fonctions telles que get_width ou get_pixbuf s’appliqueront à tout type d’image.

Choix d’une interface

Pour faire court, nous voudrions quelque chose comme ceci :

type 'a picture

type fullcolor
type grayscale
type monochrom

val from_file : string -> fullcolor picture
(** Charge une image en couleurs. *)

(** Fonctions usuelles, valables pour tout type d'image. *)
val copy : 'a picture -> 'a picture
val get_width : 'a picture -> int
val get_height : 'a picture -> int
val get_pixbuf : 'a picture -> GdkPixbuf.pixbuf

val grayscale : 
  ?filter:(Color.rgb -> int) -> 
  fullcolor picture -> grayscale picture
(** Conversion en niveaux de gris d'une image couleur (24 bits). *)

val black_and_white :
  ?threshold:int ->
  grayscale picture -> monochrom picture
(** Conversion en noir et blanc d'une image en niveaux de gris. *)

val noise_reduction :
  ?threshold:int ->
  monochrom picture -> monochrom picture
(** Effacement des poussières sur une image en noir et blanc. *)

val fill_gaps :
  ?threshold:int ->
  monochrom picture -> monochrom picture
(** Rebouchage des trous sur une image en noir et blanc. *)

Pour que cet algorithme ne reste pas nébuleux, voici un PDF d’illustration.

Du côté de l’implémentation

Après l’interface, voyons l’implémentation. A priori, cela peut sembler difficile. Pourtant, grâce aux types fantômes, nous n’avons presque rien à faire ! Définissons d’abord le type picture :

type 'a picture = {pict: OImages.rgb24_class}

Ne vous étonnez pas de trouver ici un record alors qu’il paraît inutile. Le vrai type picture, que j’utilise dans mon application, contient d’autres champs (mais aucun n’est de type 'a, c’est très important). Il a été simplifié ici par souci de pédagogie.

Définissons maintenant trois types fantômes :

type fullcolor
type grayscale
type monochrom

Un type fantôme est un type utilisé comme paramètre d’un autre type (à la manière du type int dans int list), mais qui ne sert pas dans la définition de ce type (comme 'a dans 'a picture ci-dessus). Le type fantôme vous permet d’ajouter une information (une contrainte) qui sera propagée correctement par l’algorithme d’inférence de types, sans impact sur l’implémentation. Dans mon cas, il s’agit surtout de s’assurer que l’on passe bien une image en niveaux de gris à la fonction black_and_white, par exemple.

Nous pouvons maintenant écrire la fonction de création :

let from_file str = {pict = OImages.rgb24 (OImages.load path [])}

puis les fonctions utilitaires :

let get_width t = t.pict#width
let get_height t = t.pict#height
let get_pixbuf t = Imagegdk.to_pixbuf t.pict#coerce
let copy t = {t with pict = Oo.copy t.pict}

Nous pouvons maintenant en venir aux fonctions qui agissent directement sur l’image et, comme vous allez le constater, on ne se doute de rien en lisant cette partie du code :

let grayscale ?(filter = Color.brightness) pic =
  let res = copy pic in
  let img = res.pict in
  for x = 0 to img#width - 1 do
    for y = 0 to img#height - 1 do
      let res = filter (img#unsafe_get x y) in
      img#unsafe_set x y {Color.r = res; g = res; b = res}
    done
  done;
  res

let black = {Color.r = 0; g = 0; b = 0}
let white = {Color.r = 255; g = 255; b = 255}

let black_and_white ?(threshold = 0x90) pic =
  let res = copy pic in
  let img = res.pict in
  for x = 0 to img#width - 1 do
    for y = 0 to img#height - 1 do
      let rgb = img#unsafe_get x y in
      img#unsafe_set x y (if rgb.Color.r > threshold then white else black)
    done
  done;
  res

et ainsi de suite (le détail d’implémentation des fonctions   et fill_gaps sort du cadre de ce billet; je peux développer sur demande, mais il ne me semble pas pertinent de le faire ici). Avec un appel à ocamlc -i, toutes ces fonctions accepteraient des images de type 'a picture. La contrainte que nous avons posée dans l’interface est à la fois valide et transparente du côté de l’implémentation.

Il est intéressant de noter que les types fantômes apportent une information supplémentaire sans impact sur l’implémentation. Cela renforce la sûreté du code sans nuire aux performances (imaginez la lourdeur qui consisterait à s’assurer d’abord que tous les pixels sont bien des teintes de gris !).

En guise de conclusion…

Je parlais d’un aller simple vers le monde des fantômes. Vous savez maintenant pourquoi : quand on y a goûté, on ne peut plus s’en passer. Les types fantômes, c’est bien, mangez-en !

À bientôt,
Cacophrène

Je vous ai parlé, dans le précédent billet, de l’intégration du widget GtkSourceView 2.0 dans la bibliothèque LablGTK. Voyons ici ce qui change par rapport à l’ancien widget.

Voici ci-dessous un petit code qui permet de voir quelques-unes des nouveautés de GtkSourceView 2.0, entre autres les thèmes (GtkStyleScheme) et la matérialisation des espaces. Un thème est choisi aléatoirement au lancement de l’application (évidemment, plus vous en avez et plus il y aura de visuels possibles…). Pour tester, placez le code suivant dans un fichier test.ml, puis compilez avec :

Si vous voulez utiliser un nom différent, n’oubliez pas de modifier la fonction read dans le code source !

let window =
  GMain.init ();
  let wnd = GWindow.window 
    ~title:"GtkSourceView 2.0 Demo" 
    ~position:`CENTER 
    ~resizable:false  
    ~width:800 ~height:600 () in 
  wnd#connect#destroy GMain.quit; 
  wnd 
 
let ocaml = 
  let manager = GSourceView2.source_language_manager ~default:true in 
  match manager#language "objective-caml" with 
  | None -> failwith "La coloration syntaxique pour OCaml n'est pas disponible !" 
  | some -> some
 
let manager = GSourceView2.source_style_scheme_manager ~default:true 
let schemes = Array.of_list manager#style_scheme_ids 
 
let get_random_style_scheme () = 
  Random.self_init (); 
  match manager#style_scheme schemes.(Random.int (Array.length schemes)) with 
  | None -> assert false 
  | some -> some 
 
let scroll = GBin.scrolled_window 
  ~hpolicy:`ALWAYS 
  ~vpolicy:`ALWAYS 
  ~packing:window#add () 
 
let source = 
  let src = GSourceView2.source_view 
    ~draw_spaces:[`NEWLINE; `SPACE] (* Matérialisation des espaces. *) 
    ~auto_indent:true 
    ~indent_on_tab:true (* Quelques étiquettes ont été renommées *) 
    ~indent_width:2 
    ~insert_spaces_instead_of_tabs:true 
    ~right_margin_position:80 
    ~show_line_numbers:true 
    ~show_right_margin:true 
    ~packing:scroll#add () in 
  src#misc#modify_font_by_name "Monospace 10"; 
  let buf = src#source_buffer in 
  buf#set_language ocaml; 
  buf#set_highlight_syntax true; 
  buf#set_style_scheme (get_random_style_scheme ()); 
  src 
 
let read () = 
  let ich = open_in "test.ml" in 
  let len = in_channel_length ich in 
  let str = String.create len in 
  really_input ich str 0 len; 
  close_in ich; 
  Glib.Convert.locale_to_utf8 str 
 
let _ = 
  source#source_buffer#set_text (read ()); 
  window#show (); 
  GMain.main ()

Ce code nous donne quelque chose comme ça :

Le nouveau widget bénéficie d’une interface plus agréable à utiliser, avec des étiquettes plus parlantes qu’auparavant. Il ne lui manque plus que la factorisation du code (code folding) et l’auto-complétion, qui sont sans doute les deux fonctionnalités les plus attendues pour les prochaines versions.

À bientôt,
Cacophrène

Je vous propose de poursuivre notre exploration de la bibliothèque LablGTK. Dans ce billet, nous allons parler du module GPack. Celui-ci contient tous les widgets nécessaires à la réalisation d’interfaces complexes. La plupart d’entre eux sont transparents pour l’utilisateur, car ils n’ont pas de représentation graphique. Pourtant, comme nous allons le voir ici, ce sont de précieux alliés !

Introduction

Nous avons vu dans un précédent billet que l’élément principal d’une interface est généralement une fenêtre (GtkWindow). Or ce widget ne peut contenir qu’un seul widget enfant. Cela semble, a priori, une limitation majeure. Pourtant, GTK permet de réaliser des interfaces arbitrairement complexes. Il est donc possible de lever cette limitation. Pour cela, GTK définit des conteneurs, c’est-à-dire des widgets dont la fonction principale est de contenir d’autres widgets. Ces conteneurs peuvent être imbriqués à souhait et constituent donc une solution à la fois élégante et souple.

Les boîtes horizontales (GtkHBox)

Ces boîtes permettent d’insérer des widgets horizontalement. Les enfants sont insérés avec la méthode #add, ou avec #pack si l’on souhaite paramétrer finement le style d’insertion (entre autres, la capacité du widget enfant à être élargi pour remplir l’espace disponible). Voyez par exemple :

let window =
  GMain.init ();
  let wnd = GWindow.window ~width:150 ~height:100 () in
  wnd#connect#destroy GMain.quit;
  wnd

let packing = 
  let hbox = GPack.hbox
    ~spacing:5 (* Les enfants sont espacés de 5 pixels. *)
    ~border_width:5 (* La boîte possède une bordure de 5 pixels. *)
    ~packing:window#add () in
  hbox#pack ~expand:false

let _ = 
  List.iter (fun text -> ignore (GMisc.label ~packing ~text ())) ["foo"; "bar"];
  window#show ();
  GMain.main ()

Pour info : cet exemple, comme les suivants, est complet et peut-être testé dans l’interpréteur après avoir chargé la bibliothèque LablGTK.

Les boîtes verticales (GtkVBox)

Les boîtes verticales fonctionnent de la même manière que les boîtes horizontales, à un détail près : les widgets enfants sont insérés verticalement.

let window =
  GMain.init ();
  let wnd = GWindow.window ~width:150 ~height:100 () in
  wnd#connect#destroy GMain.quit;
  wnd

let packing = 
  let vbox = GPack.vbox
    ~spacing:5 (* Les enfants sont espacés de 5 pixels. *)
    ~border_width:5 (* La boîte possède une bordure de 5 pixels. *)
    ~packing:window#add () in
  vbox#pack ~expand:false

let _ = 
  List.iter (fun text -> ignore (GMisc.label ~packing ~text ())) ["foo"; "bar"];
  window#show ();
  GMain.main ()

Les tableaux (GtkTable)

Les tableaux (GtkTable) sont un moyen pratique d’organiser des widgets sous forme de tableaux (on s’en serait douté…). Ils peuvent être utilisés, par exemple, pour créer des palettes. Les widgets sont insérés à l’aide de la méthode #attach en indiquant l’emplacement des coins gauche (left) et haut (top) du widget.

let window =
  GMain.init ();
  let wnd = GWindow.window () in
  wnd#connect#destroy GMain.quit;
  wnd

let attach = 
  let table = GPack.table 
    ~rows:4 (* Nombre de rangées. *)
    ~columns:4 (* Nombre de colonnes. *)
    ~row_spacings:2 (* Espacement des éléments d'une même rangée. *)
    ~col_spacings:2 (* Espacement des éléments d'une même colonne. *)
    ~packing:window#add () in
  fun i -> table#attach ~left:(i mod 4) ~top:(i / 4)

let _ = 
  Random.self_init ();
  for i = 0 to 24 do
    let r = Random.int 256 and g = Random.int 256 and b = Random.int 256 in
    let text = Printf.sprintf "#%02x%02x%02x" r g b in
    let entry = GEdit.entry ~text ~width:80 ~packing:(attach i) () in
    entry#misc#modify_base [`NORMAL, `NAME text]
  done;
  window#show ();
  GMain.main ()

Les boîtes pour boutons (GtkButtonBox)

GTK fournit une boîte spécialement conçue pour recevoir des boutons : il s’agit de GtkButtonBox, ou GPack.button_box dans LablGTK. Elle est conçue pour vous permettre d’organiser des boutons à la manière des boîtes de dialogue :

let window =
  GMain.init ();
  let wnd = GWindow.window
    ~title:"Button box demo"
    ~position:`CENTER 
    ~resizable:false
    ~width:300 ~height:150 () in
  wnd#connect#destroy GMain.quit;
  wnd

let vbox = GPack.vbox 
  ~spacing:2 
  ~border_width:2
  ~packing:window#add ()

let view = GText.view ~packing:vbox#add ()

let bbox = GPack.button_box `HORIZONTAL
  ~layout:`EDGE (* C'est ici que l'on choisit la disposition des boutons. *)
  ~border_width:2
  ~packing:(vbox#pack ~expand:false) ()

let help = GButton.button ~stock:`HELP ~packing:bbox#add ()
let quit = GButton.button ~stock:`QUIT ~packing:bbox#add ()

let _ =
  window#show ();
  GMain.main ()

Autres éléments

Le module GPack définit d’autres widgets, notamment les pages à onglets (GtkNotebook) et les panneaux mobiles (GtkPaned). En raison de leur intérêt tout particulier dans la réalisation d’interfaces, nous y consacrerons un billet entier.

Atelier : Le triangle de Pascal

Pour terminer, je vous propose de réaliser une petite application qui affiche à l’écran les coefficients binomiaux en les présentant sous la forme du célèbre triangle de Pascal. Voici à quoi devra ressembler notre application :

Pour réaliser notre application, nous avons besoin d’une fenêtre :

let window =
  let wnd = GWindow.window
    ~title:"GPack demo"
    ~position:`CENTER
    ~resizable:false
    ~width:400 ~height:300 () in
  wnd#connect#destroy GMain.quit;
  wnd

Celle-ci doit recevoir deux éléments distincts : une fenêtre assortie de barres de défilement, pour recevoir le triangle, et un bouton de fermeture. Nous allons donc commencer par insérer une boîte verticale dans window :

let vbox = GPack.vbox 
  ~border_width:2 
  ~spacing:2 
  ~packing:window#add ()

Nous pouvons alors ajouter les barres de défilement pour permettre à l’utilisateur d’explorer les lignes du triangle :

let scroll = GBin.scrolled_window
  ~hpolicy:`ALWAYS
  ~vpolicy:`ALWAYS
  ~packing:window#add ()

Ces barres de défilement ajoutées avec GBin.scrolled_window ne résolvent pas le problème de GWindow.window, car l’une comme l’autre ne peuvent contenir qu’un seul widget enfant. Pour lever cette limitation, nous devons donc insérer une boîte verticale à l’intérieur des barres de défilement. Ici, comme il doit être possible de faire défiler le contenu de la boîte, on utilise la méthode #add_with_viewport au lieu du classique #add. Ce qui nous donne :

let vbox, packing = 
  let vbox = GPack.vbox
    ~spacing:2
    ~packing:scroll#add_with_viewport () in
  vbox, vbox#pack ~expand:false

Écrivons maintenant une fonction spécialisée (par application partielle) de GMisc.label pour nous simplifier la tâche :

let label = GMisc.label ~height:50 ~width:50 ~xalign:0.5

Pour information, les paramètres height et width fixent la taille des étiquettes produites (pas étonnant quand même…), et xalign détermine l’alignement du texte (aligné à gauche avec 0.0, centré avec 0.5 et aligné à droite avec 1.0).

Venons-en maintenant au coeur du problème. Nous devons écrire une fonction qui affiche les lignes successives du triangle de Pascal en calculant les coefficients. Ici, les boucles sont pratiques, je préfère donc donner une version en style impératif. Les principales étapes sont les suivantes :

• Pour tout entier i entre 1 et n, créer un nouveau conteneur horizontal (GPack.hbox) et la fonction d’empaquetage associée (packing).
• Pour tout entier j entre 1 et j, calculer le coefficient binomial, égal à 1 lorsque j = 1 ou j = i, et coeff(i – 1, j – 1) + coeff(i – 1, j) sinon. Le stocker dans une table de hachage pour réutilisation ultérieure (mémoïsation).
• Créer une étiquette (GMisc.label) contenant le coefficient, et l’insérer dans le conteneur horizontal précédemment créé.

Nous pouvons satisfaire à toutes ces exigences avec le code suivant :

let create n =
  let mem = Hashtbl.create n in
  let get = Hashtbl.find mem in
  for i = 1 to n do
    let packing = (GPack.hbox ~spacing:2 ~packing ())#pack ~expand:false in
    for j = 1 to i do
      let coef =
        if j = 1 || j = i then 1 
        else get (i - 1, j) + get (i - 1, j - 1) in
      label ~text:(string_of_int coef) ~packing ();
      Hashtbl.add mem (i, j) coef
    done
  done

Nous pouvons maintenant terminer notre application en lui ajoutant un bouton de fermeture. C’est le moment de se rappeler que le conteneur GPack.button_box est destiné tout spécialement à recevoir des boutons :

let quit = 
  let bbox = GPack.button_box `HORIZONTAL 
    ~layout:`END 
    ~packing:(vbox#pack ~expand:false) () in
  let quit = GButton.button ~stock:`QUIT ~packing:bbox#add () in
  quit#connect#clicked window#destroy;
  quit

Pour finir, quelques lignes qui vérifient que le nombre de lignes à afficher est bien passé en argument, et qu’il s’agit d’un entier valide compris entre 1 et 25 (limites arbitraires) :

let _ =
  try
    if Array.length Sys.argv = 2 then (
      let n = int_of_string Sys.argv.(1) in
      if n > 0 && n < 26 then create n else raise Exit;
      window#show ();
      GMain.main ()
    ) else raise Exit 
  with _ -> prerr_endline "Usage: triangle.ml TAILLE"

C’est tout ! Il ne nous reste plus qu’à lancer l’application :

Voici aussi un lien vers le code complet de cet atelier.

À bientôt,
Cacophrène

Rien de tel que de commencer la nouvelle année par un jeu. Nous allons donc essayer d’implémenter en OCaml une version proche du jeu Le Compte est bon imaginé par Armand Jammot (dans l’émission Des chiffres et des lettres que regarde votre grand-mère).

Pour ce que ce soit plus pratique, nous allons changer un peu les règles du jeu :

• Le but du jeu est de calculer un nombre N compris entre 100 et 1000.
• On dispose pour cela de 6 entiers choisis dans l’intervalle [1; 100].
• Le choix des nombres est aléatoire et il n’y a pas de doublons.
• Les entiers sont combinés entre eux à l’aide des opérations +, -, * et /.

Contrairement aux candidats du jeu télévisé, l’ordinateur devra trouver toutes les solutions. Nous souhaitons obtenir cette réponse en une seconde au plus sur un ordinateur récent (en natif, bien entendu).

Mais au fait…

Avant de commencer, je ne peux m’empêcher de vous proposer une question préliminaire pour évaluer la faisabilité de ce programme : combien de cas l’ordinateur doit-il analyser ? Je ne donne pas la réponse tout de suite, mais voici tout de même un indice : pour n = 6, cas qui nous intéresse ici, il faut examiner plus de 700 000 expressions.

Définition d’une expression

Pour pouvoir travailler efficacement, nous devons d’abord définir un type capable de représenter une expression mathématique de la forme (((a + b) - c) * d) / e. Il s’agit tout simplement d’une sorte d’arbre binaire dont les feuilles sont des entiers :

type expr =
  | Num of int              (* Entier.      *)
  | Add of expr * expr      (* Somme.       *)
  | Rem of expr * expr      (* Différence.  *)
  | Mul of expr * expr      (* Produit.     *)
  | Div of expr * expr      (* Quotient.    *)

Par commodité, et parce que les constructeurs d’OCaml ne sont pas des fonctions (il y a, je crois, des extensions camlp4 pour obtenir quelque chose dans ce genre), nous allons nous simplifier la vie en définissant dès maintenant les quatre fonctions auxiliaires suivantes :

let add x y = Add (x, y)
let rem x y = Rem (x, y)
let mul x y = Mul (x, y)
let div x y = Div (x, y)

Pour finir, il nous faut une fonction capable de convertir une expression en chaîne de caractères en vue de son affichage. La méthode retenue ici ajoute quelques parenthèses superflues, mais elle a le double mérite d’être simple.

let to_string =
  let rec loop lbr rbr = function
    | Num x -> string_of_int x
    | Add (x, y) -> sprintf "%s%s + %s%s" lbr (inner x) (inner y) rbr
    | Rem (x, y) -> sprintf "%s%s - %s%s" lbr (inner x) (inner y) rbr
    | Mul (x, y) -> sprintf "%s%s * %s%s" lbr (inner x) (inner y) rbr
    | Div (x, y) -> sprintf "%s%s / %s%s" lbr (inner x) (inner y) rbr
  and inner expr = loop "(" ")" expr in loop "" ""

Quelques ensembles utiles

Intéressons-nous maintenant aux données que nous allons manipuler. L’énoncé précise que nous disposons de six entiers uniques choisis au hasard. Dans le cas qui nous intéresse, les ensembles (module Set) sont particulièrement bien adaptés. Définissons donc :

module NSet = Set.Make (
  struct
    type t = int
    let compare = compare
  end
)

Il nous faut aussi de quoi stocker l’ensemble des solutions. Comme nous allons seulement les afficher, nous pouvons définir un ensemble de chaînes (mais on peut aussi envisager de stocker un ensemble d’expressions en vue de traitements ultérieurs) :

module SSet = Set.Make(String)

Fonctions auxiliaires

Écrivons maintenant une fonction qui renvoie un ensemble constitué de six entiers choisis au hasard dans l’intervalle [1; 100]. L’initialisation du générateur de nombres pseudo-aléatoires est contrôlée par un paramètre facultatif, et désactivée par défaut :

let get_numbers ?(init = false) () =
  if init then Random.self_init ();
  let rec loop set = function
    | 0 -> set
    | i -> let n = Random.int 100 + 1 in
      if NSet.mem n set then loop set i
      else loop (NSet.add n set) (i - 1)
  in loop NSet.empty 6

L’algorithme

Définissons d’abord deux listes auxiliaires qui vont nous être fort utile par la suite :

let functions = [add; rem; mul; div]
let operators = [( + ); ( - ); ( * ); ( / )]

À partir de là, il faut réfléchir un peu. L’algorithme d’exploration exhaustive fonctionne de la manière suivante (je donne le noms des variables utilisées en gras dans le texte pour faciliter la compréhension du code donné ultérieurement) :

• Choisir un entier (y) et poursuivre l’exploration avec les 4 opérations de base (opr), en retirant cet entier de l’ensemble des entiers disponibles (num).
• À chaque niveau, comparer le résultat intermédiaire x avec le nombre recherché res. En effet, une expression valide (acc) ne contient pas nécessairement les 6 entiers… elle peut être plus simple !

Il existe plusieurs manières d’écrire ceci en OCaml. Je vous propose une version qui utilise des fonctions d’ordre supérieur de type fold, et qui traite séparément le cas où l’ensemble d’entiers est vide. Il s’agit d’une optimisation qui fait passer le temps d’exécution de 0,2 s à 0,1 s en natif car elle évite de manipuler des fermetures inutilement.

let rec explore res x acc num str =
  let str' = if res = x then SSet.add (to_string acc) str else str in
  if NSet.is_empty num then set' else (
    List.fold_left2 (fun str fct opr ->
      NSet.fold (fun y str ->
        explore res (opr x y) (fct acc (Num y)) (NSet.remove y num) str
      ) num str
    ) str' functions operators
  )

Il ne nous reste plus qu’à écrire une fonction find qui reçoit en entrée le nombre à calculer (res) et l’ensemble des entiers disponibles (num). Elle permet d’appeler explore en lui fournissant des valeurs initiales :

let find res num =
  NSet.fold (fun x -> 
    explore res x (Num x) (NSet.remove x num)
  ) num SSet.empty

Quelques exemples d’application

Contrairement à ce que je pensais avant de coder ce jeu, les solutions sont souvent nombreuses. Par exemple, si vous lancez ce code avec res = 162 et l’ensemble {10; 22; 36; 43; 73; 94}, vous verrez qu’il existe la bagatelle de 854 solutions ! Au contraire, certains tirages ne donnent que très peu de solutions. Voici un exemple de sortie avec peu de solutions :

> Calculer 431 avec les valeurs 34 37 57 58 66 82 
Temps d'exécution : 0.126 s (737280 cas, 4 solutions)
((((37 / 34) + 66) - 58) * 57) - 82
((((37 / 34) - 58) + 66) * 57) - 82
((((66 - 57) * 34) * 82) - 37) / 58
((((66 - 57) * 82) * 34) - 37) / 58

Et la devinette ?

Eh bien, c’est simple. Vous disposez de n entiers à combiner avec 4 opérations. Vous pouvez donc construire un total de n! * 4 ^ (n – 1) expressions (sans tenir compte de la commutativité et des expressions de moins de 6 chiffres).

Le mot de la fin

J’ai dit plus haut que ce code s’exécute en un dixème de seconde environ sur une machine récente. La méthode exhaustive est donc acceptable… mais ça n’a pas toujours été le cas. Ainsi, lors de la création du jeu, aucune implémentation efficace n’était disponible et la recherche d’une solution reposait sur le talent des animateurs (au contraire, le jeu intitulé Le mot le plus long, dans cette même émission, possédait déjà une version informatique efficace). Je reste d’ailleurs toujours admiratif devant l’agilité de certaines personnes à trouver les bonnes combinaisons de nombres et d’opérations, quand je peine à venir à bout d’une multiplication toute bête

Pour aller plus loin…

Il y a de très nombreuses manières de faire évoluer ce code :

• Ajouter la notion de commutativité pour éviter les solutions redondantes.
• Classer les solutions (courtes vs longues, etc.).
• Abstraire le code pour pouvoir utiliser d’autres types que int.

Pour finir, voici le code complet (libre de droits, cela va sans dire) qui a servi de base à la rédaction de ce billet.

À bientôt,
Cacophrène

Dans le précédent billet consacré à LablGTK, nous avons parlé du module GButton. Nous allons maintenant nous pencher sur un autre module incontournable dès que l’on veut créer une interface graphique : le module GWindow.

Le module GWindow définit des fenêtres (GtkWindow), des boîtes de dialogue qui affichent des messages (GtkMessageDialog) ou un contenu plus complexe (GtkDialog). On y trouve aussi des fenêtres spécialisées dans la manipulation des fichiers (GtkFileChooserDialog), des couleurs (GtkColorDialog), des fontes (GtkFontDialog). Enfin, le module GWindow fournit une boîte de dialogue ‘À propos…’ (GtkAboutDialog) qui simplifie le développement des applications.

GtkWindow

Les fenêtres de type GtkWindow sont appelées toplevel. Elles servent de conteneur principal pour une interface et n’ont donc pas de widget parent. Voici quelques méthodes intéressantes pour modifier la taille de la fenêtre :

Fenêtre principale et fermeture de l’application

En général, on utilise #event#connect#delete pour afficher un message de confirmation de la fermeture à l’attention de l’utilisateur, et #connect#destroy pour appeler la fonction GMain.quit et quitter l’application.

Widgets enfants

Dernier point, et non des moindres : les fenêtres sont des widgets qui ne peuvent contenir qu’un seul widget enfant. Par conséquent, toute interface tant soit peu complexe devra faire appel à des boîtes (module GPack) dont nous parlerons dans le prochain billet.

GtkMessageDialog

Les fenêtres de type GtkMessageDialog servent à afficher un court message à l’attention de l’utilisateur. On s’en sert notamment pour demander confirmation avant de fermer l’application lorsque des modifications ont été apportées depuis le dernier enregistrement. Ces boîtes de dialogue permettent d’écrire des textes très lisibles grâce aux balises Pango (gras, italique, choix de la taille de la police, etc.).

GtkDialog

Boîte de dialogue de type GtkDialog

Les boîtes de dialogue de type GtkDialog sont souvent utilisées pour créer la page ‘Préférences’ dans une application. Ce sont des fenêtres composées dès l’origine d’une boîte verticale (méthode #vbox) dans laquelle il est possible de placer n’importe quelle combinaison de widgets. On ajoute des boutons (fermeture, annulation, validation, aide, etc.) avec les méthodes :

Les boutons sont insérés dans un widget de type GtkButtonBox accessible avec la méthode #action_area.

GtkAboutDialog

La boîte de dialogue GtkAboutDialog permet de créer simplement une boîte de dialogue de type « À propos… » pour votre application. Elle permet de décrire brièvement le logiciel. Voici quelques-unes des méthodes disponibles :

Comme vous pouvez le voir, cette boîte de dialogue a été conçue pour uniformiser les applications qui utilisent GTK, mais aussi et surtout pour accélérer le développement d’un nouveau logiciel.

Autres boîtes de dialogue

Il existe d’autres boîtes de dialogue plus spécialisées comme GtkColorSelectionDialog (sélection de couleur), GtkFontSelectionDialog (sélection de fonte) ou GtkFileChooserDialog (sélection de fichier). Plutôt qu’un long discours, je vous propose de les découvrir à travers un exemple de code. Il s’agit d’un éditeur de texte simpliste que vous pouvez tester avec la commande ocaml -w s -I +lablgtk2 lablgtk.cma test.ml. De plus, vous verrez que ces quelques boîtes de dialogue ressemblent beaucoup à ce que nous avons vu précédemment avec le module GButton.

module Aux =
  struct
    let load (text : GText.view) file =
      let ich = open_in file in
      let len = in_channel_length ich in
      let buf = Buffer.create len in
      Buffer.add_channel buf ich len;
      close_in ich;
      text#buffer#set_text (Buffer.contents buf)

    let save (text : GText.view) file =
      let och = open_out file in
      output_string och (text#buffer#get_text ());
      close_out och
  end

let _ = GMain.init ()

(* GtkWindow - Fenêtre principale. *)
let window =
  let wnd = GWindow.window 
    ~height:300 
    ~resizable:false
    ~position:`CENTER
    ~title:"GWindow Demo" () in
  wnd#connect#destroy GMain.quit;
  wnd

(* GtkMessageDialog - Court message à l'attention de l'utilisateur. *)
let confirm _ =
  let dlg = GWindow.message_dialog
    ~message:"<b><big>Voulez-vous vraiment quitter ?</big>\n\n\
      Attention :\nToutes les modifications seront perdues.</b>\n"
    ~parent:window
    ~destroy_with_parent:true
    ~use_markup:true
    ~message_type:`QUESTION
    ~position:`CENTER_ON_PARENT
    ~buttons:GWindow.Buttons.yes_no () in
  let res = dlg#run () = `NO in
  dlg#destroy ();
  res

let vbox = GPack.vbox 
  ~spacing:5
  ~border_width:5
  ~packing:window#add ()

let text =
  let scroll = GBin.scrolled_window
    ~hpolicy:`ALWAYS
    ~vpolicy:`ALWAYS
    ~shadow_type:`ETCHED_IN
    ~packing:vbox#add () in
  let txt = GText.view ~packing:scroll#add () in
  txt#misc#modify_font_by_name "Monospace 10";
  txt

let bbox = GPack.button_box `HORIZONTAL
  ~spacing:5
  ~layout:`SPREAD
  ~packing:(vbox#pack ~expand:false) ()

(* GtkFileChooserDialog - Boîte de dialogue d'ouverture et d'enregistrement. *)
let action_button stock event action =
  let dlg = GWindow.file_chooser_dialog
    ~action:`OPEN
    ~parent:window
    ~position:`CENTER_ON_PARENT
    ~destroy_with_parent:true () in
  dlg#add_button_stock `CANCEL `CANCEL;
  dlg#add_select_button_stock stock event;
  let btn = GButton.button ~stock ~packing:bbox#add () in
  GMisc.image ~stock ~packing:btn#set_image ();
  btn#connect#clicked (fun () ->
    if dlg#run () = `OPEN then Gaux.may action dlg#filename;
    dlg#misc#hide ());
  btn

let open_button = action_button `OPEN `OPEN (Aux.load text)
let save_button = action_button `SAVE `SAVE (Aux.save text)

(* GtkColorSelectionDialog - Sélection de couleur. *)
let color_picker =
  let dlg = GWindow.color_selection_dialog
    ~parent:window
    ~destroy_with_parent:true
    ~position:`CENTER_ON_PARENT () in
  dlg#ok_button#connect#clicked (fun () -> 
    text#misc#modify_base [`NORMAL, `COLOR dlg#colorsel#color]);
  let btn = GButton.button ~label:"Arrière-plan" ~packing:bbox#add () in
  GMisc.image ~stock:`COLOR_PICKER ~packing:btn#set_image ();
  btn#connect#clicked (fun () -> ignore (dlg#run ()); dlg#misc#hide ());
  btn

(* GtkFontSelectionDialog - Sélection de fonte. *)
let font_button =
  let dlg = GWindow.font_selection_dialog
    ~parent:window
    ~destroy_with_parent:true
    ~position:`CENTER_ON_PARENT () in
  dlg#ok_button#connect#clicked (fun () -> 
    text#misc#modify_font_by_name dlg#selection#font_name);
  let btn = GButton.button ~stock:`SELECT_FONT ~packing:bbox#add () in
  GMisc.image ~stock:`SELECT_FONT ~packing:btn#set_image ();
  btn#connect#clicked (fun () -> ignore (dlg#run ()); dlg#misc#hide ());
  btn

(* GtkAboutDialog - Boîte de dialogue "À propos..." *)
let about_button =
  let dlg = GWindow.about_dialog
    ~authors:["Cacophrene (<cacophrene AT gmail DOT com>)"]
    ~copyright:"Copyright © 2009-2010 Cacophrene"
    ~license:"GNU General Public License v3"
    ~version:"1.0"
    ~website:"http://blog.developpez.com/ocamlblog/"
    ~website_label:"OCamlBlog"
    ~position:`CENTER_ON_PARENT
    ~parent:window
    ~destroy_with_parent:true () in
  let btn = GButton.button ~stock:`ABOUT ~packing:bbox#add () in
  GMisc.image ~stock:`ABOUT ~packing:btn#set_image ();
  btn#connect#clicked (fun () -> ignore (dlg#run ()); dlg#misc#hide ());
  btn

let _ =
  window#event#connect#delete confirm;
  window#show ();
  GMain.main ()

Bonne année 2010 et à bientôt pour de nouvelles aventures caméliennes,
Cacophrène

Ce petit billet s’intercale insidieusement dans la série de billets consacrés à LablGTK suite à la demande d’un ami. Il s’agit de présenter une alternative au mot-clef lazy d’OCaml. Façon de dire : « alternative » est ici un bien grand mot. Nous allons juste survoler la question et voir qu’il est possible de simuler facilement un type de données paresseux avec des ingrédients classiques de la programmation fonctionnelle.

Principe

On veut simuler le comportement du module Lazy d’OCaml en n’utilisant que des traits classiques d’OCaml (c’est-à-dire sans faire appel à la magie noire). En particulier, on voudrait écrire une fonction force qui se comporte (presque) comme Lazy.force. En d’autres termes, forcer une suspension qui déclenche l’exception X la déclenche à chaque nouvel appel de force. De même, forcer une suspension déjà évaluée ne nécessite aucun calcul supplémentaire (mémoïsation). En revanche nous allons laisser tomber le cas des appels cycliques à force.

Pour y parvenir, nous allons utiliser :

• Un type somme pour représenter les états possibles de la suspension.
• Des références.
• Des fonctions.

Implémentation

Commençons par définir un type 'a state qui renseigne sur l’état (évalué ou non) d’une suspension :

type 'a state =
  | Maybe of (unit -> 'a)
  | Value of 'a 
  | Error of exn

Trois cas de figure sont envisageables :

• la suspension n’a pas été évaluée (Maybe),
• la suspension a été évaluée et un résultat a été obtenu (Value),
• l’évaluation de la suspension a déclenché une erreur (Error).

Comme nous souhaitons être en mesure de modifier l’état de notre suspension, nous avons besoin d’une référence. Nous définissons donc notre type « suspension » de la façon suivante :

type 'a lazy_val = 'a state ref

À partir de là, nous pouvons écrire une fonction qui renvoie une suspension à partir d’une fonction f et de l’argument x qu’elle reçoit en entrée :

let create f = ref (Maybe f)

Nous pouvons maintenant écrire une fonction qui force l’évaluation d’une suspension. Cette fonction doit :

• forcer l’évaluation si l’état est Maybe,
• renvoyer la valeur précédemment calculée si l’état est Value,
• lever l’exception précédemment levée si l’état est Error.

Nous écrivons donc :

let rec force t =
  match !t with
  | Value x -> x
  | Error x -> raise x
  | Maybe f -> t := (try Value (f ()) with x -> Error x);
    force t

Nous pouvons également écrire une fonction qui renvoie Some x si l’évaluation de la suspension a donné un résultat x, et None dans tous les autres cas (évaluation non effectuée ou levée d’exception) :

let may_get t =
  match !t with
  | Value x -> Some x
  | _ -> None

Enfin, nous pouvons écrire une fonction qui indique si l’évaluation d’une valeur paresseuse a déjà été forcée :

let is_value t =
  match !t with
  | Maybe _ -> false
  | _ -> true

Quelques exemples d’application

Arithmétique

Nous pouvons commencer par redéfinir les opérations usuelles telles que l’addition, la soustraction, la multiplication et la division :

let aux f x y = create (fun () -> f x y)
let ( ++ ) = aux ( + )
let ( -- ) = aux ( - )
let ( ** ) = aux ( * )
let ( // ) = aux ( / )

Un exemple d’application plutôt « tarte à la crème » :

Les listes paresseuses

Un ordinateur est incapable de manipuler directement une infinité de valeurs, pour la simple et bonne raison qu’il lui faudrait pour cela une mémoire infinie. En revanche, un ordinateur peut tout à fait manipuler des structures potentiellement infinies (l’adverbe change tout).

Voyons par exemple comment implémenter des listes potentiellement infinies en utilisant notre implémentation des structures paresseuses. D’abord, il faut définir un type pour nos listes. Ce sera :

type 'a t =
  | Empty 
  | Cell of 'a * 'a t lazy_val

Jusqu’ici, rien que de bien classique : une liste est vide (Empty) ou constituée d’un couple tête/queue (Cell). La seule originalité concerne ici la queue, qui est une suspension.

Initialisation

Maintenant que le type est fixé, nous pouvons écrire une fonction semblable à Array.init :

let init f =
  let rec loop i () =
    Cell (f i, create (loop (i + 1)))
  in loop 0 ()

Il est alors très facile de créer la liste des entiers naturels :

let integers = init (fun i -> i)

Tête et queue de liste

Continuons sur notre lancée et écrivons deux fonctions hd et tl qui renvoient respectivement la tête et la queue d’une liste paresseuse. Comme leur équivalent du module List, ces fonctions lèvent l’exception Invalid_argument lorsqu’elles reçoivent une liste vide en entrée :

let hd = function
  | Empty -> invalid_arg "hd"
  | Cell (x, _) -> x

let tl = function
  | Empty -> invalid_arg "tl"
  | Cell (_, x) -> force x

Conversion en liste standard

La fonction take reçoit un entrée une liste paresseuse t et un entier n. Elle renvoie les n premiers éléments de t stockés dans une liste standard. S’il y a moins de n éléments disponibles, tous les éléments restants sont renvoyés.

let take n t =
  if n < 0 then invalid_arg "take";
  let rec loop n = function
    | Empty -> []
    | Cell (x, t) -> if n = 0 then []
      else x :: loop (n - 1) (force t)
  in loop n t

Filtrage des éléments

Voici maintenant une fonction de filtrage des éléments d’une liste paresseuse. Cette fonction reçoit un entrée un prédicat p et une liste paresseuse t. Elle renvoie la sous-liste constituée des éléments de t qui satisfont le prédicat p.

let rec filter f = function
  | Empty -> Empty
  | Cell (x, t) -> let g () = filter f (force t) in
    if f x then Cell (x, create g) else g ()

Itérateurs

La fonction map reçoit une fonction f et une liste paresseuse t en entrée et renvoie la liste paresseuse [f(t₀); f(t₁); … f(t_n)].

let rec map f = function
  | Empty -> Empty
  | Cell (x, t) -> let g () = map f (force t) in
    Cell (f x, create g)

On peut également écrire un itérateur map2 qui manipule deux listes paresseuses supposées de même longueur. Cette fonction est l’équivalent de la fonction zipWith d’Haskell.

let rec map2 f x y =
  match x, y with
  | Empty, Empty -> Empty
  | Cell (x, t1), Cell (y, t2) -> let g () = map2 f (force t1) (force t2) in
    Cell (f x y, create g)
  | _ -> invalid_arg "map2"

Longueur de liste

On peut aussi écrire une fonction length qui renvoie, non pas la longueur réelle de la liste (cela n’a aucun sens puisqu’on manipule une liste potentiellement infinie), mais le nombre de suspensions déjà évaluées. Cela donne quelque chose comme ceci :

let length x =
  let rec loop n = function
    | Empty -> n
    | Cell (_, t) -> match may_get t with
      | Some t -> loop (n + 1) t
      | _ -> n
  in loop 0 x

Liste des entiers impairs

Les entiers naturels impairs possèdent la propriété suivante : leur écriture binaire contient toujours un bit de poids faible égal à 1. On peut donc écrire une fonction odd en utilisant l’opérateur bit-à-bit land (on pouvait aussi se servir du modulo pour ne pas se compliquer la vie…), puis extraire de la liste des entiers naturels la liste des entiers impairs :

let odd x = x land 1 = 1 
let odd_list = filter odd integers

Liste des puissances de 2

Dans le même genre, on peut construire la liste des puissances de 2. Il s’agit pour le coup d’une version très inefficace (dans l’interpréteur, mon ordinateur met 26 s pour calculer les 25 premières puissances de 2).

let two x = x > 0 && x land (x - 1) = 0
let two_list = filter two integers

Liste des nombres de Fibonacci

L’évaluation retardée permet également de construire la liste des nombres de Fibonacci (cf. la notion associée de corécursion). L’idée est simple : on fournit les deux cas de base (ici 0 et 1, mais certains commencent avec 1 et 1) puis on indique que la construction des éléments suivants s’effectue en appliquant la formule F_{n + 1} = F_n + F_{n – 1}. J’utilise la bibliothèque Num car les termes de la suite de Fibonacci sont rapidement grands.

open Num

let fib =
  let rec aux a b =
    Cell (a, create (fun () -> aux b (a +/ b)))
  in aux (Int 0) (Int 1)

Exemple : take 10 fib = [Int 0; Int 1; Int 1; Int 2; Int 3; Int 5; Int 8; Int 13; Int 21; Int 34]. Voici une autre version moins efficace (dans cet exemple, aux pourrait ne pas être une fonction, mais les restrictions imposées par OCaml en matière de récursion du fait de son mode d’évaluation strict obligent à procéder de la sorte) :

let fib =
  let rec aux () =
    Cell (Int 0, create (fun () -> 
      Cell (Int 1, create (fun () ->
        let x = aux () in
        map2 (+/) x (tl x)
  )))) in aux ()

Bibliographie

• Principe de l’évaluation retardée (en anglais)
• L’évaluation retardée avec Haskell (en anglais)
• Les 1001 premiers termes de la suite de Fibonacci (attention, initialisation avec 1 et 1).
• La suite de Fibonacci et évaluation retardée avec Clojure (en anglais)

À bientôt,
Cacophrène

Ce billet est le premier d’une longue série consacrée à LablGTK et, plus particulièrement, à la présentation détaillée des modules qui la constituent. Beaucoup de questions sur le forum caml de developpez.com plaident en faveur de cette idée. Il est vrai que la bibliothèque comporte plusieurs de 20 modules d’utilisation courante… ce qui n’est pas toujours évident au premier abord. Dans ce billet, nous allons commencer par quelque chose de simple : le module GButton.

Le module GButton définit des widgets cliquables communément appelés boutons. Ce sont des boutons simples (GtkButton), des bouton à bascule (GtkToggleButton), des cases à cocher (GtkCheckButton) ou des choix multiples (GtkRadioButton). On y trouve également des versions spécialisées dans la sélection d’une fonte (GtkFontButton) ou d’une couleur (GtkColorButton), ou encore la définition de liens cliquables (GtkLinkButton). Enfin, c’est avec ce module que l’on peut définir des barres d’outils (GtkToolbar).

Les boutons simples (GtkButton)
Les boutons simples sont principalement utilisés pour répondre à un clic de l’utilisateur (#connect#clicked). Ils possèdent un seul état et se retrouvent surtout dans les boîtes de dialogue sous la forme de boutons OK, Appliquer ou Annuler. Un bouton simple peut contenir une icône prédéfinie (module GtkStock) ou issue de n’importe quel widget (#set_image).

Les boutons à bascule (GtkToggleButton)
Les boutons à bascule sont des boutons à deux états (état enfoncé et état relâché). Leur état peut être déterminé avec #active (true quand le bouton est enfoncé). Pour les applications partielles, on utilisera quelque chose comme ceci :

Les cases à cocher (GtkCheckButton)
Les cases à cocher permettent de sélectionner des options qui ne sont pas exclusives. En d’autres termes, plusieurs choix peuvent être sélectionnés simultanément. La fonction GButton.check_button qui permet de les créer renvoie un widget de type toggle_button. En d’autres termes, les cases à cocher sont des boutons à bascule dont l’apparence a été modifiée. Pour le programmeur, la manipulation est exactement la même que pour les boutons à bascule.

Les choix multiples (GtkRadioButton)
Les choix multiples obligent l’utilisateur à faire un choix parmi un ensemble de cas exclusifs. En d’autres termes, lorsqu’un nouveau choix est effectué, le choix précédent est automatiquement désélectionné. Pour assurer ce comportement, il ne faut pas oublier de définir le paramètre group pour relier les différents choix. Voici un exemple :

Sélection de fonte (GtkFontButton)
Ce bouton permet de choisir une police de caractères. L’événement associé est #connect#font_set, qui est déclenché chaque fois qu’une fonte est sélectionnée par l’utilisateur. La fonte peut être récupérée grâce à #font_name. Il s’agit d’une chaîne de caractères que l’on peut convertir dans un type plus adapté (Pango.font_description) avec la fonction Pango.Font.from_string. On a alors accès à de nombreuses infos telles que la taille, la famille, l’épaisseur…

Sélection de couleur (GtkColorButton)
Ce bouton permet de choisir une couleur. L’événement associé est #connect#color_set. La couleur est obtenue avec #color et renvoyée au format Gdk.color. On récupère les composantes rouge, verte et bleue d’une couleur au format Gdk.color avec les fonctions Gdk.Color.red, Gdk.Color.green et Gdk.Color.blue. Attention : les composantes sont sur 16 bits. Ne cherchez pas à reprogrammer ce bouton vous-mêmes, car ce serait long et inutile. Le bouton de sélection de couleur est vraiment bien conçu !

Lien cliquable (GtkLinkButton)
Ce bouton permet de définir un lien (par exemple vers une page web) auquel on peut accéder par simple clic. On le retrouve notamment dans la boîte de dialogue « À propos… » (GtkAboutDialog). Son utilisation est très simple :

let link = GButton.link_button "http://www.google.fr/" ~label:"Google France" ()

Barres d’outils (GtkToolbar)
Les barres d’outils sont utilisées pour grouper plusieurs boutons sur une petite zone de l’interface. Elles ont une orientation (verticale ou horizontale) et un style (icône seule (`ICONS), texte seul (`TEXT), icône et texte en dessous (`BOTH) ou icône et texte à côté (`BOTH_HORIZ)).

Les éléments d’une barre d’outils sont des widgets appelés toolitems. On retrouve la plupart des catégories de boutons :

• Des séparateurs : GtkSeparatorToolItem
• Des boutons simples : GtkToolButton
• Des boutons à bascule : GtkToggleToolButton
• Des choix multiples : GtkRadioToolButton
• Des boutons avec menu déroulant : GtkMenuToolButton

Mais ce n’est pas tout ! En fait, on peut insérer à peu près n’importe quel widget dans une barre d’outils à condition de l’empaqueter au préalable dans l’unité de base des barres d’outils : le GtkToolItem.

C’est tout pour aujourd’hui. Dans un prochain billet, nous aborderons un module de grande importance : GWindow.

À bientôt,
Cacophrène