#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh $0 ${1+"$@"}

# parse_line --
#
#   looks at one line
#
# Arguments:
#   line        the line to be parsed
#   linenumber  its number
# Results:
#   Returns true upon succesful parsing
#
proc parse_line {line linenumber arrayname sokoposname} {
    upvar 1 $arrayname array
    upvar 1 $sokoposname sokopos

    for {set i 0} {$i < [string length $line]} {incr i} {
        set char [string index $line $i]

        if {[string match {[# $*.@+]} $char]} {
            set array([list $i $linenumber]) $char
            if {$char == "@" || $char == "+"} {
                if {[info exists sokopos]} {
                    puts stderr "Multiple Sokobans encountered!"
                    return false
                } else {
                    set sokopos [list $i $linenumber]
                }
            }
        } else {
            puts stderr "Character \"$char\" has no meaning!"
            return false
        }
    }

    return true
}

# dlv_output_reachable --
#
#   Recursive procedure. Starts at startpos in array and tries to generate
#   relations of reachable locations. Marks visited spots in array.
#
# Arguments:
#   arrayname         the name of the array in which the field is stored
#   spos              starting position
#   boxlistname    name of the list in which positions of boxes are stored
#   cratelistname  name of the list in which positions of crates are stored
# Results:
#   Returns true upon success
#
proc dlv_output_reachable {arrayname spos boxlistname cratelistname} {
    upvar 1 $arrayname array
    upvar 1 $boxlistname boxlist
    upvar 1 $cratelistname cratelist

    # perform sideeffects for this location
    switch -regexp $array($spos) {
        {[#v]} { 
            puts stderr "Internal error 1." 
            exit 99
        }
        {[$]} {
            lappend boxlist $spos
        }
        {[*]} {
            lappend boxlist $spos
            lappend cratelist $spos
        }
        {[.+]} {
            lappend cratelist $spos
        }
        {[ @]} {
            # nothing
        }
        default { 
            puts stderr "Internal error 2." 
            exit 99
        }
    }

    # Mark this location as visited.
    set array($spos) "v"

    set x [lindex $spos 0]
    set y [lindex $spos 1]

    set uppos [list $x [expr $y - 1]]
    set downpos [list $x [expr $y + 1]]
    set rightpos [list [expr $x + 1] $y]
    set leftpos [list [expr $x - 1] $y]

    if {[info exists array($uppos)]} {
        if {$array($uppos) != "\#"} {
            puts "top(col${x}row${y},col[lindex $uppos 0]row[lindex $uppos 1])."
            if {$array($uppos) != "v"} {
                if { [dlv_output_reachable $arrayname $uppos $boxlistname $cratelistname] != "true" } {
                    return false
                }
            }
        }
    } else {
        puts stderr "Accessible location without upper border at ($x,$y)."
        return false
    }

    if {[info exists array($downpos)]} {
        if {$array($downpos) != "\#"} {
#            puts "top(col[lindex $downpos 0]row[lindex $downpos 1],col${x}row${y})."
            if {$array($downpos) != "v"} {
                if { [dlv_output_reachable $arrayname $downpos $boxlistname $cratelistname] != "true" } {
                    return false
                }
            }
        }
    } else {
        puts stderr "Accessible location without lower border at ($x,$y)."
        return false
    }

    if {[info exists array($rightpos)]} {
        if {$array($rightpos) != "\#"} {
            puts "right(col${x}row${y},col[lindex $rightpos 0]row[lindex $rightpos 1])."
            if {$array($rightpos) != "v"} {
                if { [dlv_output_reachable $arrayname $rightpos $boxlistname $cratelistname] != "true" } {
                    return false
                }
            }
        }
    } else {
        puts stderr "Accessible location without right border at ($x,$y)."
        return false
    }

    if {[info exists array($leftpos)]} {
        if {$array($leftpos) != "\#"} {
#            puts "right(col[lindex $leftpos 0]row[lindex $leftpos 1],col${x}row${y})."
            if {$array($leftpos) != "v"} {
                if { [dlv_output_reachable $arrayname $leftpos $boxlistname $cratelistname] != "true" } {
                    return false
                }
            }
        }
    } else {
        puts stderr "Accessible location without left border at ($x,$y)."
        return false
    }

    return true

}


# dlv_output_field --
#
#   a Sokoban field stored in the array named $arrayname is output
#   in datalog facts
#
# Arguments:
#   arrayname  the name of the array in which the field is stored
#   spos       the position of the Sokoban
# Results:
#   Returns ...
#
proc dlv_output_field {arrayname spos} {
    upvar 1 $arrayname array

    if {$array($spos) != "@" && $array($spos) != "+" } {
        puts stderr "Internal error 3."
        exit 99
    }

    set boxlist [list]
    set cratelist [list]

    if {[dlv_output_reachable $arrayname $spos boxlist cratelist] != "true"} {
        exit 3
    }

    foreach boxloc $boxlist {
        puts "box(col[lindex $boxloc 0]row[lindex $boxloc 1],0)."
    }

    foreach crateloc $cratelist {
        puts "solution(col[lindex $crateloc 0]row[lindex $crateloc 1])."
    }

    puts "sokoban(col[lindex $spos 0]row[lindex $spos 1],0)."
}


##############################################################################
##############################################################################



# SYNOPSIS: $argv0

##############################################################################
# There should not be any arguments.

if {$argc > 0} then {
    puts stderr "$argv0 is a filter, it reads from the standard input"
    puts stderr "and writes to the standard output. It takes no arguments."
    exit 1
}

for {set lines_count 0} {[eof stdin] == 0} {incr lines_count} {
    gets stdin input($lines_count)
}

for {set i 0} {$i < $lines_count} {incr i} {
    if {[parse_line $input($i) $i array sokobanposition] != "true"} {
        puts stderr "Parse error on line $i -- line ignored."
    } else {
        # print the line as a comment
        puts "% $input($i)"
    }
}

if {! [info exists sokobanposition]} {
    puts stderr "Error: No Sokoban (@) has been encountered."
    exit 3
}

dlv_output_field array $sokobanposition