gnubg interface

board.ml

@@ -252,8 +252,9 @@ let to_representation t version ~to_play =
   representation Forwards @ (List.rev (representation Backwards))
   |> order to_play
 
-
-(* From import.c in the gnubg source code:
+(* The comment below is taken from import.c in the gnubg source code. The implementation differs from
+ * this specification slightly, however: the bar fields are the opposite way round, and the first one
+ * is negative.
  *
  * Snowie .txt files
  *
@@ -288,14 +289,14 @@ let to_snowie t ~to_play roll =
     str [1; 0; 0; 0; 0]
     @ List.map [Player.char to_play; Player.char (Player.flip to_play)] ~f:String.of_char
     @ str [0; 0; 0; 1; 0]
-    @ str [Per_player.get t.bar to_play]
+    @ str [Int.neg (Per_player.get t.bar (Player.flip to_play))]
     @ begin
       List.map t.points ~f:(fun point ->
         Int.(Point.count point to_play - Point.count point (Player.flip to_play)))
       |> order (Player.flip to_play)
       |> str
     end
-    @ str [Per_player.get t.bar (Player.flip to_play)]
+    @ str [Per_player.get t.bar to_play]
     @ str begin
       match roll with
       | Some (Roll.Double i) -> [i; i]
@@ -307,14 +308,15 @@ let to_snowie t ~to_play roll =
 
 let of_snowie s =
   Or_error.try_with (fun () ->
+    let raise_str s = Error.raise (Error.of_string s) in
     let fields = String.split s ~on:';' in
-    if Int.(List.length fields < 40) then failwith "not enough fields";
+    if Int.(List.length fields < 40) then raise_str "not enough fields";
     let to_play_field = List.nth_exn fields 5 in
     let to_play =
       match String.to_list to_play_field with
       | [c] when Char.equal c Player.(char Forwards) -> Player.Forwards
       | [c] when Char.equal c Player.(char Backwards) -> Player.Backwards
-      | _ -> failwithf "invalid player on roll %s" to_play_field ()
+      | _ -> raise_str (sprintf "invalid player on roll %s" to_play_field)
     in
     let board_fields, roll_fields =
       List.split_n fields 12
@@ -330,27 +332,23 @@ let of_snowie s =
       | [first_roll; second_roll] ->
         begin
           if Int.(first_roll < 1 || first_roll > 6 || second_roll < 1 || second_roll > 6) then
-            failwithf "invalid roll %i-%i" first_roll second_roll ();
+            raise_str (sprintf "invalid roll %i-%i" first_roll second_roll);
           if Int.equal first_roll second_roll then
             Some (Roll.Double first_roll)
           else if Int.(first_roll > second_roll) then
             Some (High_low (first_roll, second_roll))
           else
             Some (High_low (second_roll, first_roll))
         end
-      | _ -> failwith "unreachable"
+      | _ -> raise_str "unreachable"
     in
-    let bar_to_play_field, (points_fields, bar_not_to_play_field) =
+    let bar_not_to_play_field, (points_fields, bar_to_play_field) =
       List.split_n board_fields 1
-      |> Tuple2.map_fst ~f:List.hd_exn
-      |> Tuple2.map_snd ~f:(fun l -> List.split_n l 24)
-      |> Tuple2.map_snd ~f:(Tuple2.map_snd ~f:List.hd_exn)
-    in
-    let check_bar_field i =
-      if Int.(i < 0) then failwithf "negative number of counters on the bar %i" i ()
+      |> Tuple2.map_fst ~f:(Fn.compose Int.abs List.hd_exn)
+      |> Tuple2.map_snd ~f:(fun l ->
+        List.split_n l 24
+        |> Tuple2.map_snd ~f:(Fn.compose Int.abs List.hd_exn))
     in
-    check_bar_field bar_to_play_field;
-    check_bar_field bar_not_to_play_field;
     let bar =
       Per_player.create (fun player ->
         if Player.equal player to_play then bar_to_play_field else bar_not_to_play_field)
@@ -372,7 +370,8 @@ let of_snowie s =
             + List.fold points ~init:0 ~f:(fun total point -> total + Point.count point player))
         in
         if Int.(total_not_off > 15) then
-          failwithf "too many counters of player %c in play %i" (Player.char player) total_not_off ();
+          raise_str (
+            sprintf "too many counters of player %c in play %i" (Player.char player) total_not_off);
         Int.(15 - total_not_off))
     in
     { bar; off; points }, `To_play to_play, roll)

game.ml

@@ -178,34 +178,61 @@ let rec human ?history_position:history_position_opt ~stdin () player board roll
       printf "%s\n" (Error.to_string_hum err);
       human ~stdin () player board roll ~history
 
-let gnubg ~prog ~filename =
+let gnubg ~prog ~filename ~display =
   Process.create ~prog ~args:[] ()
   >>| function
   | Error err -> failwithf "Failed to run gnubg: %s." (Error.to_string_hum err) ()
   | Ok process ->
-  fun player board roll ~history:_ ->
-    Writer.save filename ~contents:(Board.to_snowie board ~to_play:player (Some roll))
-    >>= fun () ->
-    List.iter
-      [ sprintf "import snowietxt %s" filename
-      ; "play"
-      ; sprintf "export position snowietxt %s" filename
-      ; "help"
-      ]
-      ~f:(Writer.write_line (Process.stdin process));
-    Clock.after (sec 5.) (* CR jhilton: use Process.stdout *)
-    >>= fun () ->
-    Reader.file_contents filename
-    >>| fun new_board_snowie ->
-    match Board.of_snowie new_board_snowie with
-    | Error err -> failwithf "Failed to parse gnubg output: %s." (Error.to_string_hum err) ()
-    | Ok (new_board, `To_play to_play, _) ->
-      if Player.equal player to_play then failwith "Failed to receive gnugb output.";
-      let valid_boards = Move.all_legal_turn_outcomes roll player board in
-      if not (Set.exists valid_boards ~f:(Board.equal new_board)) then
-        failwith "Illegal move made by gnubg."
-      else
-        Ok (new_board, None)
+    Writer.write_line (Process.stdin process) "set automatic roll off";
+    fun player board roll ~history:_ ->
+      Writer.save filename ~contents:(Board.to_snowie board ~to_play:player (Some roll))
+      >>= fun () ->
+      List.iter
+        [ sprintf "import snowietxt %s" filename
+        ; "play"
+        ; sprintf "export position snowietxt %s" filename
+        ; "help help"
+        ]
+        ~f:(Writer.write_line (Process.stdin process));
+      Deferred.repeat_until_finished None (fun resignation_status ->
+        Reader.read_line (Process.stdout process)
+        >>= function
+        | `Ok line ->
+          begin
+            if display then printf "%s\n" line;
+            let new_resignation_status =
+              match resignation_status with
+              | Some outcome -> Some outcome
+              | None ->
+                let prefix = "offers to resign" in
+                if String.is_substring line ~substring:(sprintf "%s a single game" prefix) then
+                  Some Outcome.Game
+                else if String.is_substring line ~substring:(sprintf "%s a gammon" prefix) then
+                  Some Gammon
+                else if String.is_substring line ~substring:(sprintf "%s a backgammon" prefix) then
+                  Some Backgammon
+                else
+                  None
+            in
+            Deferred.return (
+              if String.is_prefix line ~prefix:"Usage: help" then
+                `Finished new_resignation_status else `Repeat new_resignation_status)
+          end
+        | `Eof -> failwith "Failed to keep gnubg running.")
+      >>= function
+      | Some outcome -> failwithf "implement how to resign%s" (Outcome.to_phrase outcome) ()
+      | None ->
+        Reader.file_contents filename
+        >>| fun new_board_snowie ->
+        match Board.of_snowie new_board_snowie with
+        | Error err -> failwithf "Failed to parse gnubg output: %s." (Error.to_string_hum err) ()
+        | Ok (new_board, `To_play to_play, _) ->
+          if Player.equal player to_play then failwith "Move not made by by gnugb.";
+          let valid_boards = Move.all_legal_turn_outcomes roll player board in
+          if not (Set.exists valid_boards ~f:(Board.equal new_board)) then
+            failwith "Illegal move made by gnubg."
+          else
+            Ok (new_board, None)
 
 let vs ts player = (Per_player.get ts player) player
 

game.mli

@@ -7,7 +7,7 @@ val of_equity : Equity.t -> t
 
 val human : ?history_position:int -> stdin:Reader.t -> unit -> t
 
-val gnubg : prog:string -> filename:string -> t Deferred.t
+val gnubg : prog:string -> filename:string -> display:bool -> t Deferred.t
 
 val vs : t Per_player.t -> t
 

main.ml

@@ -25,6 +25,7 @@ module Game_config = struct
     | Gnubg of
         { prog : string
         ; filename : string
+        ; display : bool
         }
     | Random
     | Pip_count_ratio of { look_ahead : int }
@@ -49,7 +50,7 @@ module Game_config = struct
     | Human ->
       let stdin = Lazy.force Reader.stdin in
       [], `Game (Deferred.return (Game.human ~history_position:0 ~stdin ()))
-    | Gnubg { prog; filename } -> [], `Game (Game.gnubg ~prog ~filename)
+    | Gnubg { prog; filename; display } -> [], `Game (Game.gnubg ~prog ~filename ~display)
     | Random -> [], `Equity (Equity.random)
     | Pip_count_ratio { look_ahead } ->
       [], `Equity (Equity.minimax Equity.pip_count_ratio ~look_ahead Game)