← Back to branch summary

~ubuntu-branches/ubuntu/hardy/ocaml-doc/hardy

« back to all changes in this revision

Viewing changes to examples/camltk/taquin.ml

  • Committer: Bazaar Package Importer
  • Author(s): Samuel Mimram
  • Date: 2007-09-08 01:49:22 UTC
  • mfrom: (0.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070908014922-lvihyehz0ndq7suu
Tags: 3.10-1
* New upstream release.
* Removed camlp4 documentation since it is not up-to-date.
* Updated to standards version 3.7.2, no changes needed.
* Updated my email address.

Show diffs side-by-side

added added

removed removed

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