open Types
open Board
open Map_analyze
open Protocol
open Printer

let rec string_of_int_list_limited limit = function
    [] -> ""
  | [e] -> string_of_int e
  | e::tl -> 
      if limit = 0 then "..."
      else string_of_int e ^ " "
	^ string_of_int_list_limited (limit - 1) tl

let stat_string c id robot = 
  Printf.sprintf "%c: #%d  at %s, belonging %s"
    c id (print_loc robot.robot_loc)
    (string_of_int_list_limited 7 (intset_to_list robot.own))

let print_pack id = 
  match IntMap.find id !packs with
    (Some { dest = dest; weight = w }, _) ->
      Printf.printf "pack #%d  %2dKg, to %s\n"
	id w (print_loc dest)
  | _ ->
      Printf.printf "pack #%d  unknown\n"
	id

let print_belonging () = 
  let my_pack = my_pack () in
  print_string "Listing of your belongings:\n";
  IntSet.iter
    (fun id -> print_pack id)
    my_pack;
  Printf.printf "... %d object(s) in your hands.\n"
    (IntSet.cardinal my_pack)

let parse_loc_set args = 
  let rec iter acc = 
    function
	x :: y :: rest ->
	  let x, y = int_of_string x, int_of_string y in
	  let acc = IntSet.add (fastloc_of_loc (x, y)) acc in
	  iter acc rest
      | [] -> acc
      | _ -> failwith "odd number?"
  in
  iter IntSet.empty args

let create_map_array f =
  let map = !board in
  let width, height = !board_width, !board_height in
  let output = Array.init (height + 2)
      (fun _ -> String.make (width + 2) ' ') in
  for y = 0 to height + 1 do
    for x = 0 to width + 1 do
      output.(y).[x] <- f (x, y)
    done;
  done;
  output

let print_map_array o = 
  let height = !board_height in
  for y = 0 to height + 1 do
    print_endline o.(height + 1 - y);
  done

let print_map () =
  let map = !board in
  let width, height = !board_width, !board_height in
  if height = 0 then
    print_string "[empty]\n"
  else begin
    (* MAP *)
    let output = 
      create_map_array 
	(fun (x, y) -> print_map_elem map.(y).(x)) in
    
    (* PACKS *)
    let add_pack n ( _, pack_loc ) =
      match pack_loc with
	No -> ()
      |	Yes( x, y ) -> output.(y).[x] <- '*'
      |	Maybe( x, y ) -> 
	  if output.(y).[x] <> '*' then output.(y).[x] <- '?'
    in
    IntMap.iter add_pack !packs;

    (* DROP TARGET *)
    let my_pack = my_pack () in
    IntSet.iter
      (fun id ->
	match IntMap.find id !packs with
	  (Some { dest = (x, y) }, _) ->
	    output.(y).[x] <- '+'
	| _ -> ()) my_pack;

    (* ROBOT INFO *)
    let stats = Array.create (height + 2) "" in
    let n = ref 0 in
    IntMap.iter
      (fun id record ->
	if id <> !my_id then begin
	  let char = Char.chr (0x30 + id mod 10) in
	  let x, y = record.robot_loc in
	  output.(y).[x] <- char;
	  if !n < !board_height then
	    stats.(!n + 2) <- stat_string char id record;
	  incr n
	end)
      !robots;
    stats.(0) <- stat_string '&' (!my_id) (IntMap.find !my_id !robots);
    stats.(1) <- Printf.sprintf "money: $%d" !money;
    begin
      let x, y = my_loc () in
      output.(y).[x] <- '&';
    end;

    for y = 0 to height + 1 do
      Printf.printf "%s %s\n" output.(height + 1 - y) stats.(y);
    done;

    (* OBJS ON FLOOR *)
    begin
      let packs = !packs_here in
      let size = IntSet.cardinal packs in
      if size = 0 then
	print_newline ()
      else begin
	let s, fst = Buffer.create 80, ref true in
	Printf.bprintf s "%d obj(s) (#" size;
	let add id = 
	  if Buffer.length s > 50 then
	    (Buffer.add_string s ",..."; raise Exit)
	  else begin
	    if !fst then
	      fst := false
	    else
	      Buffer.add_string s ",";
	    Buffer.add_string s (string_of_int id)
	  end
	in
	(try IntSet.iter add packs with Exit -> ());
	Buffer.add_string s ") on floor.";
	print_endline (Buffer.contents s);
	Buffer.clear s;
      end
    end
  end

let map_print_mode = ref true

let map_repeat_print_mode = ref false

let set_map_mode rest =
  let m, r = 
    match rest with
      ["TRUE" | "ON" | "YES"] -> true, false
    | ["REPEAT"] -> true, true
    | ["FALSE" | "OFF" | "NO"] -> false, false
    | _ -> failwith "SET MAP <arg>: arg = ON | OFF | REPEAT"
  in
  map_print_mode := m;
  map_repeat_print_mode := r

let adjustment_function = ref Dijkstra.adjustment_singleplay

let set_dijkstra_mode rest =
  adjustment_function :=
    match rest with
      ["MULTI"] -> Dijkstra.adjustment_multiplay
    | ["SINGLE"] -> Dijkstra.adjustment_singleplay
    | _ -> failwith "SET DIJKSTRA <arg>: arg = MULTI | SINGLE"

let set_mode rest = 
  match rest with
    "DIJKSTRA" :: rest -> set_dijkstra_mode rest
  | "MAP" :: rest -> set_map_mode rest
  | _ -> failwith "SET <cmds> <args>: cmds = DIJKSTRA | MAP"

let print_direction d m = 
  match d with
    N :: _ -> 'A'
  | S :: _ -> 'V'
  | E :: _ -> '>'
  | W :: _ -> '<'
  | [] -> print_map_elem m

let print_direction_map starts (dist, dt) = 
  let width, height = !board_width, !board_height in
  if height = 0 then
    print_string "[empty]\n"
  else begin
    let output = create_map_array
	(fun (x, y) -> 
	  let loc = fastloc_of_loc (x, y) in
	  if IntSet.mem loc starts then 'S'
	  else
	    print_direction
	      (if (y > height || x > width || dist.(loc) >= Dijkstra.infty)
	      then [] else [dt.(loc)])
	      !fast_board.(loc));
    in
    print_map_array output
  end

let print_floor_weight_map () = 
  print_endline
    "Map of floor weight.   1     2     3     4     5     6     7  ";
  print_endline
    "                     ? - 0-9   A-E   F-J   K-O   P-T   U-Y   Z";
  let output = create_map_array
      (fun (x, y) ->
	let m = !Map_analyze.fast_board.(fastloc_of_loc (x, y)) in
	let d = !Map_analyze.weight_map.(fastloc_of_loc (x, y)) in
	if Map_analyze.is_blocked m then
	  print_map_elem m
	else if d < 1.0 then 'O' (*should not happen*)
	else if d = 1.0 then '-'
	else if d < 2.0 then Char.chr (0x30 + (truncate (d *. 10. -. 10.)))
	else if d < 7.0 then Char.chr (0x41 + (truncate (d *. 5. -. 10.)))
	else 'Z')
  in
  print_map_array output

let parse_objs args default =
  match args with
    [] -> failwith "valid args: 'ALL' (A), 'NONE' (N) or integers"
  | ["A" | "ALL"] ->
      let default = intset_to_list default in
      default
  | ["N" | "NONE"] ->
      []
  | args -> 
      List.map int_of_string args

let print_floor args = 
  match args with
    ["D" | "DETAIL"] -> 
      Printf.printf "Detailed listing of the packs on floor at %s:\n"
	(print_loc (my_loc ()));
      IntSet.iter print_pack !packs_here;
      Printf.printf "... %d object(s) here.\n" (IntSet.cardinal !packs_here)
  | [] ->
      let size = IntSet.cardinal !packs_here in
      let fst = ref true in
      Printf.printf "%d objs (#" size;
      let p id = 
	if !fst then
	  fst := false
	else
	  print_string ",";
	print_int id
      in
      IntSet.iter p !packs_here;
      print_endline ") on floor."
  | ["WEIGHT"] -> print_floor_weight_map ()
  | _ -> failwith "FLOOR [optional DETAIL]"

let packs_locs () = 
    IntMap.fold
    (fun id info set ->
      try
	match info with
	  (Some { dest = p }, _) -> 
	    IntSet.add (fastloc_of_loc p) set
	| _ -> set
      with
	Not_found -> set)
    !packs IntSet.empty 

let solve_maze rest = 
  let d_limit, starts, target = 
    match rest with
      [] -> None, None, None
    | ["PACK-DEST"] -> None, None, Some (packs_locs ())
    | (s :: "FROM" :: rest) -> Some (float_of_string s), Some (parse_loc_set rest), None
    | [s] -> Some (float_of_string s), None, None
    | _ -> failwith "usage: DIJKSTRA <optional limit | PACK-DEST | limit FROM locs>"
  in
  let loc = my_loc () in
  print_string "solving maze..."; flush stdout;
  let d =
    match starts, target with 
      None, None -> Dijkstra.dijkstra ?d_limit ~adjustment:!adjustment_function loc
    | None, Some s -> Dijkstra.dijkstra_stopset ~adjustment:!adjustment_function loc s
    | Some set, None -> Dijkstra.dijkstra_multi ?d_limit ~adjustment:!adjustment_function set
    | _ -> failwith "why? not implemented."
  in
  print_endline "done.";
  let start_set = match starts with
    None -> IntSet.singleton (fastloc_of_loc loc)
  | Some s -> s
  in
  print_direction_map start_set d
    
let help () =
  List.iter print_endline 
    [ "Moving:";
      "\tN(orth), S(outh), E(ast), W(est):  Go that direction";
      "\tH, J, K, L                      :  Vi binding :-)";
      "Package Handling:";
      "\tP(ick) < A(ll) | N(one) | list of ids >: Pick packages";
      "\tD(rip) < A(ll) | N(one) | list of ids >: Drop packages";
      "Repeation:";
      "\tR(epeat) <count> <command> : Repeat Move/Package command";
      "";
      "Status:";
      "\tM(ap)        : Show map";
      "\tB(elongings) : Show your own packages";
      "\tF(loor)      : Show packages under yout foot";
      "\tF(loor) D(etail) : Show status of packages under yout foot";
(*      "\tPACKS            : Show status of all packages"; *)
      "Other Commands:";
      "\tQ(uit) : Quit game";
      "\tDIJKSTRA: Show shortest-path map from your location";
      "\tSET DIJKSTRA (MULTI | SINGLE): Set dijkstra pathsearcher's mode";
      "\tSET MAP (ON | OFF | REPEAT): Set auto map display preference";
      "\tFLOOR-WEIGHT: Show floor weight for multiplay"
    ]

let parse_input line = 
  let line = List.map String.uppercase line in
  try begin
    match line with
      [] -> raise Exit
    | hd::rest ->
	let bid, cmds = 
	  try int_of_string (hd), rest with
	    Failure _ -> 1, line
	in
	let rec action repeat cmds = match cmds with
	  [] -> raise Exit
	| ["N" | "K" | "NORTH"] -> 1, Move N
	| ["S" | "J" | "SOUTH"] -> 1, Move S
	| ["E" | "L" | "EAST"] -> 1, Move E
	| ["W" | "H" | "WEST"] -> 1, Move W
	| ("P" | "PICK") :: rest -> 1, Pick (parse_objs rest (!packs_here))
	| ("D" | "DROP") :: rest -> 1, Drop (parse_objs rest (my_pack ()))
	| _ when repeat -> failwith "bad command"
	| ("R" | "REPEAT") :: cnt :: rest -> begin
	    let rep = int_of_string cnt in
	    if rep < 1 then failwith "bad repeat count";
	    let _, cmd = action true rest in
	    rep, cmd
	end
	| ["M" | "MAP"] -> print_map (); raise Exit
	| ["B" | "BELONGINGS"] -> print_belonging (); raise Exit
	| ("F" | "FLOOR")::rest -> print_floor rest; raise Exit
	| ["?" | "HELP"] -> help (); raise Exit
	| ["Q" | "QUIT"] -> exit 0
	| ("DIJKSTRA" | "SHORTEST_PATH") :: rest ->
	    solve_maze rest; raise Exit
	| ["FLOOR-WEIGHT"] ->
	    print_floor_weight_map (); raise Exit
	| "SET" :: rest ->
	    set_mode rest; raise Exit
	| _ -> failwith "bad command"
	in
	let rep, act = action false cmds in
	Some (bid, rep, act)
  end
  with
    Exit -> None
  | Failure s -> 
      print_endline ("Command Error: " ^ s); None

let play argv = 
  try
    if (not !Protocol.is_open) then
	Protocol.init argv;
    map_print_mode := !board_width < 120 && !board_height < 75;
    if (!map_print_mode) then 
      print_map ()
    else
      print_endline 
	"Info: auto map display disabled. Use \"X SET MAP ON\" if you want.";
    while(IntMap.mem !my_id !robots) do
      let rec get_cmd () = 
	print_string "Command >"; flush stdout;
	let line = Pervasives.read_line () in
	let line = (Protocol.split line) in
	match parse_input line with
	  None -> get_cmd ()
	| Some cmd -> cmd
      in
      let n, rep, a = get_cmd () in
      for i = 1 to rep do
	try
	  Protocol.send_cmd n a;
	  if !map_print_mode && !map_repeat_print_mode then print_map ();
	with
	  End_of_file ->
	    print_endline "Your robot has ascended (or server shutdown).";
	    Protocol.close ();
	    raise Exit
      done;
      if !map_print_mode && (not !map_repeat_print_mode) then print_map ();
    done;
    print_endline "Your robot has vanished!?"
  with
    Exit -> ()

let _ = 
  if not !Sys.interactive then 
    play Sys.argv