#!/usr/bin/env tclsh
namespace eval ssd-info {
    namespace path ::tcl::mathop

    variable version 0.1
    variable message {%1$s has %2$s%% of its write resource remaining.}
}

# Get the value of the SMART vendor attribute $name for $device.
proc ::ssd-info::get-attribute {device name} {
    set value [string trimleft \
            [exec smartctl -A $device | awk "/$name/ { print \$4 }"] 0]
    if {![string is integer -strict $value]} {
        error "$device has no attribute $name"
    }
    return $value
}

# Get SSD wearout value using one of the two common vendor attributes.
proc ::ssd-info::get-wearout {device} {
    set result {}
    set error [catch {
        set result [get-attribute $device Remaining_Lifetime_Perc]
    }]
    if {$error} {
        # Intel SSD.
        set result [get-attribute $device Media_Wearout_Indicator]
    }
}

# Linear interpolation.
proc ::ssd-info::interpolate-color {color1 color2 {x 0.5}} {
    set result {}
    foreach v1 $color1 v2 $color2 {
        lappend result [expr {
            round($v1 * (1 - $x) + $v2 * $x)
        }]
    }
    return $result
}

# Draw a progress bar-like gradient with text ${value}% over it.
proc ::ssd-info::draw-bar {canvas value color {steps 10} {font barFont}} {
    set width [$canvas cget -width]
    set height [$canvas cget -height]

    set barWidth [/ [* $value $width] 100.0]
    set stepSize [/ $barWidth $steps]
    set color1 {}
    foreach x $color {
        lappend color1 [/ $x 2.0]
    }
    set color2 $color

    # Create a gradient out of rectangles.
    for {set step 0} {$step < $steps} {incr step} {
        set color [interpolate-color \
                $color1 \
                $color2 \
                [expr { (1.0 * $step) / ($steps - 1) }]]
        $canvas create rectangle \
                [* $step $stepSize] 0 [* [+ 1 $step] $stepSize] $height \
                -width 0 \
                -fill [format "#%02x%02x%02x" {*}$color]
    }

    $canvas create text \
            [/ $barWidth 2] \
            [/ $height 2] \
            -text "[expr {round($value)}]%" \
            -font $font \
            -fill white
}

# Display a GUI showing device wear.
proc ::ssd-info::gui {device wear} {
    variable message

    package require Tk

    wm title . "ssd-info"

    canvas .canvas -width 800 -height 50
    ::ttk::label .status \
            -text [format $message $device $wear]

    set font [font actual .canvas]
    dict set font \
            -size [* 2 [dict get $font -size]]
    font create barFont {*}$font

    ::ssd-info::draw-bar \
            .canvas \
            $wear \
            [interpolate-color {128 0 0} {0 128 0} [/ $wear 100.0]] \
            100
    pack .canvas
    pack .status
}

# Produce text output reporting device wear.
proc ::ssd-info::report {device wear} {
    variable message

    puts [format $message $device $wear]
}

# From http://wiki.tcl.tk/40097.
proc ::ssd-info::main-script? {} {
    global argv0
    if {[info exists argv0]
     && [file exists [info script]] && [file exists $argv0]} {
        file stat $argv0        argv0Info
        file stat [info script] scriptInfo
        expr {$argv0Info(dev) == $scriptInfo(dev)
           && $argv0Info(ino) == $scriptInfo(ino)}
    } else {
        return 0
    }
}

proc ::ssd-info::main {argv0 argv} {
    lassign $argv device
    if {![file exists $device]} {
        puts "usage: $argv0 device ?-nogui?"
        exit 0
    }

    set wear [::ssd-info::get-wearout $device]

    if {[string trimleft [lindex $argv 1] -] ne "nogui"} {
        gui $device $wear
    } else {
        report $device $wear
    }

}

if {[::ssd-info::main-script?]} {
    ::ssd-info::main $argv0 $argv
}