1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* only by permission. *)
(* *)
(***********************************************************************)
open Camltk;;
let dcoupe_image img nx ny =
let l = Imagephoto.width img
and h = Imagephoto.height img in
let tx = l / nx and ty = h / ny in
let pices = ref [] in
for x = 0 to nx - 1 do
for y = 0 to ny - 1 do
let pice =
Imagephoto.create [Width (Pixels tx); Height (Pixels ty)] in
Imagephoto.copy pice img
[ImgFrom(x * tx, y * ty, (x + 1) * tx, (y + 1) * ty)];
pices := pice :: !pices
done
done;
(tx, ty, List.tl !pices);;
let remplir_taquin c nx ny tx ty pices =
let trou_x = ref (nx - 1)
and trou_y = ref (ny - 1) in
let trou =
Canvas.create_rectangle c
(Pixels (!trou_x * tx)) (Pixels (!trou_y * ty))
(Pixels tx) (Pixels ty) [] in
let taquin = Array.make_matrix nx ny trou in
let p = ref pices in
for x = 0 to nx - 1 do
for y = 0 to ny - 1 do
match !p with
| [] -> ()
| pice :: reste ->
taquin.(x).(y) <-
Canvas.create_image c
(Pixels (x * tx)) (Pixels (y * ty))
[ImagePhoto pice; Anchor NW; Tags [Tag "pice"]];
p := reste
done
done;
let dplacer x y =
let pice = taquin.(x).(y) in
Canvas.coords_set c pice
[Pixels (!trou_x * tx); Pixels(!trou_y * ty)];
Canvas.coords_set c trou
[Pixels (x * tx); Pixels(y * ty); Pixels tx; Pixels ty];
taquin.(!trou_x).(!trou_y) <- pice;
taquin.(x).(y) <- trou;
trou_x := x; trou_y := y in
let jouer ei =
let x = ei.ev_MouseX / tx and y = ei.ev_MouseY / ty in
if x = !trou_x && (y = !trou_y - 1 || y = !trou_y + 1)
|| y = !trou_y && (x = !trou_x - 1 || x = !trou_x + 1)
then dplacer x y in
Canvas.bind c (Tag "pice") [[], ButtonPress]
(BindSet ([Ev_MouseX; Ev_MouseY], jouer));;
let rec permutation = function
| [] -> []
| l -> let n = Random.int (List.length l) in
let (lment, reste) = partage l n in
lment :: permutation reste
and partage l n =
match l with
| [] -> failwith "partage"
| tte :: reste ->
if n = 0 then (tte, reste) else
let (lment, reste') = partage reste (n - 1) in
(lment, tte :: reste');;
let create_filled_text parent lines =
let lnum = List.length lines
and lwidth =
List.fold_right
(fun line max ->
let l = String.length line in
if l > max then l else max)
lines 1 in
let txtw = Text.create parent [TextWidth lwidth; TextHeight lnum] in
List.iter
(fun line ->
Text.insert txtw (TextIndex (End, [])) line [];
Text.insert txtw (TextIndex (End, [])) "\n" [])
lines;
txtw;;
let give_help parent lines () =
let help_window = Toplevel.create parent [] in
Wm.title_set help_window "Help";
let help_frame = Frame.create help_window [] in
let help_txtw = create_filled_text help_frame lines in
let quit_help () = destroy help_window in
let ok_button = Button.create help_frame [Text "Ok"; Command quit_help] in
pack [help_txtw; ok_button ] [Side Side_Bottom];
pack [help_frame] [];;
let taquin nom_fichier nx ny =
let fp = openTk () in
Wm.title_set fp "Taquin";
let img = Imagephoto.create [File nom_fichier] in
let c =
Canvas.create fp
[Width(Pixels(Imagephoto.width img));
Height(Pixels(Imagephoto.height img))] in
let (tx, ty, pices) = dcoupe_image img nx ny in
remplir_taquin c nx ny tx ty (permutation pices);
pack [c] [];
let quit = Button.create fp [Text "Quit"; Command closeTk] in
let help_lines =
["Pour jouer, cliquer sur une des pices";
"entourant le trou";
"";
"To play, click on a part around the hole"] in
let help =
Button.create fp [Text "Help"; Command (give_help fp help_lines)] in
pack [quit; help] [Side Side_Left; Fill Fill_X];
mainLoop ();;
if !Sys.interactive then () else begin taquin "joconde.gif" 3 5; exit 0 end;;
|
