#!/bin/sh
# the next line restarts using wish \
exec bltwish "$0" "$@"       

# TkPerfmeter (Version 0.2)
#
# Copyright (C) 2000 by T.Sato <VEF00200@nifty.ne.jp>
#
# http://member.nifty.ne.jp/tsato/tkdeskset/
#
# 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
# of the License, or 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.

wm title . "TkPerfmeter  (Version 0.2)"
wm iconname . "TkPerfmeter"

# This program requires BLT, which can be obtained for free
# at http://www.tclk.com/blt.

package require BLT
namespace import blt::*

# set default parameters

set meters { cpu pkts page swap intr disk ctxt load colls error }
set tkperfmeterrc "$env(HOME)/.tkperfmeterrc"

foreach meter $meters { set cur_opt(show_$meter) 0 }
set cur_opt(orient) "Vertical"
set cur_opt(interval) 1

set opt(width) 80
set opt(height) 60

catch { source $tkperfmeterrc }

# some initialization

set many_zeros [ list 0 ]
for { set i 0 } { $i < 8 } { incr i } {
    set many_zeros [ concat $many_zeros $many_zeros ]
}
set n_many_zeros [ llength $many_zeros ]

foreach meter $meters {
    set ydata($meter) $many_zeros
    set delta($meter) 0
}

# For Japanese locale, translate messages to Japanese.

set lang "C"
if { ! [ catch { kanji code "abc" } ] } {
    catch { set lang $env(LANG) }
    catch { set lang $env(LC_ALL) }
    catch { set lang $env(LC_MESSAGES) }
}

proc gettext msg {
    global lang

    if [ regexp {^ja_|^japanese|^ja$} $lang junk ] {
	switch $msg {
	    "m cpu"   { return "CPU" }
	    "m pkts"  { return "パケット" }
	    "m page"  { return "ページ" }
	    "m swap"  { return "スワップ" }
	    "m intr"  { return "割り込み" }
	    "m disk"  { return "ディスク" }
	    "m ctxt"  { return "コンテキスト" }
	    "m load"  { return "負荷" }
	    "m colls" { return "衝突" }
	    "m error" { return "エラー" }
	    "Show %s" { return "%sを表示" }
	    "Properties..." { return "プロパティ..." }
	    "Monitor:" { return "モニタ:" }
	    "Orientation:" { return "方向:" }
	    "Vertical" { return "垂直" }
	    "Horizontal" { return "水平" }
	    "Sample time:" { return "サンプル周期" }
	    "Apply" { return "適用" }
	    "Dismiss" { return "閉じる" }
	    "Save as Default" { return "デフォルトに保存" }
	}
    }
    switch $msg {
	"cpu"   { return "cpu  " }
	"pkts"  { return "pkts " }
	"page" 	{ return "page " }
	"swap" 	{ return "swap " }
	"intr" 	{ return "intr " }
	"disk" 	{ return "disk " }
	"ctxt" 	{ return "cntxt" }
	"load"  { return "load " }
	"colls" { return "colls" }
	"error" { return "errs " }
	"m cpu"   { return "CPU" }
	"m pkts"  { return "Packets" }
	"m page"  { return "Page" }
	"m swap"  { return "Swap" }
	"m intr"  { return "Interrupts" }
	"m disk"  { return "Disk" }
	"m ctxt"  { return "Context" }
	"m load"  { return "Load" }
	"m colls" { return "Collisions" }
	"m error" { return "Errors" }
    }
    return $msg
}


################################################################
# Property panel

proc popup_props_panel {} {
    global meters cur_opt

    if [ winfo exists .props ] { destroy .props }

    toplevel .props -borderwidth 3m
    wm title .props "TkPerfmeter - Properties"
    wm transient .props .
    wm resizable .props false false

    set row 0

    label .props.monitor_label -text [ gettext "Monitor:" ]
    grid .props.monitor_label -row $row -col 0 -sticky e

    set col 1
    foreach meter $meters {
	checkbutton .props.$meter -variable cur_opt(show_$meter) \
		-text [ gettext "m $meter" ]
	grid .props.$meter -row $row -col $col -sticky w
	grid columnconfigure .props $col -minsize 70
	incr col
	if { 5 < $col } {
	    incr row
	    set col 1
	}
    }

    incr row
    label .props.orient_label -text [ gettext "Orientation:" ] -pady 3
    grid .props.orient_label -row $row -col 0 -sticky e
    frame .props.orient_frame 
    grid .props.orient_frame -row $row -col 1 -columnspan 5 -sticky w

    radiobutton .props.orient_vert -variable cur_opt(orient) -value "Vertical" \
	    -text [ gettext "Vertical" ]
    radiobutton .props.orient_horiz -variable cur_opt(orient) -value "Horizontal" \
	    -text [ gettext "Horizontal" ]
    pack .props.orient_vert .props.orient_horiz -in .props.orient_frame -side left

    incr row
    label .props.interval_label -text [ gettext "Sample time:" ] -pady 3
    grid .props.interval_label -row $row -col 0 -sticky e
    scale .props.interval_value -from 1 -to 60 -orient horizontal \
	    -variable cur_opt(interval)
    grid .props.interval_value -row $row -col 1 -columnspan 5 -sticky w

    incr row
    frame .props.bot
    button .props.apply -text [ gettext "Apply" ] \
	    -command { apply_props; destroy .props }
    button .props.dismiss -text [ gettext "Dismiss" ] \
	    -command { destroy .props }
    button .props.default -text [ gettext "Save as Default" ] \
	    -command { save_props }
    pack .props.apply .props.dismiss -in .props.bot -side left -pady 2 -padx 2
    pack .props.default -in .props.bot -side left -pady 2 -padx 16
    grid .props.bot -row $row -col 0 -columnspan 6
}

proc apply_props {} {
    global meters opt cur_opt read_stat_cnt n_meters

    foreach s [ array names cur_opt ] {
	set opt($s) $cur_opt($s)
    }

    set n_meters 0
    set ht 0
    foreach meter $meters {
	if [ winfo ismapped .$meter ] {
	    if { $ht == 0 } {
		set ht [ winfo height .$meter ]
		set wd [ winfo width .$meter ]
	    }
	    pack forget .$meter
	}
	if { $opt(show_$meter) } { incr n_meters }
    }
    if { $ht == 0 } {
	set ht $opt(height)
	set wd $opt(width)
    }

    if { $n_meters == 0 } {
	incr n_meters
	set cur_opt(show_cpu) 1
	set opt(show_cpu) 1
    }

    foreach meter $meters {
	if { $opt(show_$meter) } {
	    if { $opt(orient) == "Horizontal" } {
		pack .$meter -side left -padx 1 -fill both -expand true
	    } else {
		pack .$meter -fill both -expand true
	    }
	}
    }
    if { $opt(orient) == "Horizontal" } {
	set wd [ expr ($wd + 2) * $n_meters ]
    } else {
	set ht [ expr $ht * $n_meters ]
    }
    set scr_wd [ expr [ winfo screenwidth . ] - 10 ]
    set scr_ht [ expr [ winfo screenheight . ] - 20 ]
    if { $scr_wd < $wd } { set wd $scr_wd }
    if { $scr_ht < $ht } { set ht $scr_ht }
    if { $ht != [ winfo height . ] || $wd != [ winfo width . ] } {
	wm geometry . "[ expr $wd ]x$ht"
    }

    set read_stat_cnt 1000
}

proc save_props {} {
    global tkperfmeterrc cur_opt meters

    set f [ open "$tkperfmeterrc" w ]
    foreach s [ array names cur_opt ] {
	puts $f "set cur_opt($s) $cur_opt($s)"
    }

    set ht 0
    foreach meter $meters {
	if [ winfo ismapped .$meter ] {
	    if { $ht == 0 } {
		set ht [ winfo height .$meter ]
		set wd [ winfo width .$meter ]
	    }
	}
    }
    puts $f "set opt(height) $ht"
    puts $f "set opt(width) $wd"

    close $f
}


# switch meter to be displayed

proc meter_menu_selected new_meter {
    global meters n_meters cur_opt

    if { $n_meters <= 1 } {
	foreach meter $meters { set cur_opt(show_$meter) 0 }
	set cur_opt(show_$new_meter) 1
    } else {
	set cur_opt(show_$new_meter) [ expr !$cur_opt(show_$new_meter) ]
    }
    apply_props
}


################################################################
# Meters

proc make_chart meter {
    frame .$meter

    barchart .$meter.graph -barmode aligned -title "" \
	    -leftmargin 1 -rightmargin 1 -bottommargin 1 -topmargin 1 \
	    -plotpadx 0 -plotpady 0 -width 30 -height 30

    .$meter.graph legend configure -hide yes
    .$meter.graph element create z -borderwidth 0 -barwidth 0
    .$meter.graph grid configure -hide yes

    pack .$meter.graph -fill both -expand true

    frame .$meter.footer
    label .$meter.label -text [ gettext $meter ] -font { -size -10 }
    label .$meter.max -text "" -font { -size -10 }
    pack .$meter.label -in .$meter.footer -side left
    pack .$meter.max -in .$meter.footer -side right
    pack .$meter.footer -fill x
}


# set fullscale for the meter

proc set_fullscale { meter max } {
    .$meter.graph axis configure y -min [ expr -$max / 25.0 ] -max $max
    .$meter.max configure -text [ format "%3d" $max ]
}


################################################################
# Read status informations from /proc files
# - this is tested on redhat Linux 5.2 and 6.1

proc read_stat {} {
    global meters opt read_stat_cnt
    global last_value delta ydata many_zeros n_many_zeros

    incr read_stat_cnt
    if { $opt(interval) <= $read_stat_cnt } {
	set read_stat_cnt 0

	set f [ open "/proc/stat" r ]
	while { 0 <= [ gets $f line ] } {
	    regsub -all " +" $line " " line
	    set s [ split $line " +" ]
	    switch [ lindex $s 0 ] {
		cpu {
		    set cur_value(cpu_used) [ expr [ lindex $s 1 ] + \
			    [ lindex $s 2 ] + [ lindex $s 3 ] ]
		    set cur_value(cpu_idel) [ lindex $s 4 ]
		}
		page {
		    set cur_value(page) [ expr [ lindex $s 1 ] + [ lindex $s 2 ] ]
		}
		swap {
		    set cur_value(swap) [ expr [ lindex $s 1 ] + [ lindex $s 2 ] ]
		}
		default {
		    set cur_value([ lindex $s 0 ]) [ lindex $s 1 ]
		}
	    }
	}
	close $f

	set cur_value(pkts)  0
	set cur_value(error) 0
	set cur_value(colls) 0

	set f [ open "/proc/net/dev" r ]
	gets $f line
	gets $f line
	regsub {^ +} $line {} line
	regsub -all {[|: ]+} $line { } line
	set keys [ split $line { } ]
	while { 0 <= [ gets $f line ] } {
	    regsub {^ +} $line {} line
	    regsub -all {[|: ]+} $line { } line
	    set s [ split $line { } ]
	    for { set i 0 } { $i < [ llength $s ] } { incr i } {
		switch -glob [ lindex $keys $i ] {
		    pac* { incr cur_value(pkts)  [ lindex $s $i ] }
		    err* { incr cur_value(error) [ lindex $s $i ] }
		    col* { incr cur_value(colls) [ lindex $s $i ] }
		}
	    }
	}
	close $f

	set f [ open "/proc/loadavg" r ]
	gets $f line
	close $f
	set s [ split $line " +" ]
	set cur_value(load) [ lindex $s 1 ]

	if [ array exists last_value ] {
	    foreach s [ array names cur_value ] {
		set delta($s) [ expr $cur_value($s) - $last_value($s) ]
	    }
	    set delta(cpu) [ expr $delta(cpu_used) * 100 \
		    / ($delta(cpu_used) + $delta(cpu_idel)) ]
	    set delta(load) $cur_value(load)

	    set x0 -1
	    foreach meter $meters {
		if { $opt(show_$meter) } {
		    if { $x0 < 0 } {
			set x0 [ expr $n_many_zeros - [ winfo width .$meter.graph ] ]
			if { $x0 < 0 } { set x0 0 }
			set xlist [ lrange $many_zeros $x0 end ]
		    }
		    if { $meter != "cpu" } {
			set delta($meter) [ expr $delta($meter) / $opt(interval) ]
		    }
		    set ydata($meter) [ lreplace $ydata($meter) 0 0 ]
		    lappend ydata($meter) $delta($meter)
		    set ylist [ lrange $ydata($meter) $x0 end ]
		    if { $meter != "cpu" && $meter != "load" } {
			set max 1
			foreach y $ylist {
			    if { $max < $y } { set max $y }
			}
			set_fullscale $meter [ expr round($max * 1.2 + 1) ]
		    }

		    .$meter.graph element configure z -xdata $xlist -ydata $ylist
		}
	    }
	}
	foreach s [ array names cur_value ] {
	    set last_value($s) $cur_value($s)
	}
    }
    after 1000 { read_stat }
}


################################################################
# The main routine.

set mode_specified 0
while { 0 < [ llength $argv ] } {
    switch -- [ lindex $argv 0 ] {
	"-V" {
	    set s [ lindex $argv 1 ]
	    set argv [ lreplace $argv 0 1 ]
	    if { 0 <= [ lsearch $meters $s ] } {
		set cur_opt(show_$s) 1
		set mode_specified 1
	    } else {
		puts "tktapetool: bad parameter for -V option: $s"
		puts "tktapetool: available parameters are: $meters"
	    }
	}
	"-title" {
	    wm title . [ lindex $argv 1 ]
	    set argv [ lreplace $argv 0 1 ]
	}
	"-i" {
	    set s [ lindex $argv 1 ]
	    set argv [ lreplace $argv 0 1 ]
	    if { [ regexp {^[0-9]+$} $s junk ] && 1 <= $s } {
		set cur_opt(interval) $s
	    } else {
		puts "tktapetool: must be a number: $s"
	    }
	}
	default {
	    puts "tktapetool: no such option: [ lindex $argv 0 ]"
	    set argv [ lreplace $argv 0 0 ]
	}
    }
}

bind . <ButtonPress> {
    if [ winfo exists .menu ] { destroy .menu }
    menu .menu -tearoff false
    foreach meter $meters {
	.menu add checkbutton -indicatoron [ expr 1 < $n_meters ] \
		-label [ format [ gettext "Show %%s" ] [ gettext "m $meter" ] ] \
		-variable opt(show_$meter) \
		-command "meter_menu_selected $meter"
    }
    .menu add separator
    .menu add command -label [ gettext "Properties..." ] \
	    -command { popup_props_panel }

    tk_popup .menu %X %Y
}

foreach meter $meters { make_chart $meter }
set_fullscale cpu 100
set_fullscale load 1

apply_props
read_stat
set read_stat_cnt 1000