\ Sudoku-Solver
\ (c) by Christian Baumann, 0126091
\ s" d:\eigene dateien\tu\master\semester 3\stack\sudoku.fs" included

0 Value fd-in
9 Constant max-line
Variable cursor 81 cursor !
Create line-buffer max-line 2 + allot
Create grid 81 cells allot
Create gridrows 9 cells allot
Create gridcols 9 cells allot
Create region 9 cells allot
Create dir 2 cells allot s" d:\eigene dateien\tu\master\semester 3\stack\" dir 1 cells + ! dir !

\ helping words
: concat ( addr u addr u -- addr u)  
  2swap >r over r> dup rot +           \ calculate the length of the new string (remember on return-stack)
  dup >r allocate throw dup >r         \ allocate memory for the new string (remember on return-stack)
  swap dup >r cmove                    \ copy the first part of the string
  r> r> dup >r swap chars + swap cmove \ copy the second part string (with char-offset)
  r> r> ;                              \ return address and length of the new string

: clean-stack ( ?? -- ??)  begin -1 = until ;    \ remove remaining items from stack
: calc-index ( u u -- u )  swap 9 * + ;          \ calculate cell-index from i, j
: from-index ( u -- u u )  dup 9 / swap 9 mod ;  \ calculate i, j from cell-index
: calc-region ( u u -- u )  3 / swap 3 / 3 * + ; \ calculate region-index from i, j
: get-bin ( u -- u)  1 swap 1 - lshift ;         \ get bitvector representation of a number

: print-bin ( u -- )                             \ print numbers in a given bitvector (for debugging purposes)
  10 1 u+do
    dup i get-bin and if
      i .
    endif
  loop
  drop cr ;

\ words for storing/recalling values
: cur@ ( -- u ) cursor @ ;
: cur! ( u -- ) cursor ! ;
: grid@ ( u u -- u )  calc-index grid swap cells + @ ;
: grid! ( u u u -- u )  calc-index grid swap cells + ! ;
: row@ ( u -- u )  gridrows swap cells + @ ;
: row! ( u u -- ) gridrows swap cells + ! ;
: col@ ( u -- u )  gridcols swap cells + @ ;
: col! ( u u -- )  gridcols swap cells + ! ;
: region-idx@ ( u -- u )  region swap cells + @ ;
: region-idx! ( u u -- )  region swap cells + ! ;
: region@ ( u u -- u )  calc-region region-idx@ ;
: region! ( u u u -- )  calc-region region-idx! ;

\ words for accessing files
: set-dir ( addr u -- )  dir 1 cells + ! dir ! ;
: get-dir ( -- addr u )  dir @ dir 1 cells + @ ;
: get-file ( addr u -- addr u )  get-dir 2swap concat ;
: open-input ( addr u -- )  r/o open-file throw to fd-in ;
: close-input ( -- )  fd-in close-file throw ;

\ words for setting grid cells
: toggle-helpers  ( u u u -- )  { n i j }
  n get-bin
  i row@ over xor i row!
  j col@ over xor j col!
  i j region@ over xor i j region!
  drop ;

: put-item ( u u u -- )  { n i j } n i j grid! n i j toggle-helpers ;
: rem-item ( u u u -- )  { n i j } 0 i j grid! n i j toggle-helpers ;

\ check if a number can be put at given position (according to the rules)
: is-legal ( u u u -- f )  { n i j }
  i j grid@ 0 =
  n get-bin
  i row@ over and 0 = swap
  j col@ over and 0 = swap
  i j region@ over and 0 = nip
  and and and ;

: solve ( ?? -- f ) { n }
  n 0 < if
    true
  else
    10 1 u+do
      i n from-index is-legal if
        i n from-index put-item
        recurse if
          81 leave
        endif
        i n from-index rem-item
      endif
    loop
    dup 81 = if
      drop true
    else
      n false
    endif
  endif ;

: init-grid ( -- )
  9 0 u+do
    9 0 u+do
      0 i j grid!   \ init cell with 0
    loop
    0 i row!        \ init row-bitvector with 0
    0 i col!        \ init column-bitvector with 0
    0 i region-idx! \ init region-bitvector with 0
  loop ;

: print-grid ( -- )
  ." +-------+-------+-------+" cr
  9 0 u+do
    ." | "
    9 0 u+do
      j i calc-index cur@ 2dup = if
        2drop ." * "
      else
        > if
          ."   "
        else
          j i grid@ 
          dup 0 = if
              drop ." - "
          else
            .
          endif
        endif
      endif
      i 3 mod 2 = if
        ." | "
      endif
    loop
    cr
    i 3 mod 2 = if
      ." +-------+-------+-------+" cr
    endif
  loop ;

: print-solution ( -- )
  solve if                                \ if solution found
    ." Solution found!" cr print-grid     \ print the solution
  else
    ." No solution found." cr             \ no solution
  endif ;

\ init the grid from a file
: read-grid ( addr u -- ?? )
  init-grid open-input -1                                \ init the grid, open input file
  9 0 u+do
    line-buffer max-line 2 + fd-in read-line throw 2drop \ read the next line from the file
    9 0 u+do
      line-buffer i chars + c@                           \ read single character from the line
      dup 45 = if                                        \ == "-"
        drop j i calc-index 0                            \ push index of cell on the stack, cell value is 0
      else
        48 -                                             \ calculate cell value
      endif
      j i put-item                                       \ store value in the grid
    loop
  loop close-input ;                                     \ close file

\ init the grid from the input
: scan-grid ( -- )
  init-grid page 0 cur! -1 begin
    page print-grid
    cur@ from-index dup 3 / + 2 * 2 + swap dup 3 / + 1 + at-xy
    key dup 27 = if                                      \ ESC pressed
      drop page 0 0 at-xy clean-stack unloop exit
    else dup 8 = if                                      \ Backspace pressed
      drop cur@ 0 > if
        dup cur@ tuck 1 - = if
          nip
        endif
        2 - cur!
      endif
    else dup 48 > over 57 <= and if                      \ 48 < x <= 57 (numbers 1 to 9)
      48 -                                               \ calculate cell value
    else
      drop cur@ 0                                        \ push index of cell on the stack, cell value is 0
    endif
      cur@ from-index put-item                           \ store value in the grid
    endif endif
    cur@ 1 + dup cur! 81 >=
  until
  page 81 cur! print-grid 0 13 at-xy ;

\ main words
: sudoku ( addr u -- )  cr get-file read-grid print-grid print-solution ; \ solve sudoku from file
: sudoku-scan ( -- )  scan-grid print-solution ;                          \ solve sudoku from manual input

\ shortcut words
: run sudoku-scan ;
: run1 s" puzzle1.txt" sudoku ;
: run2 s" puzzle2.txt" sudoku ;
: run3 s" puzzle3.txt" sudoku ;
: run4 s" puzzle4.txt" sudoku ;
: run5 s" puzzle5.txt" sudoku ;
: run6 s" puzzle6.txt" sudoku ;
: run7 s" puzzle7.txt" sudoku ;
: run8 s" puzzle8.txt" sudoku ;

cr cr ." The current directory is " get-dir type cr \ run1