#!/usr/bin/rebol
Rebol [
    title: "Sudoku-bol"
    author: "Frank Sievertsen"
    purpose: "Sudoku Solver and Gererator"
    version: 1.0.3
    comments: {
        Divided cleanly into the game-engine (sudoku-game object) and the gui.
        
        Both written by me, I put them into one file for simple distribution.
        
        sudoku-game object has some additional functions to make it easy to use in other programs. (printout, readin for example)
        
        You can use this program to solve the sudoku-game in your newspaper, too.
        
        Now with undo and redo.
    }
]

random/seed now

sudoku-game: context [
    board: array 9 * 9
    
    column: func [
        "Returns a column of the board"
        num [integer!]
        /local out
    ] [
        if any [
            num < 0
            num > 9
        ] [
            make error! "column"
        ]
        extract (at board num) 9
    ]
    
    row: func [
        "Returns a row of the board"
        num [integer!]
    ] [
        if any [
            num < 0
            num > 9
        ] [
            make error! "row"
        ]
        copy/part skip board num - 1 * 9 9
    ]
    field: func [
        "Returns the values of a 3x3 field"
        num [integer!]
        /local x y out
    ] [
        x: num - 1 // 3 + 1
        y: (to-integer num - 1 / 3) * 3 + 1
        out: copy []
        for z y (y + 2) 1 [
            append out copy/part skip row z (x - 1 * 3) 3
        ]
        out
    ]
    
    one9: func [
        "Returns the numbers 1 - 9 randomized, used to implement the generator"
    ] [
        random [1 2 3 4 5 6 7 8 9]
    ]

    legal?: func [
        "Is the block (3x3, line or row) ok?"
        block [block!]
        /local x pos
    ] [
        repeat x 9 [
            pos: block
            if pos: find block x [
                if find next pos x [return false]
            ] 
        ]
        true
    ]
    
    all-legal?: func [
        "Are all lines, rows and 3x3-field ok?"
    ] [
        repeat x 9 [
            if not all [
                legal? row x
                legal? column x
                legal? field x
            ] [return false] 
        ]
        true
    ]
    
    full?: func [
        "Is the board filled up?"
    ] [
        not find board none
    ]
    
    step: func [
        "returns all possibilities to add a number to the first free cell on the board"
        /local x pos out neu poses
    ] [
        if full? [return copy []]
        
        pos: index? find board none
        out: copy []
        
        repeat z one9 [
            poke board pos z
            if all-legal? [append out make self []]         
        ]
        poke board pos none
        
        out
    ]

    get-xy: func [
        "returns cell-number for x,y"
        x [integer!]
        y [integer!]
    ] [
        y - 1 * 9 + x
    ]
    
    get-xy-val: func [
        "returns cell for x,y"
        x [integer!]
        y [integer!]
    ] [
        pick board get-xy x y
    ]
    
    field-xy: func [
        "Retuns the 3x3-field around x,y"
        x y
        /local z
    ] [
        field (to-integer y - 1 / 3) * 3 + (to-integer x - 1 / 3) + 1
    ]
    

    solve: func [
        {Solve the game by depth-first left-to-right and backtracking
         and uses 'deduce to speedup process}

        /callback
            cb [function!]
        
        /local bag tester fertig not-deduce
    ] [
        fertig: copy []
        if not all-legal? [return none]
        bag: reduce [self]
        not-deduce: 0
            ; Not-decuce prevents the solver from beeing slowed down by the deducer
            ; when it is unable to deduce
        forever [
            if empty? bag [return none]
            tester: last bag
            if callback [cb tester]
            if tester/full? [return tester]
            either all [not-deduce <= 0 deduce] [
                ; Conclude ok
            ] [
                ; Conclude fail
                
                if not-deduce <= 0 [not-deduce: 10]
                not-deduce: not-deduce - 1
                remove back tail bag    
                append bag tester/step step
            ]
        ]
    ]
    
    comment {
        Speedup-Functions, you could replace them by
            decuce: none
        while step only fills in numbers by trial and error and backtracking,
        this one tries to fill in the correct numbers in every step.
    }
    
    deduce: func [
        "Tries to fill in a number in a free cell by searching for fields where only one number is allowed"
        /local p1 p2 p3 t1 t2
    ] [
        repeat y one9 [
            p1: copy []
            p2: copy []
            p3: copy []
            repeat x one9 [
                repend p1 [y x]
                repend p2 [x y]
            ]
            repeat y2 3 [ repeat x2 3 [
                repend p3 [
                    (y - 1 // 3) * 3 + x2
                    (to-integer y - 1 / 3) * 3 + y2 
                ]
            ]]

            if t1: any [
                deduce2 p1
                deduce2 p2
                deduce2 p3
            ] [return t1]
        ]
        false
    ]
    
    deduce2: func [
        coordinates
        /local count mem
    ] [
        repeat z one9 [
            count: 0
            foreach [x y] coordinates [
                if none? pick board get-xy x y [
                    poke board get-xy x y z
                    if all [
                        legal? row y
                        legal? column x
                        legal? field-xy x y
                    ] [
                        count: count + 1
                        mem: reduce [x y]
                    ]
                    poke board get-xy x y none
                ]
            ]
            if count = 1 [
                poke board get-xy mem/1 mem/2 z
                return true
            ]
        ]
    ]
    
    
    printout: func [
        "Returns a string with a representation of the board"
        /local out
    ] [
        out: copy ""
        repeat z 9 [
            append out form replace/all row z none "?"
            append out newline
        ]
        out
    ]
    readin: func [
        "Takes a string with the representation of the board and insertes it into the board"
        str [string!]
        /local c
    ] [
        str: copy str
        str: trim/all str
        if (length? str) <> (9 * 9) [make error! "readin"]
        if not find charset [#"1" - #"9" "?"] str [make error! "readin"]
        c: 0
        foreach chr str [
            c: c + 1
            either chr = #"?" [
                poke board c none
            ] [
                poke board c to-integer to-string chr
            ]
        
        ]
    ]
    empty: func [
        "How many fields are empty?"
        /local p c
    ] [
        p: board
        c: 0
        while [p: find p none] [
            p: next p
            c: c + 1
        ]
        c
    ]
    
    removing?: no           ; Is the generator removing numbers?
    
    generate: func [
        "The generator is quite simple, because i randomized the solver"
        empty [integer!] "Number of empty fields on the board"
        
        /callback
            cb [function!]
        /local mem mem2 count t xy x y pos
    ] [
    
        removing?: no
        
        ; First we solve an empty board
        
        pos: board
        forall pos [pos/1: none]
        
        t: either callback [solve/callback :cb] [solve]
        
        removing?: yes
        
        ; Now we remove numbers as long as we can still use deduce to solve the board
        board: t/board
        count: 0
        xy: copy []
        repeat x one9 [
            repeat y one9 [
                repend/only xy [x y]
            ]
        ]
        xy: random xy
        foreach xy xy [
                x: xy/1 y: xy/2
                either callback [cb self]
                mem: copy board
                poke board y - 1 * 9 + x none
                mem2: copy board
                count: count + 1
                either loop count [if not deduce [break/return none] 1] [
                    board: mem2
                ] [
                    board: mem
                    count: count - 1
                ]   
                if count >= empty [break]
        ]
        self
    ]
    
]


; AND NOW THE GUI

undos: copy []
redos: copy []

save-undo: func [] [
    clear redos
    if any [
        empty? undos
        (last undos) <> sudoku-game/board
    ] [append/only undos copy sudoku-game/board]
]

undo: func [/local val] [
    if any [
        empty? redos
        (last redos) <> sudoku-game/board
    ] [append/only redos copy sudoku-game/board]
    
    while [not empty? undos] [
        val: last undos
        remove back tail undos
        if val <> sudoku-game/board [
            sudoku-game/board: val
            show sudoku-panel
            exit
        ]
    ]
]
redo: func [/local tmp] [
    tmp: redos redos: undos undos: tmp
    undo
    tmp: redos redos: undos undos: tmp
]

active-sudoku-cell: none
sudoku-styles: stylize [
    sudoku-cell: txt
                40x40
                edge [size: 2x2]
                font [
                    size: 20
                    align: 'center
                    valign: 'middle
                ]
                with [
                    sudoku-offset: func [] [offset / (size + 20x20) + 1x1]
                    state: no
                    highlight: no
                    locked: no
                ]
                feel [
                    redraw: func [face action] [
                        face/text: form any [
                             sudoku-game/get-xy-val
                            (first face/sudoku-offset)
                            (second face/sudoku-offset)
                             ""
                        ]
                        face/edge/effect: pick [ibevel bevel] face/state
                        face/color: if face/highlight [red + 200.200.200]
                        
                        face/font/color: pick [0.0.0 0.0.250] face/locked
                        system/view/caret: tail face/text
                        system/view/highlight-start: face/text
                        system/view/highlight-end: tail face/text
                    ]
                    engage: func [face action event /local offset] [
                        if action = 'down [
                            focus face
                            if active-sudoku-cell [
                                active-sudoku-cell/state: no
                                show active-sudoku-cell
                            ]
                            face/state: yes
                            active-sudoku-cell: face
                            show face
                        ]
                        if action = 'key [
                            if all [
                                find "^H^~ " event/key
                                not face/locked
                            ] [
                                save-undo
                                poke
                                    sudoku-game/board
                                    sudoku-game/get-xy
                                        (first face/sudoku-offset)
                                        (second face/sudoku-offset)
                                    none
                                show face
                            ]
                            if all [
                                find "123456789" event/key
                                not face/locked
                            ] [
                                save-undo
                                poke
                                    sudoku-game/board
                                    sudoku-game/get-xy
                                        (first face/sudoku-offset)
                                        (second face/sudoku-offset)
                                    to-integer to-string event/key
                                show face
                            ]
                            if offset: select [
                                up 0x-1
                                left -1x0
                                down 0x1
                                right 1x0
                            ] event/key [
                                foreach f face/parent-face/pane [
                                    if face/size + 20 * offset + face/offset = f/offset [
                                        f/feel/engage f 'down none
                                        break
                                    ]
                                ]
                            ]
                        ]
                    ]
                ]

    sudoku-col: image 4x520 100.100.200
    
    sudoku-row: sudoku-col with [size: reverse size]
]


layout-def: copy [
    across
    space 20
    origin 10
    
    styles sudoku-styles
]

loop 9 [
    loop 9 [
        append layout-def [sudoku-cell]
    ]
    append layout-def [return]
]

repeat z 2 [
    offset: sudoku-styles/sudoku-cell/size + 20 * z * 3 - 12
    append layout-def compose [
        at (offset * 1x0 + 10) sudoku-col
        at (offset * 0x1 + 10) sudoku-row
    ]
]

generate-hardness: 20

view layout [
    style tog tog 130
    style btn btn 130
    
    at 10x10
    sudoku-panel: panel 540x540 layout-def
    return
    drop-down "Beginner" "Advanced" "Expert" 130 [error? try [
        generate-hardness: pick [20 35 50] index? find face/list-data value
    ]]
    btn "Generate board" #"^G" [use [c prg new] [
        save-undo
        win: view/new center-face layout [
            txt "Generating board..."
            prg: progress 300   
        ]
        c: 0
        new: sudoku-game/generate/callback generate-hardness func [t] [
            c: c + 1
            if c // 10 = 0 [
                either t/removing? [
                    prg/data: (t/empty / 50) / 2 + ,5
                ] [
                    prg/data: (81 - t/empty) / 81 / 2
                ]
                show prg
                wait 0
            ]
        ]
        unview/only win
        either new [
            sudoku-game: new
        ] [
            request/ok "Generation failed."
        ]
        show sudoku-panel
        lock-tog/state: lock-tog/data: yes
        show lock-tog
        do-face lock-tog yes
    ]]
    btn "Solve board" #"^S" [use [c prg new win] [
        save-undo
        win: view/new center-face layout [
            txt "Solving..."
            prg: progress 300   
        ]
        c: 0
        new: sudoku-game/solve/callback func [t] [
            c: c + 1
            if c // 40 = 0 [
                prg/data: (81 - t/empty) / 81
                show prg
                wait 0
            ]
        ]
        unview/only win
        either new [
            sudoku-game: new
        ] [
            request/ok "Not solvable."
        ]
        show sudoku-panel
    ]]
    lock-tog: tog "Lock" "Unlock" [
        foreach face sudoku-panel/pane [
            if face/style = 'sudoku-cell [
                either value [
                    face/locked: face/text <> ""
                ] [
                    face/locked: no
                ]
                show face
            ]
        ]
    ]
    
    btn "Clean up board" #"^C" [
        save-undo
        repeat z 9 * 9 [
            if not get in (pick sudoku-panel/pane z) 'locked [
                poke sudoku-game/board z none
            ]
        ]
        show sudoku-panel
    ]
    
    btn "Give hint" #"^H" [use [tmp-game count f] [
        tmp-game: make sudoku-game []
        repeat z 9 * 9 [
            f: pick sudoku-panel/pane z
            f/highlight: no
            show f
        ]
        either tmp-game/deduce [
            count: 0
            until [
                count: count + 1
                (pick tmp-game/board count) <> (pick sudoku-game/board count)
            ]
            f: pick sudoku-panel/pane count
            f/highlight: yes
            f/feel/engage f 'down none
            show f
        ] [
            request/ok "Hint not found, sorry."
        ]
    ]]
    panel 150x22 [
        style btn btn 60
        across
        btn "Undo" #"^Z" [undo]
        btn "Redo" #"^Y" [redo]
    ]
    ;pad 0x10
    panel 40x32 * 3x4 - 10x10 [
        space 10
        style num-btn btn 30 [use [val] [
            if active-sudoku-cell [
                val: #" "
                if find "123456789" first face/text [
                    val: first face/text
                ]
                active-sudoku-cell/feel/engage active-sudoku-cell 'key make object! [
                    key: val
                ]
            ]
        ]]
        across
        num-btn "1" num-btn "2" num-btn "3"
        return
        num-btn "4" num-btn "5" num-btn "6"
        return
        num-btn "7" num-btn "8" num-btn "9"
        return
        num-btn "CLR" 80
    ]
    
    ;pad 0x10
    
    txt 160 {
        Welcome to sudoku-bol. Use the generate-button to make a new board. You can use the solve-button
        to solve the game. The lock-button will lock/unlock all used board-cells. The hint-button will shows a cell to start with. Use can control the program by keyboard (1-9, space, cursor-keys) or by mouse (see buttons above). Have fun, Frank (FX5)
    }
]