#!/usr/bin/wish -f
#
# TkMon a resource monitor for Linux Xwindows, made with Tcl 7.5 and Tk 4.1
# Coding and design by Arend van der Boom Copyleft(c) JUN 1997
# Logo designed and made by Larry Ewing Copyright(c)
#

wm title . "Tk Resource Monitor"
wm iconname . "TkMon"

set total(Memory)		0		;# Total amount of memory 
set total(Swap)			0		;# Total amount of swap 
set percentage(Memory)		0		;# Store the used space here
set percentage(Swap)		0		
set percentage(Cached)		0		
set percentage(Buffers)		0		
set percentage(Shared)		0		
set indicator(used)		red		;# color of used indicator
set indicator(free)		green		;# color of free indicator
set userpref(outp)		Bytes		;# Magnitude of the values
set userpref(what)		used		;# Display free or used memory
set userpref(time)		2		;# Updating info in secs.
set userpref(blink)		0		;# 1 Blink logo, 0 not
set userpref(geom)		+110+0		;# Position of window
set fp				0		;# Filepointer for /proc/meminfo

# Where to find the files
set logo1	"./tkmonn.gif"
set logo2	"./tkmonb.gif"
set rcfile	"./.tkmonrc"

# Main entrance of the application
proc Main {} {
	global percentage total userpref indicator
	global logo1

	if { [SanityCheck] == "insane"} {
		return -1
	} 

	init

	# Display Logo button
	image create photo logo
	button .l -relief sunken -image logo -borderwidth 2 -highlightthickness 0 \
			-activebackground yellow -background gray \
			-command "settings .usr"
	pack .l -side left
	logo configure -file $logo1

	# Contains all indicators
	frame .r -relief flat -borderwidth 0 -background gray
	pack .r -side right -fill y 

	# Display indicators
	foreach i {memory swap cached buffers shared} {
		canvas .r.$i -relief ridge -borderwidth 3 -width 200 \
				-height 15 -background gray \
				 -highlightthickness 0
		pack .r.$i -side top 
		.r.$i create text [expr 200/2] 10 \
				-text "$i 0$userpref(outp)" -tag txt
	}
	retrieveinfo
}

# Updates the indicators
#	- c	Canvas name
#	- tag	Name of indicator to update  
proc updateindicator {c tag} {
	global percentage total userpref indicator

	# Only Swap and Memory have both free and used space.
	# Cached, buffers and shared are alwayes used space
	set what $userpref(what)
	if { $tag == "Swap" } {
		set maxval $total($tag)
	} else {
		set maxval $total(Memory)
		if { $tag != "Memory" } {
			set what used
		}
	}
	if { $percentage($tag) <= $maxval && $percentage($tag) > 0 } {
		set res [expr $percentage($tag) / ($maxval / 200)]
		$c delete tot
		switch $what {
			"free"  { set color green 
				  set res [expr 200 - $res]
				  set val [expr $maxval - $percentage($tag)]
				}
			"used"  { set color red 
				  set val $percentage($tag)
				}
			"total" { set color red
				  set val $maxval
				  $c delete tot
				  $c create rectangle 0 0 \
					[expr 200 + 3] \
					[expr 15 + (3*2)] \
					-fill green -outline "" -tag tot
				}
		}
		switch $userpref(outp) {
			"Bytes"	{ set val $val }
			"Kb"	{ set val [expr $val / 1000] }
			"Mb"	{ set val [expr $val / 1000000] } 
			"%"	{ set val [expr $val / ($maxval/100)] }
		}
		$c delete $tag
		$c create rectangle 0 0 \
				[expr $res + 3] [expr 15 + (3*2)] \
				-fill $color -outline "" -tag $tag
 		$c raise txt
		$c itemconfigure txt -text "$tag $val $userpref(outp)"
	}
}

# Initilize application and various variables 
# This function must be called before the retrieveinfo function 
proc init {} {
	global total fp userpref

	rcfile read

	# If geometry parameters on command line use them. 
	if { [winfo exist .] } {
		set geom [wm geometry .]
		if { [string length $geom] > 7 } {
 			set geom [string range $geom [string first + $geom] end]
			wm geometry . $geom
			set userpref(geom) $geom
		} else {
			wm geometry . $userpref(geom)
		}	
	}
	set fp [open /proc/meminfo r]
	set minfo [read $fp]
	seek $fp 0 start
	set total(Memory)	[lindex $minfo 7]
	set total(Swap)		[lindex $minfo 14]
}

# Get the information
proc retrieveinfo {} {
	global total percentage userpref logo1 logo2 fp

	if { [eof $fp] == 1 } {
		seek $fp 0 start
	}
	set minfo [read $fp]	
	set percentage(Memory)	[lindex $minfo 8]
	set percentage(Swap)	[lindex $minfo 15]
	set percentage(Cached)	[lindex $minfo 12]
	set percentage(Buffers) [lindex $minfo 11]
	set percentage(Shared)  [lindex $minfo 10]

	updateindicator .r.memory Memory
	updateindicator .r.swap Swap
	updateindicator .r.cached Cached
	updateindicator .r.buffers Buffers
	updateindicator .r.shared Shared
	if { $userpref(blink) == 1 } {
		logo configure -file $logo2
		after 150 [list logo configure -file $logo1]
	}
	after [expr $userpref(time)*1000] [list retrieveinfo]
}

# Get the users preference of how to display the information
#	- w	Window name
proc settings {w} {
	global userpref indicator 
	catch {destroy $w}
	toplevel $w
	wm transient $w .
	wm geometry $w $userpref(geom)
	
	# Top Frame
	frame $w.t -relief flat -borderwidth 0 -highlightthickness 0
	pack $w.t -side top -fill x

	# Magnitude Options
	frame $w.t.mo -relief groove -borderwidth 2 -highlightthickness 0
	pack $w.t.mo -side left -fill x -expand true
	radiobutton $w.t.mo.perc -text "View %" -variable userpref(outp) \
				 -activebackground white -value % -anchor w
	radiobutton $w.t.mo.by -text "View Bytes" -variable userpref(outp) \
				-activebackground white -value Bytes -anchor w
	radiobutton $w.t.mo.kb -text "View Kb" -variable userpref(outp) \
				-activebackground white -value Kb -anchor w 
	radiobutton $w.t.mo.mb -text "View Mb" -variable userpref(outp) \
				-activebackground white -value Mb -anchor w
	pack $w.t.mo.perc $w.t.mo.by $w.t.mo.kb $w.t.mo.mb -side top -fill x

	# View Options
	frame $w.t.vo -relief groove -borderwidth 2 -highlightthickness 0
	pack $w.t.vo -side right -fill both -expand true
	radiobutton $w.t.vo.us -text "Show Used" -variable userpref(what) \
			-activebackground $indicator(used) -value used -anchor w
	radiobutton $w.t.vo.fr -text "Show Free" -variable userpref(what) \
			-activebackground $indicator(free) -value free -anchor w
	radiobutton $w.t.vo.to -text "Show Total" -variable userpref(what) \
			-activebackground white -value total -anchor w
	pack $w.t.vo.us $w.t.vo.fr $w.t.vo.to -side top -fill x \
			-expand true		

	# View Timing
	frame $w.ti -relief groove -borderwidth 2 -highlightthickness 0
	pack $w.ti -side top -fill x
	label $w.ti.t -text "Seconds :" -relief flat -borderwidth 0 -highlightthickness 0
	entry $w.ti.te -relief sunken -width 4 -borderwidth 2 -background white \
								-highlightthickness 0	
	pack $w.ti.t $w.ti.te -side left 
	$w.ti.te insert 0 $userpref(time)

	# Blinking 
	checkbutton $w.ti.bl -text "Blink" -variable userpref(blink) \
						 -activebackground white -anchor w
	pack $w.ti.bl -side left

	# About Tkmon
	button $w.ti.about -text "About" -relief raised -borderwidth 2 \
				-activebackground white -highlightthickness 2 \
				-command "AboutTkMon .about"
	pack $w.ti.about -side right

	button $w.ok -text "Ok" -relief raised -borderwidth 2 -highlightthickness 0 \
			-activebackground white -command "savepref $w"
	pack $w.ok -side bottom -fill x

	bind $w.ti.te <Return> "gettime $w.ti.te"
}

# Save prefrence
#	- w	window name
proc savepref {w} {
	rcfile write
	destroy $w
}

# Get interval time
#	- w	entry pathname
proc gettime {w} {
	global userpref
	set userpref(time) [$w get]
}

# Display Program information
#	- w	Parent window
proc AboutTkMon {w} {
	global userpref

	catch {destroy $w}
	toplevel $w
	wm transient $w .
	wm geom $w $userpref(geom)

	frame $w.f -relief ridge -borderwidth 4 -highlightthickness 4 
	pack $w.f -side top

	set text "\n TkMon a resource monitor for Linux Xwindows \n Coding & Design \
		  \n by \n Arend van der Boom \n Version Beta 1.0 \
		  Copyleft(c) 1997"
	message $w.f.m -text $text -width 300 -justify center
	label $w.f.l -image logo -relief groove -borderwidth 3
	message $w.f.m2 -text "Logo made by \n Larry Ewing" -justify center
	pack $w.f.m $w.f.l $w.f.m2 -side top

	button $w.f.ok -text "Ok" -relief raised -borderwidth 2 \
		-activebackground white -highlightthickness 3 -command "destroy $w"
	pack $w.f.ok -side bottom -fill x
}

# Get or Set the user preference
#	- o Option read or write rcfile
proc rcfile {o} {
	global userpref rcfile 

	if { $o == "read" && [file exists $rcfile] == 1 } {
		set fp [open $rcfile r]
		while { [eof $fp] == 0 && [gets $fp line] != -1 } {
			lappend buf $line
		}
		close $fp
		foreach i $buf {
			set idx [string first : $i]
			if { $idx != -1 } {
				set command [string range $i 0 [expr $idx-1]]
				set value [string range $i [expr $idx+1] end]
				if { [string length $command] > 0 && \
							[string length $value] > 0 } {
					filluserpref $command $value
				}
			}
		}
	} elseif { $o == "write" } {
		set fp [open $rcfile w]
			puts $fp "Magnitude : $userpref(outp)"
			puts $fp "Display : $userpref(what)"
			puts $fp "Retrieval time : $userpref(time)"
			puts $fp "Blink : $userpref(blink)"
		close $fp
	}
}

# Fill the userpref array
#	- c	witch array element to fill
#	- v	value to fill element with 	
proc filluserpref {c v} {
	global userpref

	set command [string trim [string tolower $c]]
	set value [string trim [string tolower $v]]
	switch $command {
		"magnitude" 	{ if { $value == "%" } {
				  	set userpref(outp) "%"
				  } elseif { $value == "bytes" } {
					set userpref(outp) "Bytes"
				  } elseif { $value == "kb" } {
					set userpref(outp) "Kb"
				  } elseif { $value == "mb" } {
					set userpref(outp) "Mb"
				  } 
				}
		"display"	{ if { $value == "used" } {
					set userpref(what) "used"
				  } elseif { $value == "free" } {
					set userpref(what) "free"
				  } elseif { $value == "total" } {
					set userpref(what) "total"
				  }
				}
		"retrieval time" { set userpref(time) $value }
		"blink"		{ set userpref(blink) $value }
	}
}

# SanityCheck, check if versions, platform and os are correct
proc SanityCheck {} {
	global tcl_platform tcl_version tk_version

	set err 0
	if { $tcl_platform(os) != "Linux" && $tcl_platform(platform) != "unix"} {
		set err 1
	} 
	if { $tcl_version < "7.5" || $tk_version < "4.1" } {
		set err 1
	}
	if { $err == 1 } {
		frame .sc -relief ridge -borderwidth 3 -highlightthickness 3
		pack .sc -side top
		set text "\nSOMETHING HAS GONE WRONG !!!\n"
		message .sc.m -text $text -width 300 -justify center
		set text "TkMon is designed to run under Xwindows\
			with the Tcl/Tk package.\n Tcl/Tk Versions Tcl 7.5 and Tk 4.1\
			\nOnly the Linux Operating System is supported.\n\
			Because TkMon uses the /proc filesystem to retrieve the\
			memory information about the System.\n\
			Your current configuration is not sufficient enough\n\
			Configuration found :\n Tcl/Tk - Tcl $tcl_version \
			Tk $tk_version, Platform - $tcl_platform(platform), \
			O.S. - $tcl_platform(os) \n \
			\n *** If you want to use this wonderful program\
			then it's time to upgrade ***\n (or change your O.S.)\n"
		message .sc.m2 -text $text -width 450 -justify center
		pack .sc.m .sc.m2 -side top -fill x

		button .sc.b -text "Ok" -activebackground white -command {destroy .}
		pack .sc.b -side top -fill x
		return "insane"
	} else {
		return "sane"
	}
}
# When application is deleted close /proc/meminfo file
wm protocol . WM_DELETE_WINDOW {die}
proc die {} {
	global fp

	close $fp
	rcfile write 
	destroy .
}

# Start the application
Main
