Blame examples_labltk/taquin.ml

Packit bd2e5d
(***********************************************************************)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*                 MLTk, Tcl/Tk interface of OCaml                     *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
Packit bd2e5d
(*               projet Cristal, INRIA Rocquencourt                    *)
Packit bd2e5d
(*            Jacques Garrigue, Kyoto University RIMS                  *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
Packit bd2e5d
(*  en Automatique and Kyoto University.  All rights reserved.         *)
Packit bd2e5d
(*  This file is distributed under the terms of the GNU Library        *)
Packit bd2e5d
(*  General Public License, with the special exception on linking      *)
Packit bd2e5d
(*  described in file LICENSE found in the OCaml source tree.          *)
Packit bd2e5d
(*                                                                     *)
Packit bd2e5d
(***********************************************************************)
Packit bd2e5d
Packit bd2e5d
(* $Id$ *)
Packit bd2e5d
Packit bd2e5d
open Tk;;
Packit bd2e5d
Packit bd2e5d
let découpe_image img nx ny =
Packit bd2e5d
  let l = Imagephoto.width img
Packit bd2e5d
  and h = Imagephoto.height img in
Packit bd2e5d
  let tx = l / nx and ty = h / ny in
Packit bd2e5d
  let pièces = ref [] in
Packit bd2e5d
  for x = 0 to nx - 1 do
Packit bd2e5d
    for y = 0 to ny - 1 do
Packit bd2e5d
      let pièce = Imagephoto.create ~width:tx ~height:ty () in
Packit bd2e5d
      Imagephoto.copy ~src:img
Packit bd2e5d
        ~src_area:(x * tx, y * ty, (x + 1) * tx, (y + 1) * ty) pièce;
Packit bd2e5d
      pièces := pièce :: !pièces
Packit bd2e5d
    done
Packit bd2e5d
  done;
Packit bd2e5d
  (tx, ty, List.tl !pièces);;
Packit bd2e5d
Packit bd2e5d
let remplir_taquin c nx ny tx ty pièces =
Packit bd2e5d
  let trou_x = ref (nx - 1)
Packit bd2e5d
  and trou_y = ref (ny - 1) in
Packit bd2e5d
  let trou =
Packit bd2e5d
    Canvas.create_rectangle
Packit bd2e5d
      ~x1:(!trou_x * tx) ~y1:(!trou_y * ty) ~x2:tx ~y2:ty c in
Packit bd2e5d
  let taquin = Array.make_matrix nx ny trou in
Packit bd2e5d
  let p = ref pièces in
Packit bd2e5d
  for x = 0 to nx - 1 do
Packit bd2e5d
    for y = 0 to ny - 1 do
Packit bd2e5d
      match !p with
Packit bd2e5d
      | [] -> ()
Packit bd2e5d
      | pièce :: reste ->
Packit bd2e5d
          taquin.(x).(y) <-
Packit bd2e5d
            Canvas.create_image
Packit bd2e5d
                ~x:(x * tx) ~y:(y * ty)
Packit bd2e5d
                ~image:pièce ~anchor:`Nw ~tags:["pièce"] c;
Packit bd2e5d
          p := reste
Packit bd2e5d
    done
Packit bd2e5d
  done;
Packit bd2e5d
  let déplacer x y =
Packit bd2e5d
    let pièce = taquin.(x).(y) in
Packit bd2e5d
    Canvas.coords_set c pièce
Packit bd2e5d
      ~xys:[!trou_x * tx, !trou_y * ty];
Packit bd2e5d
    Canvas.coords_set c trou
Packit bd2e5d
      ~xys:[x * tx, y * ty; tx, ty];
Packit bd2e5d
    taquin.(!trou_x).(!trou_y) <- pièce;
Packit bd2e5d
    taquin.(x).(y) <- trou;
Packit bd2e5d
    trou_x := x; trou_y := y in
Packit bd2e5d
  let jouer ei =
Packit bd2e5d
    let x = ei.ev_MouseX / tx and y = ei.ev_MouseY / ty in
Packit bd2e5d
    if x = !trou_x && (y = !trou_y - 1 || y = !trou_y + 1)
Packit bd2e5d
    || y = !trou_y && (x = !trou_x - 1 || x = !trou_x + 1)
Packit bd2e5d
    then déplacer x y in
Packit bd2e5d
  Canvas.bind ~events:[`ButtonPress]
Packit bd2e5d
                 ~fields:[`MouseX; `MouseY] ~action:jouer c (`Tag "pièce");;
Packit bd2e5d
Packit bd2e5d
let rec permutation = function
Packit bd2e5d
  | [] -> []
Packit bd2e5d
  | l  -> let n = Random.int (List.length l) in
Packit bd2e5d
          let (élément, reste) = partage l n in
Packit bd2e5d
          élément :: permutation reste
Packit bd2e5d
Packit bd2e5d
and partage l n =
Packit bd2e5d
  match l with
Packit bd2e5d
  | [] -> failwith "partage"
Packit bd2e5d
  | tête :: reste ->
Packit bd2e5d
      if n = 0 then (tête, reste) else
Packit bd2e5d
        let (élément, reste') = partage reste (n - 1) in
Packit bd2e5d
        (élément, tête :: reste');;
Packit bd2e5d
Packit bd2e5d
let create_filled_text parent lines =
Packit bd2e5d
  let lnum = List.length lines
Packit bd2e5d
  and lwidth =
Packit bd2e5d
    List.fold_right
Packit bd2e5d
     (fun line max ->
Packit bd2e5d
       let l = String.length line in
Packit bd2e5d
       if l > max then l else max)
Packit bd2e5d
     lines 1 in
Packit bd2e5d
  let txtw = Text.create ~width:lwidth ~height:lnum parent in
Packit bd2e5d
  List.iter
Packit bd2e5d
   (fun line ->
Packit bd2e5d
        Text.insert ~index:(`End, []) ~text:line txtw;
Packit bd2e5d
        Text.insert ~index:(`End, []) ~text:"\n" txtw)
Packit bd2e5d
   lines;
Packit bd2e5d
  txtw;;
Packit bd2e5d
Packit bd2e5d
let give_help parent lines () =
Packit bd2e5d
 let help_window = Toplevel.create parent in
Packit bd2e5d
 Wm.title_set help_window "Help";
Packit bd2e5d
Packit bd2e5d
 let help_frame = Frame.create help_window in
Packit bd2e5d
Packit bd2e5d
 let help_txtw = create_filled_text help_frame lines in
Packit bd2e5d
Packit bd2e5d
 let quit_help () = destroy help_window in
Packit bd2e5d
 let ok_button = Button.create ~text:"Ok" ~command:quit_help help_frame in
Packit bd2e5d
Packit bd2e5d
 pack ~side:`Bottom [help_txtw];
Packit bd2e5d
 pack ~side:`Bottom [ok_button ];
Packit bd2e5d
 pack [help_frame];;
Packit bd2e5d
Packit bd2e5d
let taquin nom_fichier nx ny =
Packit bd2e5d
  let fp = openTk () in
Packit bd2e5d
  Wm.title_set fp "Taquin";
Packit bd2e5d
  let img = Imagephoto.create ~file:nom_fichier () in
Packit bd2e5d
  let c =
Packit bd2e5d
    Canvas.create ~background:`Black
Packit bd2e5d
     ~width:(Imagephoto.width img)
Packit bd2e5d
     ~height:(Imagephoto.height img) fp in
Packit bd2e5d
  let (tx, ty, pièces) = découpe_image img nx ny in
Packit bd2e5d
  remplir_taquin c nx ny tx ty (permutation pièces);
Packit bd2e5d
  pack [c];
Packit bd2e5d
Packit bd2e5d
  let quit = Button.create ~text:"Quit" ~command:closeTk fp in
Packit bd2e5d
  let help_lines =
Packit bd2e5d
   ["Pour jouer, cliquer sur une des pièces";
Packit bd2e5d
    "entourant le trou";
Packit bd2e5d
    "";
Packit bd2e5d
    "To play, click on a part around the hole"] in
Packit bd2e5d
  let help =
Packit bd2e5d
    Button.create ~text:"Help" ~command:(give_help fp help_lines) fp in
Packit bd2e5d
  pack ~side:`Left ~fill:`X [quit] ;
Packit bd2e5d
  pack ~side:`Left ~fill:`X [help] ;
Packit bd2e5d
  mainLoop ();;
Packit bd2e5d
Packit bd2e5d
if !Sys.interactive then () else
Packit bd2e5d
begin taquin "Lambda2.back.gif" 4 4; exit 0 end;;