--- /dev/null
+(* $Id$ *)
+
+(* Tron? Game *)
+open GMain
+
+let m_pi = acos (-1.)
+let clRed = `NAME "red" (* `BLACK *)
+let clBlue = `NAME "blue" (* `WHITE *)
+let clBlack = `BLACK
+
+type point = {mutable x: int; mutable y: int}
+
+let main () =
+(* Game State *)
+ let gameSize = 64 in
+ let gameState =
+ Array.create_matrix ~dimx:(gameSize+2) ~dimy:(gameSize+2) 0 in
+ let gameInit _ =
+ for i=1 to gameSize do
+ for j=1 to gameSize do
+ gameState.(i).(j) <- 0;
+ done
+ done;
+ for i=0 to gameSize do
+ gameState.(0).(i) <- 3; (* left wall *)
+ gameState.(i).(gameSize+1) <- 3; (* floor *)
+ gameState.(gameSize+1).(i+1) <- 3; (* right wall *)
+ gameState.(i+1).(0) <- 3 (* ceiling *)
+ done in
+ gameInit ();
+ let lpos = {x=4; y=4} in
+ let lspeed = {x=0; y=1} in
+ let rpos = {x=gameSize-3; y=gameSize-3} in
+ let rspeed = {x=0; y= -1} in
+ let keys = "asdfhjkl" in
+ let keyMapL = [|(-1, 0); (0, -1); (0, 1); (1, 0)|] in
+ let keyMapR = [|(-1, 0); (0, 1); (0, -1); (1, 0)|] in
+
+(* User Interface *)
+ let window = GWindow.window ~border_width:10 ~title:"tron(?)" () in
+ window#event#connect#delete
+ ~callback:(fun _ -> prerr_endline "Delete event occured"; false);
+ window#connect#destroy ~callback:Main.quit;
+ let vbx = GPack.vbox ~packing:window#add () in
+ let area = GMisc.drawing_area ~width:((gameSize+2)*4) ~height:((gameSize+2)*4)
+ ~packing:vbx#add () in
+ let drawing = area#misc#realize (); new GDraw.drawable (area#misc#window) in
+ let style = area#misc#style#copy in
+ style#set_bg [`NORMAL,`WHITE];
+ area#misc#set_style style;
+ drawing#set_background `WHITE;
+ let area_expose _ =
+ for i=0 to gameSize+1 do
+ for j=0 to gameSize+1 do
+ if gameState.(i).(j) = 1 then begin
+ drawing#set_foreground clRed;
+ drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
+ end
+ else if gameState.(i).(j) = 2 then begin
+ drawing#set_foreground clBlue;
+ drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
+ end
+ else if gameState.(i).(j) = 3 then begin
+ drawing#set_foreground clBlack;
+ drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 ()
+ end
+ done
+ done;
+ false
+ in
+ area#event#connect#expose ~callback:area_expose;
+ let control = GPack.table ~rows:3 ~columns:7 ~packing:vbx#pack () in
+
+ let abuttonClicked num (lbl : GMisc.label) _ = begin
+ let dialog =
+ GWindow.window ~kind:`DIALOG ~border_width:10 ~title:"Key remap" () in
+ let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in
+ let entry = GEdit.entry ~max_length:1 ~packing: dvbx#add () in
+ let txt = String.make 1 keys.[num] in
+ entry#set_text txt;
+ let dquit = GButton.button ~label:"OK" ~packing: dvbx#add () in
+ dquit#connect#clicked ~callback:
+ begin fun _ ->
+ let chr = entry#text.[0] in
+ let txt2 = String.make 1 chr in
+ lbl#set_text txt2;
+ keys.[num]<-chr;
+ dialog#destroy ()
+ end;
+ dialog#show ()
+ end in
+ let attach = control#attach ~expand:`BOTH in
+ let new_my_button ~label:label ~left:left ~top:top =
+ let str = String.make 1 keys.[label] in
+ let btn = GButton.button ~packing:(attach ~left:left ~top:top) () in
+ let lbl = GMisc.label ~text:str ~packing:(btn#add) () in
+ btn#connect#clicked ~callback:(abuttonClicked label lbl);
+ btn
+ in
+ new_my_button ~label:0 ~left:1 ~top:2;
+ new_my_button ~label:1 ~left:2 ~top:1;
+ new_my_button ~label:2 ~left:2 ~top:3;
+ new_my_button ~label:3 ~left:3 ~top:2;
+ new_my_button ~label:4 ~left:5 ~top:2;
+ new_my_button ~label:5 ~left:6 ~top:3;
+ new_my_button ~label:6 ~left:6 ~top:1;
+ new_my_button ~label:7 ~left:7 ~top:2;
+ let quit =
+ GButton.button ~label:"Quit" ~packing:(attach ~left:4 ~top:2) () in
+ quit#connect#clicked ~callback:window#destroy;
+ let message = GMisc.label ~text:"tron(?) game" ~packing:vbx#pack () in
+
+ let game_step () =
+ let lx = lpos.x in let ly = lpos.y in
+ gameState.(lx).(ly) <- 1;
+ drawing#set_foreground clRed;
+ drawing#rectangle ~filled:true ~x:(lx*4) ~y:(ly*4) ~width:4 ~height:4 ();
+ let rx = rpos.x in let ry = rpos.y in
+ gameState.(rx).(ry) <- 2;
+ drawing#set_foreground clBlue;
+ drawing#rectangle ~filled:true ~x:(rx*4) ~y:(ry*4) ~width:4 ~height:4 ()
+ in
+ game_step ();
+ let keyDown ev = begin
+ let key = GdkEvent.Key.keyval ev in
+ for i=0 to (Array.length keyMapL)-1 do
+ let (x, y) = keyMapL.(i) in
+ let k = keys.[i] in
+ if key = Char.code k then begin
+ lspeed.x <- x;
+ lspeed.y <- y
+ end;
+ let (x, y) = keyMapR.(i) in
+ let k = keys.[i+4] in
+ if key = Char.code k then begin
+ rspeed.x <- x;
+ rspeed.y <- y
+ end
+ done;
+ false end in
+ window#event#connect#key_press ~callback:keyDown;
+ let safe_check _ =
+ if lpos.x == rpos.x && lpos.y == rpos.y then
+ 3
+ else
+ (* player 1 *)
+ (if gameState.(lpos.x).(lpos.y) != 0 then 2 else 0)
+ +
+ (* player 2 *)
+ (if gameState.(rpos.x).(rpos.y) != 0 then 1 else 0)
+ in
+ let timerID = ref (* dummy *) (Timeout.add ~ms:100 ~callback:(fun _ -> true)) in
+ let timerTimer _ = begin
+ lpos.x <- lpos.x+lspeed.x;
+ lpos.y <- lpos.y+lspeed.y;
+ rpos.x <- rpos.x+rspeed.x;
+ rpos.y <- rpos.y+rspeed.y;
+ let result = safe_check() in
+ if result!=0 then begin
+ Timeout.remove (!timerID);
+ message#set_text ("player "^string_of_int result^" won.")
+ end
+ else begin
+ game_step()
+ end;
+ true
+ end in
+ let count = ref 3 in
+ let timerTimer2 _ = begin
+(* message#set_label (string_of_int (!count)); *)
+ if (!count==0) then begin
+ Timeout.remove (!timerID);
+ timerID := Timeout.add ~ms:100 ~callback:timerTimer
+ end
+ else begin
+ count := !count-1;
+ end;
+ true
+ end in
+ let restartClicked () =
+ Timeout.remove !timerID;
+ gameInit();
+ lpos.x <- 4; lpos.y <- 4;
+ lspeed.x <- 0; lspeed.y <- 1;
+ rpos.x <- gameSize-3; rpos.y <- gameSize-3;
+ rspeed.x <- 0; rspeed.y <- -1;
+ drawing#set_foreground `WHITE;
+ drawing#rectangle ~filled:true ~x:0 ~y:0
+ ~width:((gameSize+2)*4) ~height:((gameSize+2)*4) ();
+ area_expose();
+ count := 3;
+ timerID := Timeout.add ~ms:300 ~callback:timerTimer2;
+ in
+ let restart =
+ GButton.button ~label: "Restart" ~packing:(attach ~left:4 ~top:3) () in
+ restart#connect#clicked ~callback:restartClicked;
+ restartClicked ();
+
+ window#show ();
+ Main.main ()
+
+let _ = Printexc.print main ()
+
+
projects / helm.git / blobdiff