/// Ray tracer in F#
/// (C) Flying Frog Consultancy Ltd., 2007
/// http://www.ffconsultancy.com

open System.Drawing
open System.Windows.Forms
open System.Threading

let size = 3

let size2 = size * size

// Currently running solver, if any
let solver : Thread option ref = ref None

// Remove our reference to the solver thread
let clear() = Idioms.lock solver (fun _ -> solver := None)

// Abort any solver thread and then clear it
let reset() = Idioms.lock solver (fun _ -> !solver |> Option.iter (fun s -> s.Abort()); clear())

// Input puzzle
let example = [|[|0;0;0;0;6;0;4;0;0|];
                [|0;5;0;0;0;3;6;0;0|];
                [|1;0;0;0;0;5;0;0;0|];
                [|0;4;1;0;0;0;0;0;0|];
                [|0;9;0;0;0;0;0;2;0|];
                [|5;0;2;0;0;0;3;4;0|];
                [|3;0;0;7;0;0;0;0;0|];
                [|0;0;6;5;0;0;0;9;0|];
                [|0;0;4;0;1;0;0;0;0|]|]
let puzzle = Array.init size2 (fun y -> Array.init size2 (fun x -> try example.(y).(x) with _ -> 0))

// Size of an entry on the puzzle
let s = 32

let mutable quit = false

let init_control (c : #Control) x y text =
  c.Bounds <- new Rectangle(16 + x * s + 1, 16 + y * s + 1, s - 1, s - 1);
  c.Text <- (match puzzle.(y).(x) with 0 -> "" | n -> string_of_int n);
  c.Font <- new System.Drawing.Font("Microsoft Sans Serif", 12.f, FontStyle.Regular, GraphicsUnit.Point, Byte.of_int 0)

// An entry in the solution window
type SolutionEntry =
  class
    inherit Label

    new (x, y) as this = {} then
      init_control this x y "";
      this.BorderStyle <- BorderStyle.Fixed3D;
      this.TextAlign <- ContentAlignment.MiddleCenter

    override this.OnKeyDown(e) = if e.KeyCode = Keys.Escape then Application.Exit()
  end

// Output solution
let solution = Array.mapi (fun y row -> Array.mapi (fun x _ -> new SolutionEntry(x, y)) row) puzzle

// Check if "n" is valid at position "x", "y" on the board "m", starting with "i=0"
let rec invalid m i x y n =
  i < size2 && (m.(y).(i) = n || m.(i).(x) = n ||
      m.(y / size * size + i / size).(x / size * size + i % size) = n || invalid m (i + 1) x y n)

// Recursively search every valid entry at every non-empty puzzle position
let rec search x y f accu m = match x, y with
  | x, y when x = size2 -> search 0 (y + 1) f accu m
  | 0, y when y = size2 -> f accu
  | x, y when m.(y).(x) <> 0 -> search (x + 1) y f accu m
  | x, y ->
      let aux accu n =
        if invalid m 0 x y n then accu else
          (m.(y).(x) <- n;
           let accu = search (x + 1) y f accu m in
           m.(y).(x) <- 0;
           accu) in
      IEnumerable.fold aux accu (IEnumerable.init_finite 9 (fun i -> i + 1))

// Spawn a thread to solve the puzzle
let solve() =
  Idioms.lock solver (fun _ -> !solver |> Option.iter (fun s -> s.Abort()); clear());
  Array.iteri (fun y row -> Array.iteri (fun x n -> solution.(y).(x).Text <- "") row) puzzle;
  let aux _ =
    // Take a copy of the puzzle
    let m = Array.map Array.copy puzzle in
    try
      // Search for solutions, filling in the copy of the puzzle
      search 0 0 (fun s -> raise Exit) () m;
      // No solutions
      clear()
    with Exit ->
      // m contains the first solution
      Idioms.lock solution (fun () -> Array.iteri (fun y row -> Array.iteri (fun x n -> solution.(y).(x).Text <- string_of_int n) row) m);
      clear() in
  let thread = new Thread(new ThreadStart(aux)) in
  thread.Start();
  solver := Some thread

// Given a char that has been pressed, set the puzzle entry and return the text equivalent
let set x y = function
  | '1'..'9' as k ->
      puzzle.(y).(x) <- int_of_char k - int_of_char '0';
      String.make 1 k
  | _ ->
      puzzle.(y).(x) <- 0;
      ""

// An entry in the puzzle window
type PuzzleEntry =
  class
    inherit TextBox

    val set : char -> string

    new (x, y) as this = { set = set x y } then
      init_control this x y (match puzzle.(y).(x) with 0 -> "" | n -> string_of_int n);
      this.TextAlign <- HorizontalAlignment.Center

    override this.OnKeyDown(e) =
      if e.KeyCode = Keys.Escape then Application.Exit();
      ignore (this.set (char_of_int e.KeyValue));
      this.Text <- ""

    override this.OnKeyUp(e) =
      this.Text <- this.set (char_of_int e.KeyValue);
      solve()
  end

// The puzzle input window
type Window =
  class
    inherit Form

    new(widget, text) as this = {} then
      let rec aux n =
        if n < size2*size2 then (widget(this, n % size2, n / size2); aux(n + 1)) in
      aux 0;
      this.Text <- "Sudoku Puzzle";
      this.Size <- new Size(32 + 32 * size2 + 8, 32 + 32 * size2 + 42);
      this.MinimumSize <- this.Size;
      this.MaximumSize <- this.Size;
      this.Show()

    override form.OnPaint(e) =
      // Draw a grid to highlight the sub-squares
      let w = float32(s * size2) in
      for n=0 to size do
        let x = float32_of_int(16 + s * n * size) in
        e.Graphics.DrawLine(new Pen(Color.Black), 16.f, x, 16.f + w, x);
        e.Graphics.DrawLine(new Pen(Color.Black), x, 16.f, x, 16.f + w)
      done

    override form.OnKeyDown(e) = if e.KeyCode = Keys.Escape then Application.Exit()
    
    override form.OnClosed(_) = Application.Exit()
  end

let input = new Window((fun(form, x, y) -> form.Controls.Add(new PuzzleEntry(x, y))), "Sudoku Puzzle")
let output = new Window((fun(form, x, y) -> form.Controls.Add(solution.(y).(x))), "Sudoku Solution")

do solve()

do Application.Run()