]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/fifteen.ml
"Final" commit that patches termViewer while still enabling XML Diffing.
[helm.git] / helm / DEVEL / lablgtk / lablgtk_20000829-0.1.0 / examples / fifteen.ml
1 (* $Id$ *)
2
3 open Gaux
4 open Gtk
5 open GObj
6 open GMain
7
8 class position ~init_x ~init_y ~min_x ~min_y ~max_x ~max_y = object
9   val mutable x = init_x
10   val mutable y = init_y
11   method current = (x, y)
12   method up ()    = if y > min_y then y <- y-1 else (); (x, y)
13   method down ()  = if y < max_y then y <- y+1 else (); (x, y)
14   method left ()  = if x > min_x then x <- x-1 else (); (x, y)
15   method right () = if x < max_x then x <- x+1 else (); (x, y)
16 end
17
18 let game_init () = (* generate initial puzzle state *)
19   let rec game_aux acc rest n_invert =
20     let len = List.length rest in
21     if len=0 then
22       if n_invert mod 2 = 0 then
23         acc (* to be solvable, n_invert must be even *)
24       else
25         (List.hd (List.tl acc))::(List.hd acc)::(List.tl (List.tl acc))
26     else begin
27       let rec extract n xs =
28         if (n=0) then (List.hd xs, List.tl xs)
29         else
30           let (ans, ys) = extract (n-1) (List.tl xs) in
31           (ans, List.hd xs :: ys) in
32       let ran = Random.int len in
33       let (elm, rest1) = extract ran rest in
34       let rec count p xs = match xs with
35         [] -> 0
36       | y :: ys -> let acc = count p ys in
37                  if p y then 1+acc else acc
38       in
39       let new_n_invert = count (fun x -> elm > x) acc in
40       game_aux (elm :: acc) rest1 (n_invert+new_n_invert)
41     end in
42   let rec from n = if n=0 then [] else n :: from (n-1) in
43   game_aux [] (from 15) 0
44       
45 let _ = Random.init (int_of_float (Sys.time () *. 1000.))
46 let window = GWindow.window ()
47 let _ = window#connect#destroy ~callback:GMain.Main.quit
48
49 let tbl = GPack.table ~rows:4 ~columns:4 ~homogeneous:true ~packing:window#add ()
50 let dummy = GMisc.label ~text:"" ~packing:(tbl#attach ~left:3 ~top:3) ()
51 let arr = Array.create_matrix ~dimx:4 ~dimy:4 dummy
52 let init = game_init ()
53 let _ =
54   for i = 0 to 15 do
55     let j = i mod 4  in
56     let k = i/4 in
57     let frame =
58       GBin.frame ~shadow_type:`OUT ~width:32 ~height:32
59         ~packing:(tbl#attach ~left:j ~top:k) () in
60     if i < 15 then
61       arr.(j).(k) <-
62         GMisc.label ~text:(string_of_int (List.nth init i))
63           ~packing:frame#add ()
64   done
65 let pos = new position ~init_x:3 ~init_y:3 ~min_x:0 ~min_y:0 ~max_x:3 ~max_y:3
66     
67 open GdkKeysyms
68
69 let _ =
70   window#event#connect#key_press ~callback:
71     begin fun ev ->
72       let (x0, y0) = pos#current in
73       let wid0 = arr.(x0).(y0) in
74       let key = GdkEvent.Key.keyval ev in
75       if key = _q || key = _Escape then (Main.quit (); exit 0) else
76       let (x1, y1) =
77         if key = _h || key = _Left then 
78           pos#right ()
79         else if key = _j || key = _Down then
80           pos#up ()
81         else if key = _k || key = _Up then
82           pos#down ()
83         else if key = _l || key = _Right then
84           pos#left ()
85         else (x0, y0)
86       in
87       let wid1 = arr.(x1).(y1) in
88       wid0#set_text (wid1#text);
89       wid1#set_text "";
90       true
91     end
92               
93 let main () = 
94   window#show ();
95   Main.main ()
96
97 let _ = main ()