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

   1 (* $Id$ *)
   2
   3 (* Tron? Game *)
   4 open GMain
   5
   6 let m_pi = acos (-1.)
   7 let clRed   = `NAME "red"  (* `BLACK *)
   8 let clBlue  = `NAME "blue" (* `WHITE *)
   9 let clBlack = `BLACK
  10
  11 type point = {mutable x: int; mutable y: int}
  12
  13 let main () =
  14 (* Game State *)
  15   let gameSize = 64 in
  16   let gameState =
  17     Array.create_matrix ~dimx:(gameSize+2) ~dimy:(gameSize+2) 0 in
  18   let gameInit _ =
  19     for i=1 to gameSize do
  20       for j=1 to gameSize do
  21         gameState.(i).(j) <- 0;
  22       done
  23     done;
  24     for i=0 to gameSize do
  25       gameState.(0).(i) <- 3;            (* left wall *)
  26       gameState.(i).(gameSize+1) <- 3;   (* floor *)
  27       gameState.(gameSize+1).(i+1) <- 3; (* right wall *)
  28       gameState.(i+1).(0) <- 3           (* ceiling *)
  29     done in
  30   gameInit ();
  31   let lpos = {x=4; y=4} in
  32   let lspeed = {x=0; y=1} in
  33   let rpos = {x=gameSize-3; y=gameSize-3} in
  34   let rspeed = {x=0; y= -1} in
  35   let keys = "asdfhjkl" in
  36   let keyMapL = [|(-1, 0); (0, -1); (0, 1); (1, 0)|] in
  37   let keyMapR = [|(-1, 0); (0, 1); (0, -1); (1, 0)|] in
  38
  39 (* User Interface *)
  40   let window = GWindow.window ~border_width:10 ~title:"tron(?)" () in
  41   window#event#connect#delete
  42      ~callback:(fun _ -> prerr_endline "Delete event occured"; false);
  43   window#connect#destroy ~callback:Main.quit;
  44   let vbx = GPack.vbox ~packing:window#add () in
  45   let area = GMisc.drawing_area ~width:((gameSize+2)*4) ~height:((gameSize+2)*4)
  46       ~packing:vbx#add () in
  47   let drawing = area#misc#realize (); new GDraw.drawable (area#misc#window) in
  48   let style = area#misc#style#copy in
  49   style#set_bg [`NORMAL,`WHITE];
  50   area#misc#set_style style;
  51   drawing#set_background `WHITE;
  52   let area_expose _ =
  53     for i=0 to gameSize+1 do
  54       for j=0 to gameSize+1 do
  55         if gameState.(i).(j) = 1 then begin
  56           drawing#set_foreground clRed;
  57           drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
  58         end
  59         else if gameState.(i).(j) = 2 then begin
  60           drawing#set_foreground clBlue;
  61           drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
  62         end
  63         else if gameState.(i).(j) = 3 then begin
  64           drawing#set_foreground clBlack;
  65           drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
  66         end
  67       done
  68     done;
  69     false
  70   in
  71   area#event#connect#expose ~callback:area_expose;
  72   let control = GPack.table ~rows:3 ~columns:7 ~packing:vbx#pack () in
  73
  74   let abuttonClicked num (lbl : GMisc.label) _ = begin
  75     let dialog =
  76       GWindow.window ~kind:`DIALOG ~border_width:10 ~title:"Key remap" () in
  77     let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in
  78     let entry  = GEdit.entry ~max_length:1 ~packing: dvbx#add () in
  79     let txt = String.make 1 keys.[num] in
  80     entry#set_text txt;
  81     let dquit = GButton.button ~label:"OK" ~packing: dvbx#add () in
  82     dquit#connect#clicked ~callback:
  83       begin fun _ ->
  84         let chr = entry#text.[0] in
  85         let txt2 = String.make 1 chr in
  86         lbl#set_text txt2;
  87         keys.[num]<-chr;
  88         dialog#destroy ()
  89       end;
  90     dialog#show ()
  91   end in
  92   let attach = control#attach ~expand:`BOTH in
  93   let new_my_button ~label:label ~left:left ~top:top =
  94       let str = String.make 1 keys.[label] in
  95       let btn = GButton.button ~packing:(attach ~left:left ~top:top) () in
  96       let lbl = GMisc.label ~text:str ~packing:(btn#add) () in
  97       btn#connect#clicked ~callback:(abuttonClicked label lbl);
  98       btn
  99   in
 100   new_my_button ~label:0 ~left:1 ~top:2;
 101   new_my_button ~label:1 ~left:2 ~top:1;
 102   new_my_button ~label:2 ~left:2 ~top:3;
 103   new_my_button ~label:3 ~left:3 ~top:2;
 104   new_my_button ~label:4 ~left:5 ~top:2;
 105   new_my_button ~label:5 ~left:6 ~top:3;
 106   new_my_button ~label:6 ~left:6 ~top:1;
 107   new_my_button ~label:7 ~left:7 ~top:2;
 108   let quit =
 109     GButton.button ~label:"Quit" ~packing:(attach ~left:4 ~top:2) () in
 110   quit#connect#clicked ~callback:window#destroy;
 111   let message = GMisc.label ~text:"tron(?) game" ~packing:vbx#pack () in
 112
 113   let game_step () =
 114         let lx = lpos.x in let ly = lpos.y in
 115         gameState.(lx).(ly) <- 1;
 116         drawing#set_foreground clRed;
 117         drawing#rectangle ~filled:true ~x:(lx*4) ~y:(ly*4) ~width:4 ~height:4 ();
 118         let rx = rpos.x in let ry = rpos.y in
 119         gameState.(rx).(ry) <- 2;
 120         drawing#set_foreground clBlue;
 121         drawing#rectangle ~filled:true ~x:(rx*4) ~y:(ry*4) ~width:4 ~height:4 ()
 122   in
 123   game_step ();
 124   let keyDown ev = begin
 125     let key = GdkEvent.Key.keyval ev in
 126     for i=0 to (Array.length keyMapL)-1 do
 127        let (x, y) = keyMapL.(i) in
 128        let k = keys.[i] in
 129        if key = Char.code k then begin
 130          lspeed.x <- x;
 131          lspeed.y <- y
 132        end;
 133        let (x, y) = keyMapR.(i) in
 134        let k = keys.[i+4] in
 135        if key = Char.code k then begin
 136          rspeed.x <- x;
 137          rspeed.y <- y
 138        end
 139     done;
 140     false end in
 141   window#event#connect#key_press ~callback:keyDown;
 142   let safe_check _ =
 143     if lpos.x == rpos.x && lpos.y == rpos.y then
 144       3
 145     else
 146       (* player 1 *)
 147       (if gameState.(lpos.x).(lpos.y) != 0  then 2 else 0)
 148       +
 149       (* player 2 *)
 150       (if gameState.(rpos.x).(rpos.y) != 0  then 1 else 0)
 151       in
 152   let timerID = ref (* dummy *) (Timeout.add ~ms:100 ~callback:(fun _ -> true)) in
 153   let timerTimer _ = begin
 154      lpos.x <- lpos.x+lspeed.x;
 155      lpos.y <- lpos.y+lspeed.y;
 156      rpos.x <- rpos.x+rspeed.x;
 157      rpos.y <- rpos.y+rspeed.y;
 158      let result = safe_check() in
 159      if result!=0 then begin
 160         Timeout.remove (!timerID);
 161         message#set_text ("player "^string_of_int result^" won.")
 162      end
 163      else begin
 164        game_step()
 165      end;
 166      true
 167   end in
 168   let count = ref 3 in
 169   let timerTimer2 _ = begin
 170 (*    message#set_label (string_of_int (!count)); *)
 171     if (!count==0) then begin
 172       Timeout.remove (!timerID);
 173       timerID := Timeout.add ~ms:100 ~callback:timerTimer
 174     end
 175     else begin
 176       count := !count-1;
 177     end;
 178     true
 179   end in
 180   let restartClicked () =
 181     Timeout.remove !timerID;
 182     gameInit();
 183     lpos.x <- 4; lpos.y <- 4;
 184     lspeed.x <- 0; lspeed.y <- 1;
 185     rpos.x <- gameSize-3; rpos.y <- gameSize-3;
 186     rspeed.x <- 0; rspeed.y <- -1;
 187     drawing#set_foreground `WHITE;
 188     drawing#rectangle ~filled:true ~x:0 ~y:0
 189       ~width:((gameSize+2)*4) ~height:((gameSize+2)*4) ();
 190     area_expose();
 191     count := 3;
 192     timerID := Timeout.add ~ms:300 ~callback:timerTimer2;
 193   in
 194   let restart =
 195     GButton.button ~label: "Restart" ~packing:(attach ~left:4 ~top:3) () in
 196   restart#connect#clicked ~callback:restartClicked;
 197   restartClicked ();
 198
 199   window#show ();
 200   Main.main ()
 201
 202 let _ = Printexc.print main ()
 203
 204