helm/DEVEL/lablgtk/lablgtk_20000829-0.1.0/examples/tictactoe.ml

   1 (* $Id$ *)
   2
   3 open GtkNew
   4 open GtkBase
   5
   6 (* To create a new widget:
   7    create an array sig_array containing the signals defined by
   8    the new widget;
   9    call:
  10       make_new_widget name parent:parent signal_array:sig_array
  11    where name is the name of the new widget (a string)
  12    parent is the type of the parent: of type Gtk.New.object_type
  13    This call returns a triple:
  14      (get_type_func, new_func, sig_array_num)
  15    where get_type_func is the new widget get_type function,
  16    new_func is the function returning a new widget of the new type
  17    sig_array_num is an array containing the Gtk id of the signals
  18    of the new widget.
  19 *)
  20
  21 module Tictactoe = struct
  22   type t = [`widget|`container|`box|`tictactoe]
  23   module Signals = struct
  24     open GtkSignal
  25     let tictactoe : ([>`tictactoe],_) t =
  26       { name = "tictactoe"; marshaller = marshal_unit }
  27     let emit_tictactoe = emit_unit ~sgn:tictactoe
  28   end
  29   let create : unit -> t Gtk.obj =
  30     let _,tictactoe_new = make_new_widget
  31         ~name:"Tictactoe" ~parent:VBOX ~signals:[Signals.tictactoe]
  32     in fun () -> Object.try_cast (tictactoe_new ()) "Tictactoe"
  33 end
  34
  35 open GMain
  36
  37 class tictactoe_signals obj = object
  38   inherit GContainer.container_signals obj
  39   method tictactoe =
  40     GtkSignal.connect ~sgn:Tictactoe.Signals.tictactoe obj ~after
  41 end
  42
  43 exception Trouve
  44
  45 class tictactoe ?packing ?show () =
  46   let obj : Tictactoe.t Gtk.obj = Tictactoe.create () in
  47   let box = new GPack.box_skel obj in
  48 object (self)
  49   inherit GObj.widget obj
  50   val mutable buttons = [||]
  51   val mutable buttons_handlers = [||]
  52   val label = GMisc.label ~text:"Go on!" ~packing:box#add ()
  53   method clear () =
  54     for i = 0 to 2 do
  55       for j = 0 to 2 do
  56         let button = buttons.(i).(j)
  57         and handler = buttons_handlers.(i).(j) in
  58         button#misc#handler_block handler;
  59         button#set_active false;
  60         button#misc#handler_unblock handler
  61       done
  62     done
  63   method connect = new tictactoe_signals obj
  64   method emit_tictactoe () =
  65     GtkSignal.emit_unit obj ~sgn:Tictactoe.Signals.tictactoe
  66   method toggle () =
  67     let rwins = [| [| 0; 0; 0 |]; [| 1; 1; 1 |]; [| 2; 2; 2 |];
  68                    [| 0; 1; 2 |]; [| 0; 1; 2 |]; [| 0; 1; 2 |];
  69                    [| 0; 1; 2 |]; [| 0; 1; 2 |] |]
  70     and cwins = [| [| 0; 1; 2 |]; [| 0; 1; 2 |]; [| 0; 1; 2 |];
  71                    [| 0; 0; 0 |]; [| 1; 1; 1 |]; [| 2; 2; 2 |];
  72                    [| 0; 1; 2 |]; [| 2; 1; 0 |] |] in
  73     label#set_text"Go on!";
  74     try
  75       for k = 0 to 7 do
  76         let rec aux i =
  77           (i = 3) ||
  78           (buttons.(rwins.(k).(i)).(cwins.(k).(i))#active) && (aux (i+1)) in
  79         if aux 0 then raise Trouve
  80       done
  81     with Trouve -> label#set_text "Win!!"; self#emit_tictactoe ()
  82
  83   initializer
  84     let table =
  85       GPack.table ~rows:3 ~columns:3 ~homogeneous:true ~packing:box#add () in
  86     buttons <-
  87       Array.init 3 ~f:
  88         (fun i -> Array.init 3 ~f:
  89             (fun j ->
  90               GButton.toggle_button ~width:20 ~height:20
  91                 ~packing:(table#attach ~left:i ~top:j ~expand:`BOTH) ()));
  92     buttons_handlers <-
  93       Array.mapi buttons ~f:
  94         (fun i -> Array.mapi ~f:
  95           (fun j button -> button #connect#toggled ~callback:self#toggle));
  96     GObj.pack_return self ~packing ~show;
  97     ()
  98 end
  99
 100 let win (ttt : tictactoe)  _ =
 101   Printf.printf "Gagne!!\n" ;
 102   ttt #clear ()
 103
 104 let essai () =
 105   let window = GWindow.window ~title:"Tictactoe" ~border_width:10 () in
 106   window #connect#destroy ~callback:Main.quit;
 107   let ttt = new tictactoe ~packing:window#add () in
 108   ttt #connect#tictactoe ~callback:(win ttt);
 109   window #show ();
 110   Main.main ()
 111
 112 let _ = essai ()
 113