--- /dev/null
+(* $Id$ *)
+
+open GtkNew
+open GtkBase
+
+(* To create a new widget:
+ create an array sig_array containing the signals defined by
+ the new widget;
+ call:
+ make_new_widget name parent:parent signal_array:sig_array
+ where name is the name of the new widget (a string)
+ parent is the type of the parent: of type Gtk.New.object_type
+ This call returns a triple:
+ (get_type_func, new_func, sig_array_num)
+ where get_type_func is the new widget get_type function,
+ new_func is the function returning a new widget of the new type
+ sig_array_num is an array containing the Gtk id of the signals
+ of the new widget.
+*)
+
+module Tictactoe = struct
+ type t = [`widget|`container|`box|`tictactoe]
+ module Signals = struct
+ open GtkSignal
+ let tictactoe : ([>`tictactoe],_) t =
+ { name = "tictactoe"; marshaller = marshal_unit }
+ let emit_tictactoe = emit_unit ~sgn:tictactoe
+ end
+ let create : unit -> t Gtk.obj =
+ let _,tictactoe_new = make_new_widget
+ ~name:"Tictactoe" ~parent:VBOX ~signals:[Signals.tictactoe]
+ in fun () -> Object.try_cast (tictactoe_new ()) "Tictactoe"
+end
+
+open GMain
+
+class tictactoe_signals obj = object
+ inherit GContainer.container_signals obj
+ method tictactoe =
+ GtkSignal.connect ~sgn:Tictactoe.Signals.tictactoe obj ~after
+end
+
+exception Trouve
+
+class tictactoe ?packing ?show () =
+ let obj : Tictactoe.t Gtk.obj = Tictactoe.create () in
+ let box = new GPack.box_skel obj in
+object (self)
+ inherit GObj.widget obj
+ val mutable buttons = [||]
+ val mutable buttons_handlers = [||]
+ val label = GMisc.label ~text:"Go on!" ~packing:box#add ()
+ method clear () =
+ for i = 0 to 2 do
+ for j = 0 to 2 do
+ let button = buttons.(i).(j)
+ and handler = buttons_handlers.(i).(j) in
+ button#misc#handler_block handler;
+ button#set_active false;
+ button#misc#handler_unblock handler
+ done
+ done
+ method connect = new tictactoe_signals obj
+ method emit_tictactoe () =
+ GtkSignal.emit_unit obj ~sgn:Tictactoe.Signals.tictactoe
+ method toggle () =
+ let rwins = [| [| 0; 0; 0 |]; [| 1; 1; 1 |]; [| 2; 2; 2 |];
+ [| 0; 1; 2 |]; [| 0; 1; 2 |]; [| 0; 1; 2 |];
+ [| 0; 1; 2 |]; [| 0; 1; 2 |] |]
+ and cwins = [| [| 0; 1; 2 |]; [| 0; 1; 2 |]; [| 0; 1; 2 |];
+ [| 0; 0; 0 |]; [| 1; 1; 1 |]; [| 2; 2; 2 |];
+ [| 0; 1; 2 |]; [| 2; 1; 0 |] |] in
+ label#set_text"Go on!";
+ try
+ for k = 0 to 7 do
+ let rec aux i =
+ (i = 3) ||
+ (buttons.(rwins.(k).(i)).(cwins.(k).(i))#active) && (aux (i+1)) in
+ if aux 0 then raise Trouve
+ done
+ with Trouve -> label#set_text "Win!!"; self#emit_tictactoe ()
+
+ initializer
+ let table =
+ GPack.table ~rows:3 ~columns:3 ~homogeneous:true ~packing:box#add () in
+ buttons <-
+ Array.init 3 ~f:
+ (fun i -> Array.init 3 ~f:
+ (fun j ->
+ GButton.toggle_button ~width:20 ~height:20
+ ~packing:(table#attach ~left:i ~top:j ~expand:`BOTH) ()));
+ buttons_handlers <-
+ Array.mapi buttons ~f:
+ (fun i -> Array.mapi ~f:
+ (fun j button -> button #connect#toggled ~callback:self#toggle));
+ GObj.pack_return self ~packing ~show;
+ ()
+end
+
+let win (ttt : tictactoe) _ =
+ Printf.printf "Gagne!!\n" ;
+ ttt #clear ()
+
+let essai () =
+ let window = GWindow.window ~title:"Tictactoe" ~border_width:10 () in
+ window #connect#destroy ~callback:Main.quit;
+ let ttt = new tictactoe ~packing:window#add () in
+ ttt #connect#tictactoe ~callback:(win ttt);
+ window #show ();
+ Main.main ()
+
+let _ = essai ()
+