I tried to run your code on my machine. There is no syntax error, the graphics window opens, and I can see the snakes moving. However when I press a key, the program fails with Exception: Unix.Unix_error (Unix.EINTR, "select", ""). I will not try to figure out whether it's a bug in your program or in my configuration, but I can refactor your code a bit.
The first thing is to make sure that top-level values and functions are defined at the top level. At the beginning, everything is fine, but draw_background is followed by a single semicolon, so the syntax prevents you from defining the next functions at the toplevel.
let player_2 = {x=((n_tiles-1)/2)*tile_size; y=(n_tiles-1)*tile_size; s_y= (-1)*speed; s_x=0} ;;
draw_background n_tiles tile_size;
let draw_players box_player_1 box_player_2 player_1 player_2 =
draw_box box_player_1 player_1.x player_1.y;
draw_box box_player_2 player_2.x player_2.y;
in
let key_pressed_player_1 button_pressed player =
(match button_pressed with
'q' -> if player.s_x <> speed then {x = player.x; y = player.y; s_x = (-1)*speed; s_y = 0} else player;
|'d' -> if player.s_x <> (-1)*speed then {x = player.x; y =player.y; s_x = speed; s_y = 0} else player;
|'z' -> if player.s_y <> (-1)*speed then {x = player.x; y =player.y; s_x = 0; s_y = speed} else player;
|'s' -> if player.s_y <> speed then {x = player.x; y =player.y; s_x = 0; s_y = (-1)*speed} else player;
|_ -> player)
in
Can be changed into
let player_2 = {x=((n_tiles-1)/2)*tile_size; y=(n_tiles-1)*tile_size; s_y= (-1)*speed; s_x=0} ;;
let () = draw_background n_tiles tile_size;;
let draw_players box_player_1 box_player_2 player_1 player_2 =
draw_box box_player_1 player_1.x player_1.y;
draw_box box_player_2 player_2.x player_2.y
let key_pressed_player_1 button_pressed player =
(match button_pressed with
'q' -> if player.s_x <> speed then {x = player.x; y = player.y; s_x = (-1)*speed; s_y = 0} else player;
|'d' -> if player.s_x <> (-1)*speed then {x = player.x; y =player.y; s_x = speed; s_y = 0} else player;
|'z' -> if player.s_y <> (-1)*speed then {x = player.x; y =player.y; s_x = 0; s_y = speed} else player;
|'s' -> if player.s_y <> speed then {x = player.x; y =player.y; s_x = 0; s_y = (-1)*speed} else player;
|_ -> player)
Notice that instead of using let f x = foo in let g x = bar in we can keep defining top level bindings: let f x = foo let g x = bar. The intermediate bindings can be adapted this way up until the call to the main loop:
aux player_1 player_2 [] false
in
main_loop player_1 player_2;
is turned into
aux player_1 player_2 [] false
let () = main_loop player_1 player_2;;
Now I can separate the function and value definitions from the instructions actually executing the code, which gives the following grouping at the end of the file.
let () =
Graphics.open_graph " ";
Graphics.set_window_title "Test !";
Graphics.plot 50 50;
draw_background n_tiles tile_size;
main_loop player_1 player_2;;
I try to improve (my) readability by adjusting the style slightly. For instance, following semicolons with a single space: (x1,y1);(ix1,iy1); becomes (x1,y1); (ix1,iy1);. Also editing the column alignment here and there.
I use the record update notation. This is quite useful when you are creating a new record based on an existing one and only changing a few fields. For instance:
let update_player_position pl = {
x = pl.x + pl.s_x ;
y = pl.y + pl.s_y ;
s_x = pl.s_x ;
s_y = pl.s_y};;
Becomes
let update_player_position pl = { pl with x = pl.x + pl.s_x ; y = pl.y + pl.s_y };;
The same trick can be used in the key_pressed_player_1 function. It gives
let key_pressed_player_1 button_pressed player =
(match button_pressed with
|'q' -> if player.s_x <> speed then { player with s_x = (-1)*speed; s_y = 0 } else player;
|'d' -> if player.s_x <> (-1) * speed then { player with s_x = speed; s_y = 0 } else player;
|'z' -> if player.s_y <> (-1) * speed then { player with s_x = 0; s_y = speed } else player;
|'s' -> if player.s_y <> speed then { player with s_x = 0; s_y = (-1)*speed } else player;
|_ -> player)
key_pressed_player_2 is similarly adapted, and now I see clearly the similarity between the two. It really begs for refactoring, as you indicated in your post edit. The only difference between the two functions is which key corresponds to which direction. Once the mapping is given, both function behave exactly the same. So I first define a type to capture the concept of direction, and two functions for the mapping from keys to directions.
type direction = Left | Right | Up | Down
let key_to_direction_1 button_pressed = match button_pressed with
| 'q' -> Some Left
| 'd' -> Some Right
| 'z' -> Some Up
| 's' -> Some Down
| _ -> None
let key_to_direction_2 button_pressed = match button_pressed with
| 'j' -> Some Left
| 'l' -> Some Right
| 'i' -> Some Up
| 'k' -> Some Down
| _ -> None
The next step is to capture how the speed of the player is updated based on the desired direction, if any.
let update_speed direction_option player = match direction_option with
| Some Left -> if player.s_x <> speed then { player with s_x = (-1)*speed; s_y = 0 } else player;
| Some Right -> if player.s_x <> (-1) * speed then { player with s_x = speed; s_y = 0 } else player;
| Some Up -> if player.s_y <> (-1) * speed then { player with s_x = 0; s_y = speed } else player;
| Some Down -> if player.s_y <> speed then { player with s_x = 0; s_y = (-1)*speed } else player;
| None -> player
Now I can redefine the key_pressed_player functions to glue the key-direction mapping and the speed update.
let key_pressed_player_1 button_pressed player = update_speed (key_to_direction_1 button_pressed) player
let key_pressed_player_2 button_pressed player = update_speed (key_to_direction_2 button_pressed) player
Note how the key_to_direction_1 function matches immediately on its last (and single) argument and never uses the argument name anywhere else. In such a situation we don't even need to name the argument:
let key_to_direction_1 = function
| 'q' -> Some Left
| 'd' -> Some Right
| 'z' -> Some Up
| 's' -> Some Down
| _ -> None
The same trick can be used for update_speed provided we switch the order of the arguments. Of course the order of the arguments also needs to be switched in calls to update_speed.
let update_speed player = function
| Some Left -> if player.s_x <> speed then { player with s_x = -1 * speed; s_y = 0 } else player;
| Some Right -> if player.s_x <> -1 * speed then { player with s_x = speed; s_y = 0 } else player;
| Some Up -> if player.s_y <> -1 * speed then { player with s_x = 0; s_y = speed } else player;
| Some Down -> if player.s_y <> speed then { player with s_x = 0; s_y = -1 * speed } else player;
| None -> player
Minor stylistic update as I go over the code: the disjunction and conjunction boolean operators || and && have low priority, so we can drop the parentheses around expressions surrounding them. For instance
let has_lost player walls =
(is_out player) || (is_on_wall player walls)
becomes
let has_lost player walls = is_out player || is_on_wall player walls
Similarly,
if (has_lost player_1_next walls) then begin
minisleep 3.0;
exit 0
end else ();
can be turned into
if has_lost player_1_next walls then
(minisleep 3.0;
exit 0);
I usually prefer using parentheses instead of begin and end to group sequences of expressions, but it doesn't really matter. This way, I never need to use these two keywords.
I see that the graphics related functions are independent of the other ones, so I can group them in a module that I call Draw (in my own project, I would create a file Draw.ml to hold them). When I do this, I do not need the "draw" prefix that you added to avoid future namespace collision.
There is another convenient record syntax. When defining function taking a record as argument, one can deconstruct and bind the relevant fields directly. For instance is_out can be rewritten as
let is_out { x; y; _ } = x > tile_size * n_tiles || y > tile_size * n_tiles || x < 0 || y < 0
It seems that both player's boxes are identical, except for the color. We can share the construction.
let box_player color = {
w = tile_size;
bw = tile_size / 2;
h = tile_size;
r = Top;
b1_col = color;
b2_col = color;
b_col = color }
let box_player_1 = box_player 657900
let box_player_2 = box_player 35700
The starting values for player_1 and player_2 are set globally, but are only used to initialize the main_loop. So these values do not need to be global and can be created immediately before the main loop.
let player_1 = {x=((n_tiles-1)/2)*tile_size; y=tile_size ;s_y=speed; s_x=0} ;;
let player_2 = {x=((n_tiles-1)/2)*tile_size; y=(n_tiles-1)*tile_size; s_y= (-1)*speed; s_x=0} ;;
is moved to
let () =
Graphics.open_graph " ";
Graphics.set_window_title "Test !";
Graphics.plot 50 50;
Draw.background n_tiles tile_size;
let player_1 = { x = (n_tiles - 1) / 2 * tile_size; y = tile_size; s_y = speed; s_x = 0 }
and player_2 = { x = (n_tiles - 1) / 2 * tile_size; y = (n_tiles - 1) * tile_size; s_y = -1 * speed; s_x = 0 } in
main_loop player_1 player_2;;
The updates_speed function can be simplified by moving the magnitude of the speed to the update_player_position function:
let update_player_position pl = { pl with x = pl.x + pl.s_x ; y = pl.y + pl.s_y };;
let update_speed player = function
| Some Left -> if player.s_x <> speed then { player with s_x = -1 * speed; s_y = 0 } else player;
| Some Right -> if player.s_x <> -1 * speed then { player with s_x = speed; s_y = 0 } else player;
| Some Up -> if player.s_y <> -1 * speed then { player with s_x = 0; s_y = speed } else player;
| Some Down -> if player.s_y <> speed then { player with s_x = 0; s_y = -1 * speed } else player;
| None -> player
is turned into
let update_player_position pl = { pl with x = pl.x + pl.s_x * speed ; y = pl.y + pl.s_y * speed }
let update_speed player = function
| Some Left -> if player.s_x <> 1 then { player with s_x = -1; s_y = 0 } else player;
| Some Right -> if player.s_x <> -1 then { player with s_x = 1; s_y = 0 } else player;
| Some Up -> if player.s_y <> -1 then { player with s_x = 0; s_y = 1 } else player;
| Some Down -> if player.s_y <> 1 then { player with s_x = 0; s_y = -1 } else player;
| None -> player
Don't forget to update the initial player values
let player_1 = { x = (n_tiles - 1) / 2 * tile_size; y = tile_size; s_y = 1; s_x = 0 }
and player_2 = { x = (n_tiles - 1) / 2 * tile_size; y = (n_tiles - 1) * tile_size; s_y = -1; s_x = 0 }
The update_speed function can be rewritten to use guards, it'll make it slightly simpler to read.
let update_speed player = function
| Some Left when player.s_x <> 1 -> { player with s_x = -1; s_y = 0 };
| Some Right when player.s_x <> -1 -> { player with s_x = 1; s_y = 0 };
| Some Up when player.s_y <> -1 -> { player with s_x = 0; s_y = 1 };
| Some Down when player.s_y <> 1 -> { player with s_x = 0; s_y = -1 };
| _ -> player
Keep in mind that this modification makes the function a bit less robust. Now if you ever change the type direction, for instance to add diagonals, the compiler will not complain about a non-exhaustive match, whereas the previous version would get the compiler to remind you to adapt update_speed.
Now, let's say that we do care about robustness and that we want to take advantage of the type system to help us avoid meaningless states. Currently, there are four possible pairs s_x, s_y that are meaningful, [-1, 0; 1, 0; 0, -1; 0, 1], but the type system does not prevent the construction of or update to player records with values like, say, s_x = 0; s_y = 0. In order to get the compiler to rule out such values, we can change the record type for players. We replace the s_x and s_y fields with a current_direction field that can only ever take 4 values.
type player = { x:int; y:int; cur_direction: direction }
We then need to adapt our functions to take this new type into account.
let update_player_position pl = match pl.cur_direction with
| Left -> { pl with x = pl.x - speed }
| Right -> { pl with x = pl.x + speed }
| Up -> { pl with y = pl.y + speed }
| Down -> { pl with y = pl.y - speed }
It also gives us the opportunity to clarify the guard condition we had in the update_speed function: we only update the speed if the required direction is not opposite to the current one.
let opposite_direction = function
| Left -> Right
| Right -> Left
| Up -> Down
| Down -> Up
let update_speed player = function
| Some dir -> if opposite_direction player.cur_direction <> dir then { player with cur_direction = dir } else player
| None -> player
At this point, I realize that key_pressed_player_1 is simple enough that inlining it will not decrease readability. We can also rename update_player_position into update_position to match the naming of update_speed. The main loop looks like
let main_loop player_1 player_2 =
let rec aux player_1 player_2 walls over =
Draw.players player_1 player_2;
let e = Graphics.wait_next_event [Graphics.Poll] in
if e.Graphics.keypressed then ignore (Graphics.wait_next_event [Graphics.Key_pressed]);
let player_1_bis = update_speed player_1 (key_to_direction_1 e.Graphics.key)
and player_2_bis = update_speed player_2 (key_to_direction_2 e.Graphics.key) in
minisleep refresh_rate;
let player_1_next = update_position player_1_bis
and player_2_next = update_position player_2_bis in
if has_lost player_1_next walls then (minisleep 3.0; exit 0);
if has_lost player_2_next walls then (minisleep 3.0; exit 0);
aux player_1_next player_2_next ((player_1_next.x, player_1_next.y) :: (player_2_next.x, player_2_next.y) :: walls) over in
aux player_1 player_2 [] false
We notice that as soon as player_i_bis is defined, we don't need to access player_i anymore and that as soon as player_i_next is defined, we don't need to access player_i_bis anymore. So we can use the same name player_i all over and shadow the previous values. On the other hand, the only use of player_i made by main_loop is to feed aux, so if we change the ordering of the arguments of aux we can define this function in main once and for all (instead of redefining aux for each instance of the arguments player_i. Also, the over argument of aux is never used, so we can drop it.
When a player loses, we can get out of aux naturally instead of calling exit 0, by simply not performing a recursive call.
Back to the drawing. The box_player_1 and box_player_2 values are defined globally but they are only used to feed the Draw.players function. This can be inlined.
By the way, I'm not exactly sure what you're doing with the relief type. Only the Top value seem to be used. Maybe it's there for future versions. If you don't care about Flat and Bot, then the code for Draw.box can be simplified.
I see that Graphics.plot 50 50; has hard-coded the value 50, but it corresponds to n_tiles / tile_size. Also, the Graphics instructions corresponding to the setup can be moved to the Draw module by creating an appropriate initialization function.
let init n_tiles tile_size =
Graphics.open_graph " ";
Graphics.set_window_title "Test !";
Graphics.plot (n_tiles / tile_size) (n_tiles / tile_size);
background n_tiles tile_size
After all these modifications, my refactored version of your program would be
#load "unix.cma";;
#load "graphics.cma";;
let minisleep (sec: float) = ignore (Unix.select [] [] [] sec)
type relief = Top | Bot | Flat
type box_config =
{ w:int; h:int; bw:int;
mutable r:relief;
b1_col : Graphics.color;
b2_col : Graphics.color;
b_col : Graphics.color }
let tile_size = 3
and n_tiles = 150
and refresh_rate = 0.02
let speed = tile_size
type direction = Left | Right | Up | Down
type player = { x : int; y : int; cur_direction : direction }
module Draw =
struct
let rect x0 y0 w h =
let (a, b) = Graphics.current_point ()
and x1 = x0 + w
and y1 = y0 + h in
Graphics.moveto x0 y0;
Graphics.lineto x0 y1; Graphics.lineto x1 y1;
Graphics.lineto x1 y0; Graphics.lineto x0 y0;
Graphics.moveto a b
let background n_tiles tile_size =
for i = 1 to n_tiles do
for j = 1 to n_tiles do
rect (i * tile_size) (j * tile_size) tile_size tile_size
done
done
let box_outline bcf col x1 y1=
Graphics.set_color col;
rect x1 y1 bcf.w bcf.h
let box bcf x1 y1 =
let x2 = x1 + bcf.w and y2 = y1 + bcf.h in
let ix1 = x1 + bcf.bw and ix2 = x2 - bcf.bw
and iy1 = y1 + bcf.bw and iy2 = y2 - bcf.bw in
let border1 g =
Graphics.set_color g;
Graphics.fill_poly [| (x1, y1); (ix1, iy1); (ix2, iy1); (ix2, iy2); (x2, y2); (x2, y1) |] in
let border2 g =
Graphics.set_color g;
Graphics.fill_poly [| (x1, y1); (ix1, iy1); (ix1, iy2); (ix2, iy2); (x2, y2); (x1, y2) |] in
Graphics.set_color bcf.b_col;
(match bcf.r with
| Top ->
Graphics.fill_rect ix1 iy1 (ix2 - ix1) (iy2 - iy1);
border1 bcf.b1_col;
border2 bcf.b2_col
| Bot ->
Graphics.fill_rect ix1 iy1 (ix2 - ix1) (iy2 - iy1);
border1 bcf.b2_col;
border2 bcf.b1_col
| Flat ->
Graphics.fill_rect x1 y1 bcf.w bcf.h);
box_outline bcf Graphics.black x1 y1
let box_player color = {
w = tile_size;
bw = tile_size / 2;
h = tile_size;
r = Top;
b1_col = color;
b2_col = color;
b_col = color }
let box_player_1 = box_player 657900
let box_player_2 = box_player 35700
let init n_tiles tile_size =
Graphics.open_graph " ";
Graphics.set_window_title "Test !";
Graphics.plot (n_tiles / tile_size) (n_tiles / tile_size);
background n_tiles tile_size
let players player_1 player_2 =
box box_player_1 player_1.x player_1.y;
box box_player_2 player_2.x player_2.y
end
let key_to_direction_1 = function
| 'q' -> Some Left | 'd' -> Some Right | 'z' -> Some Up | 's' -> Some Down
| _ -> None
let key_to_direction_2 = function
| 'j' -> Some Left | 'l' -> Some Right | 'i' -> Some Up | 'k' -> Some Down
| _ -> None
let update_position pl = match pl.cur_direction with
| Left -> { pl with x = pl.x - speed }
| Right -> { pl with x = pl.x + speed }
| Up -> { pl with y = pl.y + speed }
| Down -> { pl with y = pl.y - speed }
let opposite_direction = function
| Left -> Right
| Right -> Left
| Up -> Down
| Down -> Up
let update_speed player = function
| Some dir -> if opposite_direction player.cur_direction <> dir then { player with cur_direction = dir } else player
| None -> player
let is_out { x; y; _ } = x > tile_size * n_tiles || y > tile_size * n_tiles || x < 0 || y < 0
let is_on_wall player walls = List.mem (player.x, player.y) walls
let has_lost player walls = is_out player || is_on_wall player walls
let main_loop =
let rec aux walls player_1 player_2 =
Draw.players player_1 player_2;
let e = Graphics.wait_next_event [Graphics.Poll] in
if e.Graphics.keypressed then ignore (Graphics.wait_next_event [Graphics.Key_pressed]);
let player_1 = update_speed player_1 (key_to_direction_1 e.Graphics.key)
and player_2 = update_speed player_2 (key_to_direction_2 e.Graphics.key) in
minisleep refresh_rate;
let player_1 = update_position player_1
and player_2 = update_position player_2 in
if has_lost player_1 walls || has_lost player_2 walls then minisleep 3.0
else aux ((player_1.x, player_1.y) :: (player_2.x, player_2.y) :: walls) player_1 player_2 in
aux []
let () =
Draw.init n_tiles tile_size;
let player_1 = { x = (n_tiles - 1) / 2 * tile_size; y = tile_size; cur_direction = Up }
and player_2 = { x = (n_tiles - 1) / 2 * tile_size; y = (n_tiles - 1) * tile_size; cur_direction = Down } in
main_loop player_1 player_2;;
Deeper modifications are possible too. For instance, you could be concerned with the latency introduced by checking for wall collision. Currently, you store walls in a list and checking for membership is O(n). You can replace the list with a two-dimensional array, or with a hash-table and get O(1). If you would like to prefer keeping the code purely functional, then a Set from the standard library would give you access in O(log n), or maybe you could go for a Patricia tree using Jean-Christophe Filliâtre's library.
