day 18 part 2

day18/sol2.tcl

@@ -0,0 +1,81 @@
+#!/usr/bin/env tclsh
+
+proc solve {input} {
+    set data {}
+    while {[gets $input line] >= 0} {
+        set color [string trim [lindex $line 2] "()"]
+        set dir [lindex {R D L U} [string index $color end]]
+        set steps [scan [string range $color 1 end-1] "%x"]
+        lappend data $dir $steps $color
+    }
+    puts $data
+    set x 0
+    set y 0
+    set extra 0
+    set yrays {}
+    foreach {dir steps color} $data {
+        puts "$x $y $dir $steps $color"
+        set oldy $y
+        set oldx $x
+        switch $dir {
+            {U} {incr y -$steps}
+            {D} {incr y +$steps}
+            {L} {incr x -$steps}
+            {R} {incr x +$steps}
+        }
+        if {$oldy < $y} {
+            lappend yrays [list $oldy $y $x]
+        } elseif {$y < $oldy} {
+            lappend yrays [list $y $oldy $x]
+        }
+        if {$oldy != $y} {
+            incr extra [expr {abs($oldy - $y)}]
+        }
+        if {$oldx != $x} {
+            incr extra [expr {abs($oldx - $x)}]
+        }
+    }
+    #puts $yrays
+    set ypos {}
+    foreach {a b x} [join $yrays] {
+        lappend ypos $a $b
+    }
+    set ypos [lsort -integer -unique $ypos]
+    set t 0
+    puts $ypos
+    foreach y $ypos yn [difference $ypos] {
+        if {$yn eq ""} {
+            continue
+        }
+        set xpos {}
+        foreach {a b x} [join $yrays] {
+            if {$a <= $y && $y < $b} {
+                lappend xpos $x
+            }
+        }
+        set xpos [lsort -integer $xpos]
+        puts "$y +$yn : $xpos"
+        if {[llength $xpos] == 0} { error "no xpos" }
+        set in 0
+        foreach x $xpos xn [difference $xpos] {
+            set in [expr {!$in}]
+            if {$in && $xn ne {}} {
+                incr t [expr {($xn) * ($yn)}]
+            }
+        }
+    }
+    #puts "$t"
+    # +1 for the outer perimeter, -1 for the inner perimeter
+    incr t [expr {$extra/2 + 1}]
+    puts "$t"
+}
+
+proc difference lst {
+    set out {}
+    for {set i 1} {$i < [llength $lst]} {incr i} {
+        lappend out [expr {[lindex $lst $i] - [lindex $lst $i-1]}]
+    }
+    return $out
+}
+
+solve stdin