package require crc32

set hole01 [list "------" "-    -" "- -- -" "- -- -" "- -- -" "- -- -" "-B--H-" "------"]
#URD                
set hole02 [list "  ----- " "---   --" "-H     -" "---    -" "  --  --" "   -B-- " "   ---  "]
#ULDRUL
set hole03 [list " ----   " "--  ----" "-      -" "-    B -" "-  H   -" "-      -" "--    --" " ------ "]
#DLURD                 
set hole04 [list "----     " "-- ------" "-       -" "-  ---- -" "-     - -" "-- -H - -" " - -  - -" " - ---- -" " -     B-" " --------"]
#ULDRDLU
set hole05 [list "------" "-B--H-" "-   H-" "- -- -" "- -- -" "-    -" "-B   -" "------"]
#DRU
set hole06 [list "..----" ".-  H-" "-   H-" "-  ---" "-    -" "---  -" "-    -" "-  ---" "-    -" "-B  B-" "------"]
#LURULUR
set hole07 [list "-----.." "-H  ---" "---  H-" "..- ---" "..- -.." "..- -.." "..- -.." ".-- -.." ".-BB-.." ".----.."]
#URULR
set hole08 [list "--------" "-BH   B-" "-     H-" "-      -" "-      -" "-H     -" "-B   HB-" "--------"]
#ULDR
set hole09 [list "-----." "-  H-." "-  H-." "-  H-." "- ---." "- --.." "-  -.." "-   -." "-BBB -" "------"]
#ULUR
set hole10 [list "..---..." "..-B-..." "---B----" "-H-B--W-" "- - -- -" "- - H- -" "- - -- -" "-      -" "------ -" "-H     -" "--------"]
#DRDLU
set hole11 [list ".---...." ".-H-...." ".- -----" "--B    -" "-H     -" "--    B-" ".-   ---" ".-  BH-." ".------."]
#RULU
set hole12 [list "..----.." "..-H -.." "---  ---" "-B     -" "-B  S  -" "---  ---" "..-H -.." "..----.."]
#RDLUL
set hole13 [list "----..----" "-H-----H--" "-H BBBB H-" "-- WWWW --" ".- WWWW -." ".- WWWW -." "-- WWWW --" "-H BBBB H-" "-H-----H--" "----..----"]
#LRULUD
set hole14 [list "------.." "-H   --." "-     --" "-  WBBW-" "- WWBBW-" "- WWWWW-" "-HWW----" "-HW--..." "----...."]
#ULRULD
set hole15 [list "..------.." "---H   ---" "-H--   -H-" "-H-S     -" "- - S    -" "-    S   -" "-     S  -" "---    ---" "..-BBBB-.." "..------.."]
#ULURUL
set hole16 [list "----  ----" "- H-  -BW-" "-WB-  -H -" "----  ----" "          " "----  ----" "- W-  -H -" "-BH-  -WB-" "----  ----"]
#ULDR
set hole17 [list "--------- " "-       - " "-       - " "- WBBW  - " "- WWWW  --" "- WWWW  H-" "-       --" "-      -- " "-H------  " "---       "]
#URDLURDRLD
set hole18 [list "      ---   " "    ---H--  " " ----B   -  " "--       -  " "-H   S   -- " "--     S B- " " -B S     --" " --   S   H-" "  -       --" "  -   B---- " "  --H---    " "   ---      "]
#URLUDLRD
set hole19 [list "--------" "-H    H-" "-H    H-" "-- BB --" " -B  B- " " -B  B- " "-- BB --" "-H    H-" "-H    H-" "--------"]
#ULDLR
set hole20 [list "-------       " "- WSW -       " "- S  S--------" "-S S B--WSBWH-" "-   W --S SW -" "-HWSSW-- SWWS-" "--------S SW -" "       -WS   -" "       -------"]
#LUDLDRDRUU
set hole21 [list "--------" "-     H-" "-- -- --" " - -- - " " -R  R- " " - -- - " " -B-- - " "--------"]
#LULUR
set hole22 [list "-----------" "-HR   R  B-" "-- - - - --" "-- - - - --" "-B  R   RH-" "-----------"]
#URDRDRDL
set hole23 [list "----  ---" "-  ---- -" "-   R   -" "-- ---- -" " - -  -R-" " -R-  - -" " - ---- -" " -HR-B  -" "------- -" "      ---"]
#RULULD
set hole24 [list "..---.." "---H---" "-     -" "- RRR -" "--RBR--" "- RRR -" "-     -" "--- ---" "  ---  "]
#LDLU
set hole25 [list "---------" "-  RRBRW-" "- -------" "- -------" "-     HW-" "---------"]
#LDLDLDRDRDR
set hole26 [list "----------" "-H--BR--0-" "-1--  -- -" "-        -" "----------"]
#DRULU
set hole27 [list "-------." "-H1   -." "---- --." "-0-- ---" "-  RB-0-" "---BR  -" "..- ----" ".-- ----" ".-   1H-" ".-------"]
#DRULULR
set hole28 [list "   ---        " "   -0-------  " "   -R- - - -  " "------ - - ---" "-H1H1      1H-" "------1-1-1---" "     - - - -  " "     -B-B-B-  " "     -------  "]
#UDLULDLUR
set hole29 [list "...----..." "...-HH-..." "----11----" "-B  S   0-" "-B   S  0-" "---    ---" "---    ---" "-W  S   B-" "-W   S  B-" "----  ----" "...-HH-..." "...----..."]
#LURULDD
set hole30 [list "-------." "-H S W-." "--- ---." "-W S H-." "---1----" ".-0   R-" ".--- ---" "..-R   -" "..--- --" "...-BB-." "...----."]
#URULULUULUR
set hole31 [list "-----------..." "-RRRR-BBBB-..." "-  -----  -..." "-    -    ----" "---  -  ---HH-" "-0000-    1HH-" "--------------"]
#DLDRDLDRDLDRU
set hole32 [list "     ---  " "------W-  " "-BRBBBB-  " "------ -  " "     - ---" "   --- -H-" "   -H- - -" "   - -  H-" "   -H  ---" "   -- --  " "    -H-   " "    ---   "]
#DRDRDRDLRURDLDLUD


# Tipos de tile
#   -> Grass
# B -> Ball
# C -> Ball over Hole in
# D -> Rock over Hole in
# H -> Hole
# I -> Ball in hole
# J -> Rock over hole
# W -> Water
# S -> Sand
# T -> Ball in Sand disable move
# U -> Ball in Sand enabled move
# R -> Rock
# 0 -> Switch
# 1 -> Door
# 2 -> Opened door
# 3 -> Ball over switch
# 4 -> Rock over switch
# 5 -> Ball over opened door
# 6 -> Rock over opened door


# Convertir una mapa en un vector per a treballar
proc convertMap { map } {
    set premoves ""
    set j 0
    foreach row $map {
        for { set i 0 } { $i<[string length $row] } { incr i } {
            set state($i,$j) [string range $row $i $i]
        }
        incr j
    }
    set result [list [list "$premoves" [array get state]]]
    return $result
}

# traure un estat de la cua
proc popState { state } {
    upvar 1 $state st
    set moves   [lindex [lindex $st 0] 0]
    set map     [lindex [lindex $st 0] 1]
    set st [lreplace $st 0 0]
    return [list $moves $map]
}

# obtindre l'objecte que està en el tile "B= bola, R= bola marron"
proc objectInTile { tile } {
    set result ""
    switch -- $tile {
        " " -
        "H" -
        "W" -
        "S" -
        "0" -
        "1" -
        "2" { set result "" }
        "B" -
        "C" -
        "I" -
        "T" -
        "U" -
        "3" -
        "5" { set result "B" }
        "D" -
        "J" -
        "R" -
        "4" -
        "6" { set result "R" }
    }
    return $result
}

# Com se queda el tile si se mou l'objecte que hi ha en ell
proc leaveTile { from_tile } {
    set new_tile ""
    switch -- $from_tile {
        "B" -
        "R" { set new_tile " " }
        "C" -
        "D" { set new_tile "I" }
        "U" { set new_tile "S" }
        "J" { set new_tile "H"}
        "3" -
        "4" { set new_tile "0"}
        "5" -
        "6" { set new_tile "2"}
    }
    return $new_tile
}

# Com se queda el tile si entra un objecte a ell
proc enterTile {from_tile to_tile} {
    set new_tile ""
    set object [objectInTile $from_tile]
    if { $object=="B" } {
        switch -- $to_tile {
            " " { set new_tile "B" }
            "H" { set new_tile "I" }
            "I" { set new_tile "C" }
            "W" { set new_tile "W" }
            "S" { set new_tile "T" }
            "0" { set new_tile "3" }
            "2" { set new_tile "5"}
        }
    } elseif { $object=="R" } {
        switch -- $to_tile {
            " " { set new_tile "R" }
            "H" { set new_tile "J" }
            "I" { set new_tile "D" }
            "W" { set new_tile "W" }
            #"S" { set new_tile "T" }
            "0" { set new_tile "4" }
            "2" { set new_tile "6"}
        }
    }
    return $new_tile
}

# Es un tile que te un objecte que es pot moure
proc movableTile { tile } {
    set result 0
    if { $tile=="B" || $tile=="C" || $tile=="U" || $tile=="R" || $tile=="D" || 
         $tile=="J" || $tile=="3" || $tile=="4" || $tile=="5" || $tile=="6" } {
        set result 1
    }
    return $result
}

# Es un tile que no se pot atravesar
proc isWall { tile } {
    set result 0
    if { $tile=="-" || $tile=="B" || $tile=="R" || $tile=="3" || $tile=="4" || 
         $tile=="1" || $tile=="5" || $tile=="6" || $tile=="U" || $tile=="T" ||
         $tile=="J" || $tile=="D" || $tile=="C" } {
        set result 1
    }
    return $result
}

# Moure l'estat del mapa donat un moviment "move"
proc changeState { move state } {
    # Segons la direcció se processa el mapa en un sentit concret
    if { $move=="U" } { 
        set dmove [list 0 -1] 
        set j0 0;   set j1 $::MAP_HEIGHT;   set dj 1
        set i0 0;   set i1 $::MAP_WIDTH;    set di 1
    }
    if { $move=="D" } { 
        set dmove [list 0 1] 
        set j0 [expr $::MAP_HEIGHT-1];  set j1 -1;              set dj -1
        set i0 0;                       set i1 $::MAP_WIDTH;    set di 1
    }
    if { $move=="L" } { 
        set dmove [list -1 0] 
        set j0 0;   set j1 $::MAP_HEIGHT;   set dj 1
        set i0 0;   set i1 $::MAP_WIDTH;    set di 1
    }
    if { $move=="R" } { 
        set dmove [list 1 0] 
        set j0 0;                       set j1 $::MAP_HEIGHT;   set dj 1
        set i0 [expr $::MAP_WIDTH-1];   set i1 -1;              set di -1
    }
    
    # decodificar l'estat
    set premoves [lindex $state 0]
    set map      [lindex $state 1]
    set width    $::MAP_WIDTH
    set height   $::MAP_HEIGHT
    
    # convertir el mapa a vector
    array set arrmap $map
    
    # Habilitar el movimente de boles en arena
    foreach {pos tile} [array get arrmap] {
        if { $tile=="T" } { set arrmap($pos) "U" }
    }
    
    set nmoves 1
    set total_moves 0
    set iter 0; # Salvaguarda per si se lia dins del bucle
    # Fer moviments fins que res es moga
    # A cada iteració mou cada objecte que es puga al següent tile que li corresponga
    while { $nmoves>0 && $iter<9 } {
        set nmoves 0
        set j $j0
        while { $j!=$j1 } {
            set i $i0
            while { $i!=$i1 } {
                set x $i;   set y $j
                set tile $arrmap(${x},${y})
                if { [movableTile $tile]==1 } {
                    set test_x [expr $x+[lindex $dmove 0]]
                    set test_y [expr $y+[lindex $dmove 1]]
                    
                    if { [isWall $arrmap(${test_x},${test_y})]==1 } {
                        # "WALL"
                        if { $tile=="U" } { set arrmap(${x},${y}) "T" }
                        #set end_move 1
                        #set arrmap(${new_x},${new_y}) "B"
                    } else {
                        set arrmap(${x},${y}) [leaveTile $tile]
                        set arrmap(${test_x},${test_y}) [enterTile $tile $arrmap(${test_x},${test_y})]
                        incr nmoves
                        
                        # check switches
                        set switches 0
                        foreach {pos tile} [array get arrmap] { if { $tile=="0" } { incr switches } }
                        
                        if { $switches==0 } {
                            # open doors
                            foreach {pos tile} [array get arrmap] {
                                if { $tile=="1" } { set arrmap($pos) "2" }
                            }
                        } else {
                            # close doors
                            foreach {pos tile} [array get arrmap] {
                                if { $tile=="2" } { set arrmap($pos) "1" }
                            }
                        }
                    }
                }
            
                set i [expr $i+$di]
            }
            set j [expr $j+$dj]
        }
        set total_moves [expr $total_moves+$nmoves]
        incr iter
    }

    if { $total_moves==0 } {
        # Si no s'ha fet cap moviment se descarta l'estat
        set result [list ]
    } else {
        set result [list "${premoves}${move}" [array get arrmap]]
        # Comprobar si ja s'ha processat un estat igual anteriorment
        set seen [llength $::STATES_SEEN]
        addLeaf $result
        if { $seen==[llength $::STATES_SEEN] } { set result [list ] }
    }
    return $result
}

# comprobar si queda algun forat sense bola
proc checkHoles { state } {
    set premoves [lindex $state 0]
    set map      [lindex $state 1]
    set found 0
    # H -> Hole
    # J -> Rock over hole
    foreach {pos tile} $map {
        if { $tile=="H" || $tile=="J" } {
            set found 1
            break
        }
    }
    return $found
}

# pintar en pantalla un estat
proc drawState { state } {
    set premoves [lindex $state 0]
    puts "$premoves"
    array set map [lindex $state 1]
    for { set j 0 } { $j<$::MAP_HEIGHT } { incr j } {
        set row ""
        for { set i 0 } { $i<$::MAP_WIDTH } { incr i }  {
            set tile $map(${i},${j})
            set row "${row}${tile}"
        }
        puts $row
    }
    puts "+++++++++++++++++++++++++++++++++++++++"
}

# afegir a la llista d'estats processats
# cada estat se convertix a un crc32
proc addLeaf { state } {
    set data [list ]
    array set map [lindex $state 1]
    for { set j 0 } { $j<$::MAP_HEIGHT } { incr j } {
        set row ""
        for { set i 0 } { $i<$::MAP_WIDTH } { incr i }  {
            set tile $map(${i},${j})
            set row "${row}${tile}"
        }
        lappend data $row
    }
    lappend ::STATES_SEEN [::crc::crc32 $data]
    set ::STATES_SEEN [lsort -unique $::STATES_SEEN]
}

# buscar solució per a un mapa
proc solveMap { map } {
    set states [convertMap $map]
    set nmoves 0
    set found 0
    set newstates [list ]
    set solution "NOT FOUND"
    set MAX_PAR 21
    set ::MAP_WIDTH  [string length [lindex $map 0]]
    set ::MAP_HEIGHT [llength $map]
    set moves [list U D L R]
    set ::STATES_SEEN [list ]
    
    while { $found==0 && $nmoves<$MAX_PAR && [llength $states]>0} {
        set state [popState states]
        addLeaf $state
        foreach move $moves {
            set newstate [changeState $move $state]
            if { $newstate!="" } {
                lappend newstates $newstate 
                set nmoves [string length [lindex $newstate 0 0]]
                if { [checkHoles $newstate]==0 } { 
                    set found 1
                    set solution [lindex $newstate 0 0]
                    break
                }
            }
        }
        if { $found==0 && [llength $states]==0 } { 
            set states $newstates 
            set newstates [list ]
        }
    }
    return $solution    
}

# mostrar els estats per a un mapa donada una solució "moves_list"
proc solveMap2 { map moves_list } {
    set states [convertMap $map]
    set nmoves 0
    set found 0
    set newstates [list ]
    set solution "NOT FOUND"
    set MAX_PAR 21
    set ::MAP_WIDTH  [string length [lindex $map 0]]
    set ::MAP_HEIGHT [llength $map]
    #set moves [list U D L R]
    set ::STATES_SEEN [list ]
    
    foreach moves $moves_list {
        set state [popState states]
        foreach move $moves {
            set newstate [changeState $move $state]
            if { $newstate!="" } {
                drawState $newstate
                update idletasks
                lappend newstates $newstate 
                set nmoves [string length [lindex $newstate 0 0]]
                if { [checkHoles $newstate]==0 } { 
                    set found 1
                    set solution [lindex $newstate 0 0]
                    break
                }
            }
        }
        if { $found==0 && [llength $states]==0 } { 
            set states $newstates 
            set newstates [list ]
        }
    }
    return $solution    
}

# # Resoldre un mapa
# solveMap $hole01

# # Resoldre tots el mapes 
# for {set i 1 } { $i<=32 } { incr i } {
#     set moves [solveMap [subst $[subst hole[format %02d $i]]]]
#     puts "[format %02d $i]\t[string length $moves]\t$moves"
# }