#!/usr/bin/env tclsh
#
# i8kmon -- Monitor the fan speed on Dell laptops.
#
# Copyright (C) 2013       Vitor Augusto <vitorafsr@gmail.com>
# Copyright (C) 2001-2005  Massimo Dal Zotto <dz@debian.org>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.

set PROG_VERSION "v1.30 11/16/2013"

array set config {
    sysconfig	/etc/i8kmon.conf
    userconfig	~/.i8kmon
    i8kfan	/usr/bin/i8kfan
    acpi    "acpi"
    geometry	{}
    use_conf    1
    auto	1
    daemon	1
    verbose	0
    timeout	5
    unit	C
    t_high	80
    min_speed	2000
    0		{{0 0}  -1  60  -1  65}
    1		{{1 0}  50  70  55  75}
    2		{{1 1}  60  80  65  85}
    3		{{2 2}  70 128  75 128}
}

array set status {
    left	{}
    right	{}
    leftspeed	{}
    rightspeed	{}
    timer	{}
    nfans	2
    acpi_timer	0
    state	0
    temp	0
    lstate	0
    rstate	0
    lspeed	0
    rspeed	0
    lstuck	0
    rstuck	0
    ac		0
    t_low	0
    t_high	0
    ui		0
}

proc read_config {} {
    global config
    global status

    # read system config file
    if {[file exists $config(sysconfig)]} {
    	source $config(sysconfig)
	    if {$config(verbose) > 0} {
	        puts "reading system config file"
	    }
    }

    # read user config file
    # as it is read last, the options here have precedence
    if {$config(use_conf) != 0} {
        if {[file exists $config(userconfig)]} {
            source $config(userconfig)
	        if {$config(verbose) > 0} {
        		puts "reading user config file"
	        }
    	}
    }

    foreach key {0 1 2 3} {
	    set fans  [lindex $config($key) 0]
	    set lo_ac [lindex $config($key) 1]
	    set hi_ac [lindex $config($key) 2]
	    set lo_bt [lindex $config($key) 3]
	    set hi_bt [lindex $config($key) 4]

	    # check that for each key hi temp > lo temp
	    if {$lo_ac > $hi_ac} { set hi_ac [expr $lo_ac + 5]}
	    if {$lo_bt > $hi_bt} { set hi_bt [expr $lo_bt + 5]}

	    # set temperature to -1 to lo_ac and lo_bt at config(0)
	    if {$key == 0} {
	        set lo_ac -1
	        set lo_bt -1
	    }

	    # set temperature to 128 to hi_ac and hi_bt at config(3)
	    if {$key == 3} {
	        set hi_ac 128
	        set hi_bt 128
	    }

	    set config($key) [list $fans $lo_ac $hi_ac $lo_bt $hi_bt]
    }
}

proc status_timer {} {
    global config
    global status

    # Reschedule status timer
    catch {after cancel $status(timer)}
    set status(timer) [after [expr $config(timeout)*1000] {status_timer}]

    check_status
}

proc check_status {} {
    global config
    global status

    if {![read_i8k_status]} {
	return
    }

    if {$config(auto) == 1} {
	fan_control
    }

    if {$status(ui) == 1} {
	update_ui
    }
}

proc read_i8k_status {} {
    global config
    global status

    set temp [eval exec "i8kctl temp"]
    set status(temp) $temp
    set state [eval exec "i8kctl fan"]
    set status(lstate) [lindex $state 0]
    set status(rstate) [lindex $state 1]

    # Set fan speed based on probed values. In some systems, query for fan speed
    # is a slow call that freezes OS
    if {$status(lstate) != -1} {
	set status(lspeed) [lindex $status(leftspeed) $status(lstate)]
    } else {
	set status(lspeed) -1
    }
    if {$status(rstate) != -1} {
	set status(rspeed) [lindex $status(rightspeed) $status(rstate)]
    } else {
	set status(rspeed) -1
    }

    # If AC status is not available read it from procfs
    set ac [eval exec "i8kctl ac"]
    if {$ac < 0} {
	read_ac_status
    }

    # Done in make_ui.
    # If second fan status is not available assume we have only a fan
    #if {$status(nfans) >= 2 && $status(lstate) >= 0 && $status(rstate) < 0} {
    #	set status(nfans) 1
    #	catch {
    #	    place forget .i8kmon.rfan
    #	    place .i8kmon.lfan -relx 0.0 -rely 0.5 -relwidth 1.0 -relheight 0.5
    #	}
    #}

    # If fan speed is not available (on I4000) assume fans are running
    if {$status(lspeed) < 0} { set status(lspeed) $config(min_speed) }
    if {$status(rspeed) < 0} { set status(rspeed) $config(min_speed) }

    if {$config(verbose) > 0} {
        puts "temp, left, right, ac state: $status(temp) $status(lstate) $status(rstate) $status(ac)"
    }

    return 1
}

proc read_ac_status {} {
    global config
    global status

    # Read ac status once per minute
    if {[incr status(acpi_timer) -1] > 0} {
	return 1
    }

    set status(acpi_timer) [expr 60 / $config(timeout)]

    set acpi_ac [exec {*}$config(acpi)]
    if {[string match *on-line* $acpi_ac] || [string match *online* $acpi_ac]} {
        set status(ac) 1
    } else {
        set status(ac) 0
    }

    if {$config(verbose) > 0} {
        puts "[clock seconds] acpi: $acpi_ac"
    }

    return 0
}

proc fan_control {} {
    global config
    global status

    set index [expr $status(ac) ? 1 : 3]
    set state $status(state)
    set temp  $status(temp)

    set status(t_low)  [lindex $config($state) $index]
    set status(t_high) [lindex $config($state) [expr $index+1]]

    while {$temp < 128 && $temp >= $status(t_high)} {
	    if {$config(verbose) > 0} {
	        puts -nonewline "# ($temp>=$status(t_high)), "
	    }
	    incr state
	    set status(t_low)  [lindex $config($state) $index]
	    set status(t_high) [lindex $config($state) [expr $index+1]]
	    if {$config(verbose) > 0} {
	        puts "state=$state, low=$status(t_low), high=$status(t_high)"
	    }
    }

    while {$temp > 0 && $temp <= $status(t_low)} {
	    if {$config(verbose) > 0} {
	        puts -nonewline "# ($temp<=$status(t_low)), "
	    }
	    incr state -1
	    set status(t_low)  [lindex $config($state) $index]
	    set status(t_high) [lindex $config($state) [expr $index+1]]
	    if {$config(verbose) > 0} {
	        puts "state=$state, low=$status(t_low), high=$status(t_high)"
	    }
    }

    set_fan $state
}

proc set_fan {{state {}}} {
    global config
    global status

    if {$state != {}} {
	set status(state) $state
    }
    set args [lindex $config($status(state)) 0]

    # Default to user settings
    set left  $status(left)
    set right $status(right)

    if {$left == {} && $status(lstate) != [lindex $args 0]} {
	set left [lindex $args 0]
    }
    if {$left != {} && $left < [lindex $args 0]} {
	set left [lindex $args 0]
    }
    if {$left == $status(lstate)} {
	set left {}
    }

    if {$right == {} && $status(rstate) != [lindex $args 1]} {
	set right [lindex $args 1]
    }
    if {$right != {} && $right < [lindex $args 1]} {
	set right [lindex $args 1]
    }
    if {$right == $status(rstate)} {
	set right {}
    }
    if {$status(nfans) < 2} { set right {} }

    if {$left != {} || $right != {}} {
	i8kfan $left $right
    }
}

# Run the external i8kfan command and update fan state
proc i8kfan {args} {
    global config
    global status

    if {$args == {- -}} return

    set cmd [linsert $args 0 exec $config(i8kfan)]
    if {$config(verbose) > 0} {
	puts "# $cmd"
    }

    set result [eval $cmd]
    set status(lstate) [lindex $result 0]
    set status(rstate) [lindex $result 1]

    if {$status(lstate) < 0} { set status(lstate) 0 }
    if {$status(rstate) < 0} { set status(rstate) 0 }
}

proc make_ui {} {
    global status
    global config
    global tcl_version

    if {$config(daemon) == 1} {
	# Daemon mode, no user interface
	return
    }
    if {[info command .i8kmon] != {}} {
	# Applet aready existing
	return
    }

    # Load Tk library (require a Tk version >=8.4)
    package require Tk 8.4
    wm title . {}
    wm withdraw .
    update

    toplevel .i8kmon -class I8kmon -relief sunken -bd 1
    wm title .i8kmon i8kmon
    wm command .i8kmon i8kmon
    wm protocol .i8kmon WM_DELETE_WINDOW { exit }

    if {$config(geometry) != {}} {
	set geometry $config(geometry)
    } else {
	set geometry 24x24
    }
    if {[lindex [split $geometry x] 1] >= 36} {
	set font fixed
    } else {
	set font 6x10
    }
    wm geometry .i8kmon $geometry

    label .i8kmon.temp -bd 0 -padx 0 -pady 0 -text "0" -font $font \
	    -highlightthickness 0 -width 3
    button .i8kmon.lfan -bd 1 -padx 0 -pady 0 -text {} -font $font \
	    -highlightthickness 0 -command {toggle_fan left}
    button .i8kmon.rfan -bd 1 -padx 0 -pady 0 -text {} -font $font \
	    -highlightthickness 0 -command {toggle_fan right}
    bind .i8kmon.lfan <Button-2> {toggle_fan left 2}
    bind .i8kmon.lfan <Button-3> {toggle_fan left 0}
    bind .i8kmon.rfan <Button-2> {toggle_fan right 2}
    bind .i8kmon.rfan <Button-3> {toggle_fan right 0}

    place .i8kmon.temp -relx 0.0 -rely 0.0 -relwidth 1.0 -relheight 0.5
    place .i8kmon.lfan -relx 0.0 -rely 0.5 -relwidth 0.5 -relheight 0.5
    place .i8kmon.rfan -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5

    # Set $status(lstate) and $status(rstate)
    read_i8k_status
    if {$status(lstate) < 0} {
	place forget .i8kmon.lfan
	place .i8kmon.rfan -relx 0 -rely 0.5 -relwidth 1 -relheight 0.5
    }
    if {$status(rstate) < 0} {
	place forget .i8kmon.rfan
	place .i8kmon.lfan -relx 0 -rely 0.5 -relwidth 1 -relheight 0.5
    }

    set status(bg)       [.i8kmon.lfan cget -bg]
    set status(activebg) [.i8kmon.lfan cget -activebackground]
    set status(ui)	 1

    make_menu .i8kmon

    update
}

proc make_menu {w} {
    global config
    global status

    set menu $w.menu
    menu $menu -tearoff 0
    $menu add check -label "Auto"    -variable config(auto)
    $menu add check -label "Verbose" -variable config(verbose)
    $menu add separator
    $menu add command -label "Reload" -command { read_config; status_timer }
    $menu add command -label "Exit"   -command { exit }

    bind .i8kmon.temp <Button-1> "tk_popup $menu %X %Y"
}

proc update_ui {} {
    global config
    global status

    # If applet window is unexpectedly destroyed exit the program
    if {![winfo exists .i8kmon]} {
	puts stderr "applet window destroyed, exit"
	exit 1
    }

    set bg $status(bg)
    set ab $status(activebg)

    # Temperature
    if {$status(temp) >= $config(t_high)} {
	set fg red
    } else {
	set fg black
    }
    if {$config(unit) == "F" } {
	.i8kmon.temp config -text [expr (0+$status(temp))*9/5+32] -fg $fg
    } else {
	.i8kmon.temp config -text $status(temp) -fg $fg
    }

    # Left button
    if {$status(lstate) != 0 && $status(lspeed) < $config(min_speed)} {
	incr status(lstuck)
    } else {
	set status(lstuck) 0
    }
    if {$status(lstate) == 0} {
	.i8kmon.lfan config -text {} -bg $bg -activebackground $ab
    } elseif {$status(lstuck) >= 2} {
	.i8kmon.lfan config -text $status(lstate) -bg red -activebackground red
    } else {
	.i8kmon.lfan config -text $status(lstate) -bg $bg -activebackground $ab
    }

    # Right button
    if {$status(nfans) < 2} { return }
    if {$status(rstate) != 0 && $status(rspeed) < $config(min_speed)} {
	incr status(rstuck)
    } else {
	set status(rstuck) 0
    }
    if {$status(rstate) == 0} {
	.i8kmon.rfan config -text {} -bg $bg -activebackground $ab
    } elseif {$status(rstuck) >= 2} {
	.i8kmon.rfan config -text $status(rstate) -bg red -activebackground red
    } else {
	.i8kmon.rfan config -text $status(rstate) -bg $bg -activebackground $ab
    }
}

proc toggle_fan {fan {speed {}}} {
    global status

    if {$speed != {}} {
	set status($fan) $speed
    } else {
	if {$fan == "left"} {
	    set status($fan) $status(lstate)
	} else {
	    set status($fan) $status(rstate)
	}
	set status($fan) [expr ($status($fan)+1) % 3]
    }
    if {$fan == "left"} {
	i8kfan $status($fan) {}
    } else {
	i8kfan {} $status($fan)
    }
    if {$status($fan) == 0} {
	set status($fan) {}
    }
    update_ui
}

proc usage {} {
    global argv0

    regsub -all {^.*/} $argv0 {} progname
    puts "Usage:  $progname \[<options>...]

Options:

    -a|--auto               control automatically the fans
   -na|--noauto	            don\x27t control automatically the fans
    -d|--daemon             run in daemon mode without user interface
   -nd|--nodaemon           don\x27t run as daemon, open the user interface
   -nc|--nouserconfig       don\x27t use \$HOME/.i8kmon
    -v|--verbose            report status on stdout
    -g|--geometry <geom>    set applet geometry
    -t|--timeout <secs>     set poll timeout
    -u|--unit C|F           set temperature display unit

"
}

proc parse_options {} {
    global config
    global status
    global argv
    global PROG_VERSION

    for {set i 0} {$i < [llength $argv]} {incr i} {
	set arg [lindex $argv $i]
	switch -- $arg {
	    -\? - -h - -help - --help {
		usage
		exit
	    }
	    --daemon - -d {
		set config(daemon) 1
	    }
	    --nodaemon - -nd {
		set config(daemon) 0
	    }
	    --auto - -a {
		set config(auto) 1
	    }
	    --noauto - -na - -n {
		set config(auto) 0
	    }
        --nouserconfig - -nc {
        set config(use_conf) 0
        }
	    --verbose - -v {
		set config(verbose) 1
	    }
	    --geometry - -g {
		set config(geometry) [lindex $argv [incr i]]
	    }
	    --timeout - -t {
		set config(timeout) [lindex $argv [incr i]]
	    }
	    --unit - -u {
		set config(unit) [lindex $argv [incr i]]
	    }
	    -- {
		continue
	    }
	    default {
		puts stderr "invalid option: $arg"
		exit 1
	    }
	}
    }

    if {$config(verbose) > 0} {
	set copyright "Copyright (C) 2013 Vitor Augusto <vitorafsr@gmail.com>"
	puts "i8kmon $PROG_VERSION - $copyright"
	parray config
	parray status
    }
}

proc trap_signals {} {
    # This works only with the TclX extension library.
    catch {
	package require Tclx
	signal -restart trap SIGHUP { read_config; status_timer }
    }
}

proc probe_fan_speed {} {
    global status

    i8kfan 1 1
    after 1000
    set speeds [eval exec "i8kctl speed"]
    set lspeed1 [lindex $speeds 0]
    set rspeed1 [lindex $speeds 1]

    i8kfan 2 2
    after 1000
    set speeds [eval exec "i8kctl speed"]
    set lspeed2 [lindex $speeds 0]
    set rspeed2 [lindex $speeds 1]

    i8kfan 3 3
    after 1000
    set speeds [eval exec "i8kctl speed"]
    set lspeed3 [lindex $speeds 0]
    set rspeed3 [lindex $speeds 1]

    set status(leftspeed) "0 $lspeed1 $lspeed2 $lspeed3"
    set status(rightspeed) "0 $rspeed1 $rspeed2 $rspeed3"
}

# probe external tools
proc probe_tools {} {

    # The possibility of choosing 'acpi' or 'acpitool' is for compatibility
    # between different architectures: amd64, i386, kFreeBSD
    # This code below is strictly related on package dependency stated at
    # keyword 'Depends:' on file 'debian/control'
    if {![catch {exec acpi}]} {
        set config(acpi) "acpi"
    } elseif {[catch {exec acpitool}]} {
        set config(acpi) "acpitool"
    } else {
        puts stderr "Package dependency problem: neither 'acpi' nor 'acpitool' package is installed"
    }
}

proc main {} {
    probe_fan_speed
    probe_tools
    read_config
    parse_options
    make_ui
    trap_signals
    status_timer
}

if {$tcl_interactive == 0} {
    main
    vwait forever
}

