Embedded MPlayer in Tk

Ok, something a bit more interesting.

I've been using mplayer since 'bout 94 (near as I can recall), it's has been and continues to be my video player of choice. In spite of that, I still learn things now and again. Today was an instance of learning a little something about it I didn't know before.

Mplayer supports a slave mode, this was news to me. In that mode it is geared to receive commands to manipulate the player. The intention is to allow the creation of front-ends which are plentiful for that reason. I found this especially useful in embedding Mplayer into a Tk window and binding Tk controls to the player.

Below is a rough sampling of how it can be done.

#!/usr/bin/tclsh
 package require Tk

 proc Exit { } {
   exit
 }

 proc Play { } {
   upvar #0 playerId playerId
   puts $playerId "pause"
 }

 proc ReadPipe {chan} {
   upvar #0 playerId playerId
     set d [read $chan]
     foreach line [split $d \n] {
         set line [string trim $line]
         if {[regexp {^\*\*\* screenshot '(.*?)' \*\*\*} $line -> filename]} {
             # delay to permit the file to appear
             after 250 [list OnScreenshot $filename]
         }
     }
     if {[eof $chan]} {
         fileevent $chan readable {}
         close $chan
         set playerId ""
     }
 }

 proc EmbedPlayer { w } {
   upvar #0 fileList fileList
   upvar #0 playerId playerId
   set cmd mplayer
   lappend cmd -slave -vf scale=1540:1050 -wid [winfo id $w] -idle

   set pipe [open |$cmd r+]
   fconfigure $pipe -blocking 0 -buffering line
   fileevent $pipe readable [list ReadPipe $pipe]
   set playerId $pipe

   puts $playerId "load [lindex $fileList 0]"
   set fileList [lrange $fileList 1 end]
 }

 proc main { { fileList [list]} } {
   wm title . "User Interface"
   wm protocol . WM_DELETE_WINDOW [list Exit]
   wm withdraw .

   frame .video -width 1540 -height 800
   grid .video  -sticky news

   frame .controls -width 1540 -height 100
   button .play -text "Play" -command Play
   grid .play -sticky news

   grid rowconfigure . 0 -weight 1
   grid columnconfigure . 0 -weight 1


   option add *tearOff false
   . configure -menu [menu .menu]
   .menu add cascade -label File -menu [menu .menu.file]
   .menu.file add command -label Exit -command Exit
   bind .video 

I stripped this segment out of a more involved utility I'm working on so it isn't as clean as it could be.

Issue ./mplayerUi and Bobs Your Uncle.

Cpu Load Monitoring

We've recently had explore collecting and analyzing CPU resource loading metrics for our project. The host OS is Linux 2.6 based and rather than install a performance-specific set of utilities we aimed at utilizing readily available services.

Ask any Linux weenie what CPU loading they have been experiencing and most will respond by starting the top utility. Top is available on most Unix distributions, is a well known utility and has pretty much stood the test of time. For those reasons it seemed obvious to incorporate it into a performance monitoring data collection and analysis tool suite.

The following Tcl script takes two arguments, the first an output file which will be populated with the redirected top log file, the second is a duration (in seconds) of how long to monitor the performance. After the raw collection has completed the script parses the log, extracts the CPU loading metrics and outputs a median and mean CPU processing load expressed in percentage of utilization.

It's worth noting that the script incorporates searching for the regular expression *Cpu* to find the top line item holding the Cpu metrics. As a result, if you have a process running that matches *Cpu* you'll find the script errors out during processing of the log file. I'll leave it as a lesson to the reader how to correct (wink).

We've extended on the same principle to monitor network activities.

Have fun.

#!/usr/bin/tclsh

proc log { msg } {
# puts stderr __$msg
}

proc mean { L } {
 set sum 0.0
 foreach e $L {
   set sum [expr $sum + $e]
 }
 return [expr $sum / [llength $L].]
}

proc median { L } {
 set L1 [lsort -real $L]
 return [lindex $L1 [expr [llength $L1] / 2]]
}

proc process { fileName } {
 set fp [open $fileName r]
 while { [gets $fp line] >= 0 } {
   switch -glob -- $line {
     *Cpu*
       {
         log "processing line '$line'"
         set el [split $line ,]
         set userLoad [string trimleft [lindex $el 0] "Cpu(s):"]
         set sysLoad [lindex $el 1]
         set niceLoad [lindex $el 2]
         set idleLoad [lindex $el 3]
         log "parsing $userLoad"
         log "parsing $sysLoad"
         log "parsing $niceLoad"
         log "parsing $idleLoad"
         set userLoad [lindex [split $userLoad \%] 0]
         set sysLoad [lindex [split $sysLoad \%] 0]
         set niceLoad [lindex [split $niceLoad \%] 0]
         set idleLoad [lindex [split $idleLoad \%] 0]
         log "extracted $userLoad"
         log "extracted $sysLoad"
         log "extracted $niceLoad"
         log "extracted $idleLoad"
#         puts [expr $userLoad+$sysLoad+$niceLoad+$idleLoad]
         lappend L [expr 100.0-$idleLoad]
       }
   }
 }
 close $fp
 puts "mean cpu load: [mean $L]"
 puts "median cpu load: [median $L]"
}

proc monitorCpuLoad { fileName duration } {
 catch { exec top -b -n $duration -d 1 > $fileName }
 process $fileName
}

proc help { } {
 upvar #0 argv0 argv0
 puts stderr "usage: $argv0 \[logFileName\] \[duration\]"
 exit
}

#---main---
 if { [llength $argv] != 2 } {
   help
 }
 monitorCpuLoad [lindex $argv 0] [lindex $argv 1]

Tcl Package Example

I often struggle setting up a Tcl script that utilizes packages. For convenience I'm publishing a template for scripts that capitalize on packages.

::::::::::::::
process
::::::::::::::
#!/usr/bin/tclsh


 proc log { msg } {
   set lvl [expr [info level] -2]
   set indent [string repeat "  " $lvl]
   tclLog "$indent\___$msg"
 }

 proc traceLog { } {
   set uplevel [expr [info level] -1]
   set callSig [info level $uplevel]
   set el [split $callSig]
   log "call trace: [namespace current][lindex $el 0]([lrange $el 1 end])"

 }

 proc packageInit { } {
   upvar #0 auto_path auto_path

   log "initializing system"
   set pathName [file dirname [info script]]
   log "discovered path name '$pathName'"
   pkg_mkIndex $pathName tcl/*.tcl
   lappend auto_path $pathName
   log "done initializing system"
 }

 proc proc01 { a b c d } {
   traceLog
 }

 proc proc02 { } {
   traceLog
   proc01 2 4 6 8
 }

#-----main-----
 packageInit
 package require package01
 package01::function01

 log "main thread initializing"
 proc01 1 2 3 4
 proc02
 log "main thread terminating"


::::::::::::::
tcl/package01.tcl
::::::::::::::
package provide package01 1.0

namespace eval package01 {
 proc function01 { } {
   puts "...function01() method entry"
   puts "...function01() method exit"
 }
}

Parsing File Lists with Tcl

Hey all,
Been a bit of time since my last post. I've been struggling attaining some new information to post, but haven't found anything 'post worthy'. Instead, I wandered back in the ol' memory to find a useful nugget of info that you may find useful.

I love Tcl. From the bottom of my heart, this is the scripting language of choice for this cubicle dweller. A routine use for scripting languages is to batch process vast lists of files. Any well behaved *nix user probably uses camel back file naming notations (e.g. SomeFileForYou.txt), while others may use a underscore delimited notation (e.g. some_file_for_you.txt), but Windows enthusiasts (many of my teammates included) insist on using spaces in their file names (e.g. Some File For You.txt).

Batch processing filenames with spaces can present a problem if you don't parse the list properly. Since Tcl lists are generally seperated by spaces, file names with spaces are parsed as individual files for each word.

Observe:

$ ls /var/tmp/someDir
total 8
-rw-r--r-- 1 fatslowkid fatslowkid 6 2008-05-07 22:38 Some Longer File Name.txt
-rw-r--r-- 1 fatslowkid fatslowkid 7 2008-05-07 22:38 Some Long File Name.txt

$ cat listFiles
   1  #!/usr/bin/tclsh
   2
   3  set fileList [exec find /var/tmp/someDir/]
   4  #set fileList [split $fileList "\n"]
   5
   6  foreach file $fileList {
   7   puts '$file'
   8  }

Running will result in:

$ ./listFiles
'/var/tmp/someDir/'
'/var/tmp/someDir/Some'
'Long'
'File'
'Name.txt'
'/var/tmp/someDir/Some'
'Longer'
'File'
'Name.txt'

Uncommenting line 4 which splits the list using the newline character as the delimiter solves the problem. Observe:

$ ./listFiles
'/var/tmp/someDir/'
'/var/tmp/someDir/Some Long File Name.txt'
'/var/tmp/someDir/Some Longer File Name.txt'

TaDa. Hope you find this useful, I certainly have over the years.

Piping to Tcl Script

Ok, maybe I've lived up to my name. I may very well be the fat slow
kid.

I struggled for some time trying to figure out how to pipe input to a Tcl script and immediately ventured off on a quest for opening a pipe (|) file descriptor. In actuality however, since I wanted to pipe input into the tcl script my needs are met by:

#!/usr/bin/tclsh
while { [gets stdin line] >= 0 } {
puts "got '$line'"
}

so

$ ls | ./tclPipe

results in

got 'Desktop'
got 'IM'
got 'ImagingManager.tar.gz'
got 'ISC'
got 'tclPipe'

My quest however also recovered if the input command is fixed:

#!/usr/bin/tclsh

set fp [open "|ls" r]
while { [gets $fp line] >= 0 } {
  puts "got $line"
}

would surfice.