##+##########################################################################
#
# Eliminator.tcl - game to clear all balls from the screen
# by Keith Vetter -- May 2003
#
# Derived from Java applet by Riza Purwo Nugroho who copied it from IQ Puzzle
# http://javaboutique.internet.com/Eliminator/index.html
# 

package require Tk

set S(title) "Eliminator"
set S(max,col) 10
set S(max,row) 11
set S(noGUI) 0                                  ;# For when solving a puzzle

proc DoDisplay {} {
    global S B
 
    wm title . $S(title)
    ExtractImages                               ;# Carve images out of master
    
    label .level -textvariable S(lvl2) -bg black -fg white
    .level config -font "[font actual [.level cget -font]] -weight bold"
    option add *Button.font "[font actual [.level cget -font]] -weight bold"
    frame .board
    frame .mid
    frame .bottom
    
    for {set row 0} {$row < $S(max,row)} {incr row} { ;# Create the board
        for {set col 0} {$col < $S(max,col)} {incr col} {
            set w .l${row},$col
            label $w -image ::img::img(1) -bd 0 -highlightthickness 0
            grid $w -in .board -row $row -column $col
            if {$row == 0}             {bind $w <Button-1> {Mover Up}}
            if {$row == $S(max,row)-1} {bind $w <Button-1> {Mover Down}}
            if {$col == 0}             {bind $w <Button-1> {Mover Left}}
            if {$col == $S(max,col)-1} {bind $w <Button-1> {Mover Right}}
        }
    }
    bind .level <Button-1> {Mover Up}
    foreach key {Up Down Left Right} {
        bind all "<Key-$key>" [list Mover $key]
    }
    
    label .msg -relief sunken -textvariable S(msg)
    button .prev -image $::I(left) -command [list NewBoard -1 -1]
    button .next -image $::I(right) -command [list NewBoard -1 1]
    button .more -image $::I(plus) -command ToggleButtons
    button .hint -text "Hint" -highlightthickness 0 -command {Hint 0}
    button .solve -text "Solve" -highlightthickness 0 -command {Hint 1}
    button .help -text "Help" -highlightthickness 0 -command Help
    bind .prev <Button-3> [list NewBoard -1 -10]
    bind .next <Button-3> [list NewBoard -1 10]
 
    grid .level -row 0 -sticky ew
    grid .board -sticky news
    grid .mid -sticky news
    grid .msg .prev .next .more -in .mid -sticky news -pady 5
    grid .hint .solve .help -in .bottom -sticky news -padx 5 -pady 5
 
    grid configure .msg .more -padx 5
    grid rowconfigure . 100 -weight 1
    grid columnconfigure . 100 -weight 1
    grid columnconfigure .mid 0 -weight 1
    grid columnconfigure .bottom {0 1 2} -weight 1
    
    bind all <Alt-c> {console show}
    LoadBoard 0
}

proc ExtractImages {} {
    foreach row {0 1} {
        foreach col {0 1 2 3 4 5} {
            set id [expr {$row * 6 + $col}]
            set x0 [expr {$col * 20}] ; set y0 [expr {$row * 20}]
            set x1 [expr {$x0 + 20}]  ; set y1 [expr {$y0 + 20}]
            image create photo ::img::img($id)
            ::img::img($id) copy ::img::all -from $x0 $y0 $x1 $y1
        }
    }
}

proc NewBoard {abs rel} {
    global S BOARDS
    set max [llength $BOARDS]                   ;# How many boards we have
 
    set lvl [expr {$S(lvl) + $rel}]
    if {$abs != -1} {set lvl $abs}
    if {$lvl < 0} {set lvl 0}
    if {$lvl >= $max} {set lvl [expr {$max - 1}]}
    LoadBoard $lvl
}   

proc ShowBoard {{clear 0}} {
    global B S
 
    if {$S(noGUI)} return
    for {set row 0} {$row < $S(max,row)} {incr row} {
        for {set col 0} {$col < $S(max,col)} {incr col} {
            if {$clear} {set B($row,$col) 0}
            .l${row},$col config -image ::img::img($B($row,$col))
        }
    }
    if {! $clear} update
}

# = for wall 
# space for blank area
# * for non-ball
# .oO@+ for ball #1 - #5
# , to enter to the next data-row

proc LoadBoard {which} {
    global S B BOARDS
 
    array set BOARD2B {" " 0 "=" 1 "." 6 "o" 7 "O" 8 "@" 9 "+" 10 "*" 11}
    set S(lvl) $which
    set S(lvl2) "Level $S(lvl)"
    set S(busy) 0
    
    ShowBoard 1                                 ;# Clear the board
    set row [set col 0]
    foreach {B(moves) board} [lindex $BOARDS $which] break
    foreach ch [split $board ""] {
        if {$ch == ","} {                       ;# New row
            incr row
            set col 0
            continue
        }
        set cnt 1
        if {[string is integer -strict $ch]} {  ;# Repeat count
            set cnt $ch
            set ch $last
        } else {
            set ch $BOARD2B($ch)
        }
        while {[incr cnt -1] >= 0} {
            set B($row,$col) $ch
            incr col
        }
        set last $ch
    }
    ShowBoard
    set S(msg) "Level $which ([Plural $B(moves) step ""])"
    .msg config -bg [lindex [.msg config -bg] 3]
}

proc Plural {num word word2} {
    if {$num != 1} {append word "s"}
    return "$num $word$word2"
}

proc Explode {} {
    set who [FindNeighbors]
    if {[llength $who] == 0} {return 0}
    Exploder $who
    return 1
}

proc Exploder {who} {
    foreach cell $who {set ::B($cell) 0}        ;# Clear cell value
    if {$::S(noGUI)} return
 
    foreach step {2 3 4 5 0} {                  ;# Images to display
        foreach cell $who {
            .l$cell config -image ::img::img($step)
        }
        update
        after 100
    }
}

proc FindNeighbors {} {
    global B S
 
    catch {unset who}                           ;# Trick to avoid duplicates
    for {set row 0} {$row < $S(max,row)} {incr row} {
        for {set col 0} {$col < $S(max,col)} {incr col} {
            set me $B($row,$col)                ;# Ball to match
            if {$me < 6 || $me == 11} continue  ;# Not a ball, skip it
 
            foreach {drow dcol} {-1 0 1 0 0 1 0 -1} { ;# All neighboring cells
                set row2 [expr {$row + $drow}]
                set col2 [expr {$col + $dcol}]
                if {! [info exist B($row2,$col2)]} continue
                if {$B($row2,$col2) == $me} {   ;# Matching neighbors
                    set who($row,$col) 1
                    set who($row2,$col2) 1
                }
            }
        }
    }
    return [array names who]
}

proc WinOrLose {} {
    global B S
 
    foreach w {6 7 8 9 10} {set cnt($w) 0}      ;# How many of each ball
    set all 0                                   ;# How many balls altogether
    
    for {set row 0} {$row < $S(max,row)} {incr row} {
        for {set col 0} {$col < $S(max,col)} {incr col} {
            set me $B($row,$col)
            if {$me < 6 || $me == 11} continue
            incr all
            incr cnt($me)
        }
    }
    if {$all == 0} {return 1 }
    foreach w [array names cnt] {
        if {$cnt($w) == 1} {
            return 2
        }
    }
    return 0
}

# Move ball in given direction, handling explosions and end of game stuff
# Value: 1 = win; 2 = loss; -1 = no move; 0 otherwise
proc Mover {dir} {
    global S B
 
    if {$S(busy)} return                        ;# Avoid update recursion
    set S(busy) 1
    set win 0
    set moved 0
 
    while {1} {                                 ;# May move twice w/ explosions
        set n [$dir]                            ;# Do the move
        if {! $n} break                         ;# Nothing moved
        set moved -1
        set n [Explode]                         ;# Check for explosions
        if {! $n} break
        set win [WinOrLose]                     ;# Check for end of game
        if {$win} break
    }
 
    incr B(moves) $moved                        ;# One less step (perhaps)
    if {$B(moves) <= 0 && $win != 1} {set win 2};# Out of steps???
 
    if {! $S(noGUI)} {
        set S(msg) [Plural $B(moves) step " left"]
        
        if {$win == 1} {
            set S(msg) "You win!"
            .msg config -bg cyan
            after 1000 {NewBoard -1 1}
        } elseif {$win == 2} {
            set S(msg) "You lose"
            .msg config -bg red
            after 1000 {NewBoard $S(lvl) 0}
        }
    }
    set S(busy) 0
    if {$win == 0 && ! $moved} { return -1 }
    return $win
}

proc Down {} {
    set cnt 0
    while {1} {
        set moved 0
        for {set col 0} {$col < $::S(max,col)} {incr col} {
            for {set row [expr {$::S(max,row)-2}]} {$row >= 0} {incr row -1} {
                incr moved [MoveIt $row $col [expr {$row + 1}] $col]
            }
        }
        if {! $moved} break
        ShowBoard
        set cnt 1
    }
    return $cnt
}

proc Up {} {
    set cnt 0
    while {1} {
        set moved 0
        for {set col 0} {$col < $::S(max,col)} {incr col} {
            for {set row 1} {$row < $::S(max,row)-1} {incr row} {
                incr moved [MoveIt $row $col [expr {$row - 1}] $col]
            }
        }
        if {! $moved} break
        ShowBoard
        set cnt 1
    }
    return $cnt
}

proc Right {} {
    set cnt 0
    while {1} {
        set moved 0
        for {set row 0} {$row < $::S(max,row)} {incr row} {
            for {set col [expr {$::S(max,col)-2}]} {$col >= 0} {incr col -1} {
                incr moved [MoveIt $row $col $row [expr {$col + 1}]]
            }
        }
        if {! $moved} break
        ShowBoard
        set cnt 1
    }
    return $cnt
}

proc Left {} {
    set cnt 0
    while {1} {
        set moved 0
        for {set row 0} {$row < $::S(max,row)} {incr row} {
            for {set col 1} {$col < $::S(max,col)-1} {incr col} {
                incr moved [MoveIt $row $col $row [expr {$col - 1}]]
            }
        }
        if {! $moved} break
        ShowBoard
        set cnt 1
    }
    return $cnt
}

proc MoveIt {frow fcol trow tcol} {
    if {$::B($frow,$fcol) >= 6 && $::B($trow,$tcol) == 0} {
        set ::B($trow,$tcol) $::B($frow,$fcol)
        set ::B($frow,$fcol) 0
        return 1
    }
    return 0
}

proc Dump {} {
    for {set row 0} {$row < $::S(max,row)} {incr row} {
        for {set col 0} {$col < $::S(max,col)} {incr col} {
            puts -nonewline "$::B($row,$col) "
        }
        puts ""
    }
}

proc Help {} {
    set msg "$::S(title)\nby Keith Vetter, May 2003\n"
    append msg "based on a game by Riza Purwo Nugroho\n"
    append msg "\nThe object of the game is to clear all the balls.\n\n"
    append msg "Press the arrow keys to move the balls. When balls of the\n"
    append msg "same color touch, they explode. The level ends if all the\n"
    append msg "balls are eliminated, if there is no more possibility of\n"
    append msg "winning or if you run out of steps."
 
    tk_messageBox -title "$::S(title) Help" -message $msg
}

proc Hint {how} {
    set ::S(msg) "thinking..."; update
    set sol [Solve]
    set result "Give up"
    if {[llength $sol] != 0} {
        if {$how == 0} {
            set result "Go [lindex $sol 1]"
        } else {
            set result ""
            foreach {id dir} $sol {
                append result [string index $dir 0]
            }
        }
    }
    set ::S(msg) $result
}

proc Solve {} {                                 ;# BFS to find solution
    set ::S(noGUI) 1
    ClearQueue 
    set org [EnQueue -1 nil]                    ;# Starting position
 
    set max [expr {1+int(pow(4,$::B(moves)))}]
    while {1} {
        set win 0
        if {[incr max -1] < 0} break            ;# Safety net
        
        set id [DeQueue]                        ;# Board position to expand
        if {$id == -1} break                    ;# Empty queue, no solution
 
        foreach dir {Up Down Left Right} {      ;# Try all possible moves
            ExtractQueue $id
            set win [Mover $dir]
            if {$win == 2 || $win == -1} continue ;# Skip loss and no moves
            set id2 [EnQueue $id $dir]
            if {$win} break
        }
        if {$win == 1} break
    }
 
    set result {}
    if {$win == 1} {                            ;# Winning solution found
        while {$id2 != 0} {
            set result [concat $id2 $::Q($id2,dir) $result]
            set id2 $::Q($id2,prev)
        }
    }
    
    ExtractQueue $org                           ;# Back to starting position
    ClearQueue
    set ::S(noGUI) 0
    set ::result $result                        ;# For debugging
    return $result
}

proc EnQueue {prev dir} {                       ;# Add to end of queue
    set id $::Q(tail)
    incr ::Q(tail)
    set ::Q($id,prev) $prev
    set ::Q($id,dir) $dir
    set ::Q($id,board) [array get ::B]
    return $id
}

proc DeQueue {} {                               ;# Extract from front of queue
    if {$::Q(head) == $::Q(tail)} {return -1}   ;# Empty queue
    set id $::Q(head)
    incr ::Q(head)
    return $id
}

proc ExtractQueue {id} {
    array set ::B $::Q($id,board)
    return ""
}

proc ClearQueue {} {
    catch {unset ::Q}
    set ::Q(head) [set ::Q(tail) 0]
}

proc DumpQueue {{verbose 0}} {                  ;# Debugging 
    global Q
 
    puts "Head: $Q(head) => Tail: $Q(tail)"
    for {set id 0} {$id < $Q(tail)} {incr id} {
        ExtractQueue $id
        puts [format "%2d: %-6s %2d" $id $Q($id,dir) $Q($id,prev)]
        if {$verbose} {
            Dump
            puts ""
        }
    }
}

proc ToggleButtons {} {
    if {[winfo ismapped .bottom]} {
        grid forget .bottom
        .more config -image $::I(plus)
    } else {
        grid .bottom -sticky news
        .more config -image $::I(minus)
    }
}

set BOARDS {
   {4 {, =7, =o.o.o.=, = 5=, = = = =1, = = 3=, = 4=1, =6,}}
   {4 {,, 1=5, 1=.* 1=, 1= 3=, 1=. 2=, 1= 1.=1, 1=5,}}
   {4 {, 2=3, 1=1 .=1, 1= 3=, 1=. o =, 1= 1= =, 1= 1. =, 1=1o =1, 2=3,}}
   {4 {,, 1=5, 1= 1. =, 1=1 1=1, 1= 2.=, 1=. 1=1, 1=4,}}
   {4 {, 1=2, =1 =2, = . 1=1, =* . 1=1, = 1* . =, = = 1=2, =5,}}
   {4 {, =7, =o 3o=, = = 1= =, = 1. 2=, =1. . =1, = 1o . =, =7,}}
   {4 {, 1=5, =1 . *=1, = 4.=, = 5=, =. 4=, =1 3=1, 1=1* =1, 2=3,}}
   {4 {, =6, = 3.=, =. 2=1, = 1* 1=, = 3=1, =2.=1, 2=2,}}
   {4 {,,=9,= 1. 2* =,=1 1*. 1=1, = *. * =, =. 3.=, =7,}}
   {4 {, 2=4, 1=1 . =1, =1 4=, =. 3.=, = 2=1*=, =7,}}
   {6 {, 4=2, =4.=1, =. 4=, =1 2* =, 1=1 = =1, 2= =2, 2= 1.=, 2=4,}}
   {6 {, =6, = 4=, =1 .* =, =. 3=, =* 2.=, = 2* =, =6,}}
   {6 { =7, = 1. 2=,=1 1*= 1=,= 2.= 1=,=1 =1 2=, = 1* 2=, = 1. 2=, = 5=, = 5=, =7,}}
   {6 {, =6, = .= o=1, =1 3o=, 1= 3=1, 1=* 2.=, 1=.o 1=1, 1=5,}}
   {6 {, 1=5, =1. 2=, = 3.=, =1 * =1, = 4=, =1 2.=, 1=5,}}
   {6 {, 2=2, 1=1 =3, =1 4=, = 5=, = .o=.o=, =1o=2.=, 1=2 =2,}}
   {6 {, 3=2, =3O=1, = o. 1=, = = o.=2,=1 4O*=,= 5o=1,=1 O= 1=1, =6,}}
   {6 {, 4=2, 2=2 =1, 1=1. 2=, 1= 2o=1, =2 . 1=, = 1o .=1, =1 1o=1, 1=4,}}
   {6 {, 1=5, =1 1o =1, =o 3.=, =. 2* =, =1 . 2=, 1=3 =1, 4=2,}}
   {6 {, =4, =. 1=1, = 3=1, = o o.=, =2. 1=, 2= 2=, 2=4,}}
   {7 {, 2=4, 1=1 O =, =1 3=1,=1.O 3=,= 2o 1=1,= 1=2.=,= O o 1=,=7,}}
   {7 {, =2,=1 =4,=. 2O =,= 2=1.=1,= 1Oo= 1=,= o= 2=1,= 2. o =,=O 1=1 =1,=7,}}
   {7 {, 1=2, 1= =2, 1= 1o=1, 1=*. o=1, 1= =O o=, =1 2= =, = . 2O=, =1O 2=1, 1=5,}}
   {7 {,=8,= Oo.oO =,= 2o 2=,= 2O 2=,= 2o 2=,= o . O =,=1 1= 1=1, =6,}}
   {8 {, 1=4, =1 = =1, = .= 1=1, =1 =. 1=, = 5=, =1 * 1.=, 1=1 2=1, 2=1 =1, 3=2,}}
   {8 {, 1=5, =1 1= =1, =.*o.*.=1, = 6=, = =1 = 1=,=1 2=1 1=,= o 4=1,=1 4=1, =6,}}
   {8 { 1=2, 1= =, 1= =3, =1 3=1, = 1= . =, = . = 1=, =1 =. =1, 1=1 = =, 2=2 =, 4=2,}}
   {8 {, =5, = = 1=1, = 1. 1=,=2. * =1,= 3=. =,=1 2=3, =2 =, 2=2,}}
   {8 { =3,=1 1=3,= 2. 1=,=1 .=.=1, = 4=, = =o=o=, =1 1o =, 1=1 2=, 2=1 =1, 3=2,}}
   {8 {, =5, = 1o.=1, = . =o=1, = * 3=, =o 4=, =1 2.=1, 1=1 1=1, 2=3,}}
   {9 {, 1=5, 1= = .=1, 1= 1o 1=, =2. * =, =. 3=1, =1o 2=, 1= 3=, 1=5,}}
   {9 {, 4=2, 3=1*=, 2=1. =, 1=1. 1=1, =1 4=, = 4.=, =o 1* o=, =7,}}
   {9 {=7,= .oO* =,=1 4=1,=O . 3=,=o= 3=1,= =1 2=1,= 1o 3=,=. =1O. =,=5 1=, 4=3,}}
   {9 {, 1=5, 1=. 2=1, =1 = O =, = 1Oo= =, = 2Oo =, =1 o= 1=, 1= 2.=1, 1=5,}}
   {9 {, =5, = 1o =1, = O= o=, =o 1O.=1, = 5=, =1. 2O=, 1=6,}}
   {9 {, =5, = O .=1, =1 2O=1, 1= o=. =, =1 3o=, =O =O 1=, = o 3=, =1 =4, 1=2,}}
   {9 {, 1=4, =1O 1=, = o 1=1, =1. 2=, = O.o*=, =1 2.=1, 1= 2o =, 1=1 3=, 2=5,}}
   {9 {, 1=6, 1= 1. o=, =1 o= 1=, = 2= 1=, =1 3=1, 1=. 2=1, 1= 2o =, 1=1 .= =, 2=5,}}
   {9 {, 1=4, =1 1.=1, = . = =1, =1 . 1o=, =2o *.=, = . * o=, =7,}}
   {10 {, =7,=1 o 1O =,= 4o=1,=1 5=,= 1O 1.=1,=1. 2*=, =1o 2=, = . 1O=, =6,}}
}

set I(left) [image create bitmap -data {
  #define left_width 11
  #define left_height 11
  static char left_bits = {
      0x00, 0x00, 0x20, 0x00, 0x30, 0x00, 0x38, 0x00, 0xfc, 0x01, 0xfe,
      0x01, 0xfc, 0x01, 0x38, 0x00, 0x30, 0x00, 0x20, 0x00, 0x00, 0x00
  }}]
  
set I(right) [image create bitmap -data {
   #define right_width 11
   #define right_height 11
   static char right_bits = {
       0x00, 0x00, 0x20, 0x00, 0x60, 0x00, 0xe0, 0x00, 0xfc, 0x01, 0xfc,
       0x03, 0xfc, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x20, 0x00, 0x00, 0x00
  }}]

set I(plus) [image create bitmap -data {
   #define plus_width 11
   #define plus_height 11
   static char plus_bits = {
       0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe, 0x03, 0xfe,
       0x03, 0xfe, 0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x00, 0x00
   }}]

set I(minus) [image create bitmap -data {
   #define minus_width 11
   #define minus_height 11
   static char minus_bits = {
       0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0xfe,
       0x03, 0xfe, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
   }}]

image create photo ::img::all -format gif -data {
   R0lGODlheAAoANUAAAAAAAAAMwAzAAAzMzMAADMAMyQkADMzMyYmWAdaARNdWW0AAG0kAGYzM18W
   VVtVAGZmYwAkqgRnqgBk/2YkqmZmqm1t/ySSACSSVW2SAG2uVRSfqg2U/xXbqhDb/2i2qm22/23b
   qm3b/5oMAJ4IVZtkAJVpVeEMAOsOVd9qAN5nVZJtqvMkqv9tqpKcAJKcVrbbVduSAN6aVdvbVZmZ
   mZKZqpOV9KraqZbR3dyfqduS/9zcqObl6AAAAP///wAAACH+HUJ1aWx0IHdpdGggR0lGIE1vdmll
   IEdlYXIgMi41ACH5BAFkAD0ALAAAAAB4ACgAAAb+QIBwSCwWUUiUiqVqoUZJJaqlehYP2IMiizV6
   v+CweEwGo3TO6GhxTidPC+EBgoXY79wD7XDdy+18AAFlhIWGQigyTyQnJCMMbIqOiwwMQjQ+NHY0
   nHd3NDs7gVl7WDQ3O3t2L4FDA3OtX3NDdbGHYic5jY4kJJAoulCMa5YHOz6pNDmhmp0QnYHPqXTS
   PDQvNTzWsXqcrX62Q9KaXhC3RSc6KCTrTwsMZ40oJ0+VAHPJoD7InP2AfHr25XvW7xgyc3oAQFi2
   wxytOaWIzBEIQYCcITTOESGh6wkUYsDojRjR610dGjhycArFchwdgPr4aYIYcwcCif26yGHph1b+
   TAgFhNjRaATYE3kk3oVkNC8pA5osQ/E4FhWa0Kj7NBH0F+vVy38QDDYsMk4B0TBGe/H6lWNkL5Im
   qYbaR1dgMkBCV9IdyKUIgSwEX+rrKZFO0LNfhEFa8I4xI1+LF0PYW7cyM7xb5yK7nKUwNFCpSA29
   gnjMmsaL3yVlzLpx2M0GK8P2hk8m6NsvdRrThmMTuXs6JYbzWRpKleNOmCJZsmRdt1SaLbesw/lk
   2GnPvhrkkbvLP4XcOtPCe7ZNFBVJgVE5jv6pNJayZw/VMw2wqXyhEO7QtmMLketjQTCIHN3QIQco
   vxGVyAkjkVQJPLrwMpJJAIoVlVwzKeRbM6X+BHYMOTQ1YMRrY43ITDRUEXZOOiTRUxI86rDjYiUB
   CWQjfMxkOAeAXGUHkYG0aHgJPvkZAVFoeZ1YXg7rNMKgUjJM8hiN7811IU/THChQPwiWIp4Q/gEH
   i4bBFfbSHxku6eQw7+TC4CKPFEMQjheuVCJ9yLyAQFg8ZGKOihfR5BAZ4ZSp0VK9NFKJUe0oWsyO
   oMnFk4/i9IPAfQ3xAaSRoG1ahqel5fLEOr0syuQIu0CGZkEyCWRoX7mB6sVzsooxXHlPsgYJPI28
   s6s9V03D5WT7GFrETYbAYsutpYWxWiWNvUMMtKmNFys1CDY764jMauvtt+A2W8MOOdRQgwn+ZWyA
   wwcfbIBBGSrkoMK8J5TBgQcbcMCBBGW4AMMNLrzgQrgA1OCDDueaoLAJg3qxgQ8h1IDBxBSHoYIP
   8s4DRSNhPOzBvhKEHHIYLvgAAwwuuJBByhkQsicEyHph8A3LHFyDDCY8aEkRG4gQwgchBP2BBhgk
   YHQCRqhAbrw5yJuCIw0asYEH+FKN774RZB2BES7M8O8N/8JgwgsPlP0AGRUY1DARx+RwMDI+1PBC
   zsASIQLEIQj08wtFG23EMoBjLK8KJzA4ghEe+PCxDgd/jHXWRsDgA9h0gS3DCw6UTQbjyNTghQ4I
   xyZQDgw/SATQNeRdmcR9Iz1EC/JyTtf+4CZEPcS9U8u2QchaE6HBDZRXBkMGGZgtxmv7eG7EXIxT
   tU+5JZg+RAg+73DDPneL0G7rRDTdNMaC+zBvg4cP4UEHHuiQuOKK6ytB70OcfP31k08OwwslGA8G
   BTbspTwRjMsbVXQwA5qdCwI6EwIIfHA3uoTgBj/7wMSO5roWYMwg3psBvaA2EiF4rC4d4EAIOTCB
   98FPAyary8kKeIMXFE9/QthMCiyggxgAz1wUWB7ckKEDGDRtBQpDoPTuproQ2CCC7prg0YTgNrcJ
   ToP08ojtPLADKvoAfR3YQL5EprWtAUBykjMZDAp4vxe40GxnE0IKdiCEBaTAB2Y0gAL+EmCWIoDP
   f+V6wQruID3r7QWJL0gi9wDgvecNbl6k4mAMPeBExeVri1yEHAAmJ7uvvUAFFygB8WBogArEQAYI
   sEEKZGAAAzzgAhSImRAY18gcIMxcpUvgJI1IP+1J0F0U9NskC9m09aCHgx0kpNWQocVH8q6LMQRb
   GGFQA5QJ7IUwBAACHCCDEjggBRcoZQUoEIEKFGEHLyDXDmqQAx8mTIjS+1neflaDG7CLYrlkogpm
   0LR5yQCRJCFf+armyKlxYHfHhN8KxThGZ54RjUYwwCdloAA5OiACqSyCuchZrnLJLZay1GINNFCD
   DbRLkK3T5bxGStIUNEKf5XvkP1f+qsVIwi9g8nNBC10gA5XlD6FFMEAEZDDKCyBgmqlMgUSbJjcg
   MswOOtuZB2vwTpCG1HVCKGkS3gJMIvzTmCILqCSF8IJ/vUAGGTAj8aCpOS+sQAbXlEE1EaAABCyD
   CBMlXRCRmlQiaPGdFFMiBYlA0jeRxBf6tKoWQZbVLm4VAAEDW8BUtkk0ptEIMlgAWx+w0xQIFQCW
   JcILysWwB6BTlkTAQAiSeIGn6pIIKUBk7daAUiPoi7AmNKwRYuDM4pE1mkXI309rUIGfjqAErP3P
   wj5b1yLk1bRLLAKqmoLSYBYhq7E1rBeJEFYXaMCxjgXD4RZQviI8IA5kSSpovYAv3NN6AZiBBUN0
   ZQuG2+IUDCUAQHcJId4y5BKqYmgtGaRbBuyWYQToIpiABxyuIAAAOw==
}

DoDisplay