|
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;;
|