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

open Graphics;;

let taille_pièce = 30;;

let grey = rgb 175 175 175;;

let draw_rect x y w h = draw_rect x (y+1) w h;;

let dessiner_pièce0 (x, y) fond =
  if fond
  then set_color white
  else set_color grey;
  fill_rect x y taille_pièce taille_pièce;
  set_color foreground;
  draw_rect x y taille_pièce taille_pièce;;

let dessiner_rectangle_bord_arrondi x y w h arrondi =
  draw_poly
    [|(x,y+arrondi); (x,y+h-arrondi); (x+arrondi,y+h);
     (x+w-arrondi,y+h); (x+w,y+h-arrondi); (x+w,y+arrondi);
     (x+w-arrondi,y); (x+arrondi,y)|];;

let dessiner_pièce1 (x, y) fond =
  dessiner_pièce0 (x, y) fond;
  let bord = 5 (* écartement du bord du carré central *)
  and arrondi = 2 (* dimension du pan coupé *) in
    dessiner_rectangle_bord_arrondi
      (x+bord) (y+bord)
      (taille_pièce-2*bord) (taille_pièce-2*bord) arrondi;;

let dessiner_pièce2ou3 (x, y) fond orientation =
  dessiner_pièce0 (x, y) fond;
  let bord = 4 (* écartement du bord du carré central *)
  and espace = 6 (* espace entre les deux rectangles *)
  and arrondi = 1 in
  (* dimension du carré interne dans lequel s'inscrivent
     les deux rectangles *)

  let
 dim_interne = taille_pièce-2*bord in
  let
 (w, h) = (* largeur et hauteur des deux rectangles *)
    if orientation
    then (dim_interne, (dim_interne-espace)/2)
    else ((dim_interne-espace)/2, dim_interne) in
  dessiner_rectangle_bord_arrondi
    (x+bord) (y+bord) w h arrondi;
  if orientation
  then dessiner_rectangle_bord_arrondi
         (x+bord) (y+bord+h+espace) w h arrondi
  else dessiner_rectangle_bord_arrondi
         (x+bord+w+espace) (y+bord) w h arrondi;;

let dessiner_pièce6 (x, y) fond =
  dessiner_pièce0 (x, y) fond;
  let bord = 5 (* écartement du bord des carrés centraux *)
  and espace = 6 (* espace entre les carrés centraux *)
  and arrondi = 1 in
  (* côté des carrés centraux *)
  let
 w = (taille_pièce-2*bord-espace)/2 in
    dessiner_rectangle_bord_arrondi
      (x+bord) (y+bord) w w arrondi;
    dessiner_rectangle_bord_arrondi
      (x+bord+w+espace) (y+bord) w w arrondi;
    dessiner_rectangle_bord_arrondi
      (x+bord) (y+bord+w+espace) w w arrondi;
    dessiner_rectangle_bord_arrondi
      (x+bord+w+espace) (y+bord+w+espace) w w arrondi;;

let dessiner_pièce4ou5 (x, y) fond orientation =
  dessiner_pièce0 (x, y) fond;
  let bord = 5
  and espace = 4 in
  if orientation
  then
    begin
    draw_poly
      [|(x+bord,y+taille_pièce-bord);
        (x+taille_pièce-bord-espace,y+taille_pièce-bord);
        (x+bord,y+bord+espace)|];
    draw_poly
      [|(x+bord+espace,y+bord);
        (x+taille_pièce-bord,y+bord);
        (x+taille_pièce-bord,y+taille_pièce-bord-espace)|]
    end
  else
    begin

    draw_poly
      [|(x+bord+espace,y+taille_pièce-bord);
        (x+taille_pièce-bord,y+taille_pièce-bord);
        (x+taille_pièce-bord,y+bord+espace)|];
    draw_poly
      [|(x+bord,y+bord);
        (x+taille_pièce-bord-espace,y+bord);
        (x+bord,y+taille_pièce-bord-espace)|]
    end;;

let dessiner_pièce7 (x, y) fond =
  dessiner_pièce0 (x, y) fond;
  let bord = 4
  and espace = 4 in
  draw_poly
    [|(x+bord,y+bord+espace);
      (x+taille_pièce/2-espace,y+taille_pièce/2);
      (x+bord,y+taille_pièce-bord-espace)|];
  draw_poly
    [|(x+taille_pièce-bord,y+bord+espace);
      (x+taille_pièce/2+espace,y+taille_pièce/2);
      (x+taille_pièce-bord,y+taille_pièce-bord-espace)|];
  draw_poly
    [|(x+bord+espace,y+bord);
      (x+taille_pièce/2,y+taille_pièce/2-espace);
      (x+taille_pièce-bord-espace,y+bord)|];
  draw_poly
    [|(x+bord+espace,y+taille_pièce-bord);
      (x+taille_pièce/2,y+taille_pièce/2+espace);
      (x+taille_pièce-bord-espace,y+taille_pièce-bord)|];;

let dessiner_pièce (x, y) numéro =
  match numéro/2 with
  | 0 -> dessiner_pièce0 (x, y) (numéro mod 2 = 0)
  | 1 -> dessiner_pièce1 (x, y) (numéro mod 2 = 0)
  | 2 -> dessiner_pièce2ou3 (x, y) (numéro mod 2 = 0) true
  | 3 -> dessiner_pièce2ou3 (x, y) (numéro mod 2 = 0) false
  | 4 -> dessiner_pièce4ou5 (x, y) (numéro mod 2 = 0) true
  | 5 -> dessiner_pièce4ou5 (x, y) (numéro mod 2 = 0) false
  | 6 -> dessiner_pièce6 (x, y) (numéro mod 2 = 0)
  | 7 -> dessiner_pièce7 (x, y) (numéro mod 2 = 0)
  | _ -> ();;

let dessiner_sélection (x,y) =
  set_line_width 3;
  draw_rect x y taille_pièce taille_pièce;
  set_line_width 1;;

let dessiner_désélection (x,y) =
  set_color background;
  set_line_width 3;
  draw_rect x y taille_pièce taille_pièce;
  set_line_width 1;
  set_color foreground;
  draw_rect x y taille_pièce taille_pièce;;

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