Updated 2017-10-08 01:21:03 by Jorge

Jorge Moreno - March 31 2006

I needed to monitor equipment down times in a central supervision station, we have a panel with some light indicators, a PC with a National Instruments Digital Input/Ouput Card (called DIO).

So I integrated code from Task Timer,Based numbers,dllcaller and get this script.

It makes use of dll10 [1] to call the dll functions that control the IO hardware
 set dioPresent 0 
 set lstOfTesters {.icthp4\
                    .icthp5\
                    .icthp7\
                    .icthp10\
                    .icthp14\
                    .icthp18\
                    .icthp22\
                    .icthp24\
                    .icthp26\
                    .icthp27\
                    .icthp28\
                    .icthp29\
                    .icthp30\
                    .icthp32\
                    .icthp33\
                   .icthp35\
                   .icthp36\
                   .future\
                         } 
 
 console show
 set ctr 0  
 
 if {$dioPresent} {
 load dll10
 #status = DIG_Prt_Config (deviceNumber, port, mode, dir)
 set i [::dll::call nidaq32.dll DIG_Prt_Config i {i 1} {i 0} {i 0} {i 1}]
 set i [::dll::call nidaq32.dll DIG_Prt_Config i {i 1} {i 1} {i 0} {i 1}]
 set i [::dll::call nidaq32.dll DIG_Prt_Config i {i 1} {i 2} {i 0} {i 1}]
 }
  
 proc base {base number} {
    set negative [regexp ^-(.+) $number -> number] ;# (1)
    set digits {0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N
        O P Q R S T U V W X Y Z a b c d e f g h i j k l m n o p
        q r s t u v w x y z}
    set res {}
    while {$number} {
        set digit [expr {$number % $base}]
        set res [lindex $digits $digit]$res
        set number [expr {$number / $base}]
    }
    if $negative {set res -$res}
    set res
 }
 
 proc getPortAndBit {focoNr} {
  #La asignacion consecutiva de puertos de la dio, se comporta como numeros octales, shifted by one.
  return [format "%02s" [base 8 [expr {$focoNr - 1}]]]
 }
 
 proc every {ms body} {
    eval $body
    after $ms [list every $ms $body]
 }
 
 proc timeElapsed {sec} {
    set hours [expr {$sec / 3600}]
    set mins [expr {($sec / 60) % 60}]
    return [format "%02d:%02d" $hours $mins]
 }
 
  proc fmtTime {sec} {
    return [clock format $sec -format %H:%M]
 }
 
 
 # unfmtTime: Take H:M and return decimal hours
 proc unfmtTime {s} {
    set t [split $s ":"]
    set hr [string trimleft [lindex $t 0] "0"]
    if {$hr == ""} {set hr 0}
    set min [string trimleft [lindex $t 1] "0"]
    if {$min == ""} {set min 0}
    set hr [expr {0.01 * round(100 * ($hr + (1.0 * $min)/60))}]
 
    return [format "%.2f" $hr]
 }
 
 ######################################################
 ##
 ## Timer procs
 ##
 ######################################################
 
 proc toggleTimer {win} {
 global timer dioPresent
    if {$timer($win-state)} {
        $win.top.buttons.t config -relief flat
        $win.top.buttons.t config -background green
        set timer($win-state) 0
        set timer($win-inicio) "--/-- --:--"
           resetTimer $win
        #DIG_Out_Line $cardno $port $line $value
        if {$dioPresent} {
            set i [::dll::call nidaq32.dll DIG_Out_Line i {i 1} "i $timer($win-port)" "i $timer($win-bit)" {i 0}]
        }
    } else {
        $win.top.buttons.t config -relief sunken
        $win.top.buttons.t config -background red
        if {$timer($win-reset)} {
            set timer($win-reset) 0
        }
        set timer($win-init) [clock sec]
        set timer($win-state) 1
        if {$dioPresent} {
            set i [::dll::call nidaq32.dll DIG_Out_Line i {i 1} "i $timer($win-port)" "i $timer($win-bit)" {i 1}]
        }
        updateTimer
    }
 }
 
 proc resetTimer {win} {
 global timer    
    set timer($win-reset) 1
    set timer($win-elapsed) "00:00"
    set timer($win-init) [clock sec]
    set timer($win-prev) 0
 }
 
 proc updateTimer {} {
 global timer
    set lastW ""
    foreach win [array names timer] {
        set dashIx [string first - $win]
        set win [string range $win 0 [incr dashIx -1]]
        if {$lastW != $win} {
            set lastW $win
            if {$timer($win-state)} {
                set elapsed_sec [expr {[clock sec] - $timer($win-init)}]
                set timer($win-elapsed) [timeElapsed $elapsed_sec]
                set timer($win-inicio) [clock format $timer($win-init) -format "%m/%d %k:%M"]
            }
        }
    }
 }
 
 
 proc timer_create {win title} {
 global timer ctr
 incr ctr
 # Are we timing, or not?
 set timer($win-state) 0
 # Has the timer been reset?
 set timer($win-reset) 1
 # Store previous time elapsed
 set timer($win-prev) 0
 set timer($win-elapsed) "00:00"
 set timer($win-inicio) "--/-- --:--"
 set timer($win-port) [string range [getPortAndBit $ctr] 0 0]
 set timer($win-bit) [string range [getPortAndBit $ctr] 1 1]
  
 frame $win -class Radiobox
 ## -- Top frame
 frame $win.top
 pack  $win.top -side top
 label $win.top.l -textvar timer($win-inicio) -font {Tahoma 10}
 pack  $win.top.l -side left -padx 6
 
 # Buttons
 frame  $win.top.buttons
 pack   $win.top.buttons -side right -padx 6
 button $win.top.buttons.t -text $title -width 16 -background green
 pack   $win.top.buttons.t -side left
 
 ## -- Bottom frame
 frame $win.bottom
 pack  $win.bottom -side bottom
 label $win.bottom.l -textvar timer($win-elapsed) -font {Tahoma 20}
 pack $win.bottom.l
 $win.top.buttons.t config -command "toggleTimer $win"
 return $win
 }
 
 every [expr 1000 * 60] updateTimer
 foreach {uno dos} $lstOfTesters {
  timer_create $uno $uno
  timer_create $dos $dos
  grid $uno $dos
 }