(***********************************************************************) (* *) (* 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 découpe_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 pièces = ref [] in for x = 0 to nx - 1 do for y = 0 to ny - 1 do let pièce = Imagephoto.create [Width (Pixels tx); Height (Pixels ty)] in Imagephoto.copy pièce img [ImgFrom(x * tx, y * ty, (x + 1) * tx, (y + 1) * ty)]; pièces := pièce :: !pièces done done; (tx, ty, List.tl !pièces);; let remplir_taquin c nx ny tx ty pièces = 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 pièces in for x = 0 to nx - 1 do for y = 0 to ny - 1 do match !p with | [] -> () | pièce :: reste -> taquin.(x).(y) <- Canvas.create_image c (Pixels (x * tx)) (Pixels (y * ty)) [ImagePhoto pièce; Anchor NW; Tags [Tag "pièce"]]; p := reste done done; let déplacer x y = let pièce = taquin.(x).(y) in Canvas.coords_set c pièce [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) <- pièce; 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 déplacer x y in Canvas.bind c (Tag "pièce") [[], ButtonPress] (BindSet ([Ev_MouseX; Ev_MouseY], jouer));; let rec permutation = function | [] -> [] | l -> let n = Random.int (List.length l) in let (élément, reste) = partage l n in élément :: permutation reste and partage l n = match l with | [] -> failwith "partage" | tête :: reste -> if n = 0 then (tête, reste) else let (élément, reste') = partage reste (n - 1) in (élément, tête :: 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, pièces) = découpe_image img nx ny in remplir_taquin c nx ny tx ty (permutation pièces); pack [c] []; let quit = Button.create fp [Text "Quit"; Command closeTk] in let help_lines = ["Pour jouer, cliquer sur une des pièces"; "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;;