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 ()