#!/usr/bin/env tclsh8.6

# Read input into grid (array).
set maxy 0
while {[gets stdin line] >= 0} {
    set maxx 0
    foreach c [split $line {}] {
        set grid($maxx,$maxy) $c
        incr maxx
    }
    incr maxy
}

# Add "." padding all around the grid.
for {set x -1} {$x <= $maxx} {incr x} {
    set grid($x,-1) .
    set grid($x,$maxy) .
}
for {set y -1} {$y <= $maxy} {incr y} {
    set grid(-1,$y) .
    set grid($maxx,$y) .
}

# Determine whether a given number borders a "*".  If so, return the
# x,y coordinates of the "*".  Otherwise, return an empty list.
proc isstar {y startx endx} {
    global grid

    set y1 [expr {$y-1}]
    set y2 [expr {$y+1}]
    set x1 [expr {$startx-1}]
    set x2 [expr {$endx+1}]

    # Check to the left and right of the digits.
    set coords [list $x1 $y1 $x1 $y $x1 $y2 \
        $x2 $y1 $x2 $y $x2 $y2]
    # set s "$grid($x1,$y1)$grid($x1,$y)$grid($x1,$y2)"
    # append s "$grid($x2,$y1)$grid($x2,$y)$grid($x2,$y2)"

    # Check above and below each digit.
    for {set x $startx} {$x <= $endx} {incr x} {
        lappend coords $x $y1 $x $y2
        # append s "$grid($x,$y1)$grid($x,$y2)"
    }

    foreach {cx cy} $coords {
        if {$grid($cx,$cy) eq "*"} {return [list $cx $cy]}
    }
    return [list]
}

for {set y 0} {$y <= $maxy - 1} {incr y} {
    set number {}
    set startx -1   ;# starting X coord of current number

    # Let this loop hit the dot padding on the right edge.
    for {set x 0} {$x <= $maxx} {incr x} {
        set c $grid($x,$y)
        if {[string is digit $c]} {
            append number $c
            if {$startx < 0} {
                set startx $x
                # puts "New number beginning $x,$y"
            }
        } else {
            if {$startx >= 0} {
                # puts "Number terminated $x,$y"
                set coords [isstar $y $startx [expr {$x-1}]]
                if {[llength $coords]} {
                    lappend star($coords) $number
                    # puts "Part $number star [join $coords ,]"
                }
            }
            set number {}
            set startx -1
        }
    }
}

# For part 2, the "star" array holds lists of part numbers that are attached
# to each star.  If there are exactly two, then this constitutes a gear.
set total  0
foreach s [array names star] {
    if {[llength $star($s)] == 2} {
        incr total [::tcl::mathop::* {*}$star($s)]
    }
}
puts $total