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