(* ===================================================== *)
(*      Apprentissage de la programmation avec OCaml     *)
(*      Catherine Dubois & Valérie Ménissier-Morain      *)
(*                Éditions Hermès Sciences               *)
(*                        Mars 2004                      *)
(* ===================================================== *)
(* Fichier MLSRC/CC/CC_ameliorations/saisie.ml           *)
(* ===================================================== *)

open Graphics;;
open Affichage_jeu;;

let effacer_caractère s i =
  let (cx, cy) = current_point () in
  let
 (w, h) = text_size (String.sub s i 1) in
  set_color background;
  fill_rect (cx-w) cy w h;
  rmoveto (-w) 0;
  set_color foreground;;

let read_limited_string len =
  let s = String.make len '#' in
  let
 i = ref 0 in
  let
 c = ref (read_key ()) in
  while !c <> '\r' && !i < len do
    if
 !c = '\b'
    then
      begin
        if
 !i > 0
        then (i := !i-1; effacer_caractère s !i)
        else sound 100 100;
      end
    else
      begin

        s.[!i] <- !c;
        draw_char !c;
        i := !i+1
      end;
    c := read_key ();
  done;
  String.sub s 0 !i;;

let lecture_boîte s police_texte l police_lecture =
  set_font police_texte;
  let (w, h) = text_size s in
  set_font police_lecture;
  let (w1, hc) = text_size "M" in
  let
 wl = l*w1 in
  let
 lw = (size_x() - (w+wl))/2 in
  moveto lw (size_y()/2-h/2);
  set_font police_texte;
  draw_string s;
  let (cx, cy) = current_point () in
  draw_rect (cx+w1) (cy-hc/2) (wl+2*w1) (2*hc);
  rmoveto (2*w1) 0;
  set_font police_lecture;
  read_limited_string l;;

let lecture_nom () =
  clear_graph ();
  set_font "-*-helvetica-bold-r-normal--18-*";
  set_color foreground;
  écrire_centré_fenêtre (size_y()*4/5) "BRAVO";
  set_font "-*-helvetica-bold-r-normal--18-*";
  écrire_centré_fenêtre (size_y()*2/3)
    "Vous faites partie des dix meilleurs scores";
  let nom =
    lecture_boîte
      ("Entrez votre nom? ("^(Sys.getenv "USER")^") :")
      "-*-helvetica-bold-r-normal--18-*" 20
      "-adobe-courier-medium-r-normal--18-*" in
  if nom = "" then Sys.getenv "USER" else nom;;

Ce document a été traduit de LATEX par HEVEA.