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