X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2Ftron.ml;fp=helm%2FDEVEL%2Flablgtk%2Flablgtk_20001129-0.1.0%2Fexamples%2Ftron.ml;h=eced44a9caf6d94ed0f4c5d21143c6431a02c11b;hb=7aa91a2cd4497f68ebf5b9dd85b5f2c791f738a1;hp=0000000000000000000000000000000000000000;hpb=044a71416237d8e2b575678b5f49b8c9380ca409;p=helm.git diff --git a/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/tron.ml b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/tron.ml new file mode 100644 index 000000000..eced44a9c --- /dev/null +++ b/helm/DEVEL/lablgtk/lablgtk_20001129-0.1.0/examples/tron.ml @@ -0,0 +1,204 @@ +(* $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 () + +