diff options
Diffstat (limited to 'otherlibs/labltk/example/tetris.ml')
| -rw-r--r-- | otherlibs/labltk/example/tetris.ml | 72 |
1 files changed, 36 insertions, 36 deletions
diff --git a/otherlibs/labltk/example/tetris.ml b/otherlibs/labltk/example/tetris.ml index 580e7c82b..5e40c7d76 100644 --- a/otherlibs/labltk/example/tetris.ml +++ b/otherlibs/labltk/example/tetris.ml @@ -205,7 +205,7 @@ let line_full = int_of_string "0b1111111111111111" let decode_block dvec = let btoi d = int_of_string ("0b"^d) in - Array.map fun:btoi dvec + Array.map f:btoi dvec class cell t1 t2 t3 :canvas :x :y = object val mutable color = 0 @@ -213,33 +213,33 @@ class cell t1 t2 t3 :canvas :x :y = object method set color:col = if color = col then () else if color <> 0 & col = 0 then begin - Canvas.move canvas tag: t1 + Canvas.move t1 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2); - Canvas.move canvas tag: t2 + Canvas.move t2 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2); - Canvas.move canvas tag: t3 + Canvas.move t3 :canvas x:(- block_size * (x + 1) -10 - cell_border * 2) y:(- block_size * (y + 1) -10 - cell_border * 2) end else begin - Canvas.configure_rectangle canvas tag: t2 + Canvas.configure_rectangle t2 :canvas fill: colors.(col - 1) outline: colors.(col - 1); - Canvas.configure_rectangle canvas tag: t1 + Canvas.configure_rectangle t1 :canvas fill: `Black outline: `Black; - Canvas.configure_rectangle canvas tag: t3 + Canvas.configure_rectangle t3 :canvas fill: (`Color "light gray") outline: (`Color "light gray"); if color = 0 & col <> 0 then begin - Canvas.move canvas tag: t1 + Canvas.move t1 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2); - Canvas.move canvas tag: t2 + Canvas.move t2 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2); - Canvas.move canvas tag: t3 + Canvas.move t3 :canvas x: (block_size * (x+1)+10+ cell_border*2) y: (block_size * (y+1)+10+ cell_border*2) end @@ -298,8 +298,8 @@ let init fw = let cells_src = create_base_matrix cols:field_width rows:field_height in let cells = - Array.map cells_src fun: - (Array.map fun: + Array.map cells_src f: + (Array.map f: begin fun (x,y) -> let t1 = Canvas.create_rectangle c @@ -314,16 +314,16 @@ let init fw = x1:(-block_size - 12) y1:(-block_size - 12) x2:(-13) y2:(-13) in - Canvas.raise c tag: t1; - Canvas.raise c tag: t2; - Canvas.lower c tag: t3; + Canvas.raise canvas:c t1; + Canvas.raise canvas:c t2; + Canvas.lower canvas:c t3; new cell canvas:c :x :y t1 t2 t3 end) in let nexts_src = create_base_matrix cols:4 rows:4 in let nexts = - Array.map nexts_src fun: - (Array.map fun: + Array.map nexts_src f: + (Array.map f: begin fun (x,y) -> let t1 = Canvas.create_rectangle nc @@ -338,9 +338,9 @@ let init fw = x1:(-block_size - 12) y1:(-block_size - 12) x2:(-13) y2:(-13) in - Canvas.raise nc tag: t1; - Canvas.raise nc tag: t2; - Canvas.lower nc tag: t3; + Canvas.raise canvas:nc t1; + Canvas.raise canvas:nc t2; + Canvas.lower canvas:nc t3; new cell canvas:nc :x :y t1 t2 t3 end) in @@ -394,8 +394,8 @@ let _ = let line = ref 0 in let level = ref 0 in let time = ref 1000 in - let blocks = List.map fun:(List.map fun:decode_block) blocks in - let field = Array.create len:26 0 in + let blocks = List.map f:(List.map f:decode_block) blocks in + let field = Array.create 26 0 in let widgets, button, cell_field, next_field, scorev, linev, levv, game_over = init fw in let canvas = fst cell_field in @@ -419,13 +419,13 @@ let _ = let draw_falling_block fb = draw_block cell_field color: fb.bcolor - block: (List.nth fb.pattern pos: fb.d) + block: (List.nth fb.pattern fb.d) x: (fb.x - 3) y: (fb.y - 3) and erase_falling_block fb = draw_block cell_field color: 0 - block: (List.nth fb.pattern pos: fb.d) + block: (List.nth fb.pattern fb.d) x: (fb.x - 3) y: (fb.y - 3) in @@ -434,7 +434,7 @@ let _ = for i=0 to 3 do let cur = field.(i + fb.y) in field.(i + fb.y) <- - cur lor ((List.nth fb.pattern pos: fb.d).(i) lsl fb.x) + cur lor ((List.nth fb.pattern fb.d).(i) lsl fb.x) done; for i=0 to 2 do field.(i) <- line_empty @@ -489,18 +489,18 @@ let _ = let draw_next () = draw_block next_field color: (!next+1) - block: (List.hd (List.nth blocks pos: !next)) + block: (List.hd (List.nth blocks !next)) x: 0 y: 0 and erase_next () = draw_block next_field color: 0 - block: (List.hd (List.nth blocks pos: !next)) + block: (List.hd (List.nth blocks !next)) x: 0 y: 0 in let set_nextblock () = current := - { pattern= (List.nth blocks pos: !next); + { pattern= (List.nth blocks !next); bcolor= !next+1; x=6; y= 1; d= 0; alive= true}; erase_next (); @@ -512,7 +512,7 @@ let _ = try for i=0 to 3 do let cur = field.(i + fb.y) in - if cur land ((List.nth fb.pattern pos: fb.d).(i) lsl fb.x) <> 0 + if cur land ((List.nth fb.pattern fb.d).(i) lsl fb.x) <> 0 then raise Done done; false @@ -551,12 +551,12 @@ let _ = x: (block_size * 5 + block_size / 2) y: (block_size * 10 + block_size / 2) anchor: `Center in - Canvas.lower canvas tag: i; + Canvas.lower :canvas i; let img = Imagephoto.create () in fun file -> try Imagephoto.configure img file: file; - Canvas.configure_image canvas tag: i image: img + Canvas.configure_image :canvas i image: img with _ -> begin @@ -573,8 +573,8 @@ let _ = score := !score + l * l; set_message (Printf.sprintf "%d pts" (1 lsl ((l - 1) * 2))) end; - Textvariable.set linev to: (string_of_int !line); - Textvariable.set scorev to: (string_of_int !score); + Textvariable.set linev (string_of_int !line); + Textvariable.set scorev (string_of_int !score); if !line /10 <> pline /10 then (* undate the background every 10 lines. *) @@ -582,10 +582,10 @@ let _ = let num_image = List.length backgrounds - 1 in let n = !line/10 in let n = if n > num_image then num_image else n in - let file = List.nth backgrounds pos: n in + let file = List.nth backgrounds n in image_load file; incr level; - Textvariable.set levv to: (string_of_int !level) + Textvariable.set levv (string_of_int !level) end in @@ -699,7 +699,7 @@ let _ = do_after ms:!time do:loop in (* As an applet, it was required... *) - (* List.iter fun: bind_game widgets; *) + (* List.iter f: bind_game widgets; *) bind_game top; Button.configure button command: game_init; game_init () |