Initial revision

tcl/count.tcl

@@ -0,0 +1,45 @@
+#--------------------------------------------------------------------------
+# A count command for DMC
+# All arguments are optional. The current values will be used if not
+# specified
+# Dr. Mark Koennecke, Juli 1997
+#--------------------------------------------------------------------------
+proc SplitReply { text } {
+     set l [split $text =]
+     return [lindex $l 1]
+}
+#--------------------------------------------------------------------------
+proc count { {mode  NULL } { preset NULL } } {
+#----- deal with mode
+     set mode2 [string toupper $mode]
+     set mode3 [string trim $mode2]
+     set mc    [string index $mode2 0]
+     if { [string compare $mc T] == 0 } {
+       banana CountMode Timer
+     } elseif { [string compare $mc M] == 0 } {
+       banana CountMode Monitor
+     }
+#------ deal with preset
+     if { [string compare $preset NULL] != 0 } {
+       banana preset $preset
+     }
+#------ prepare a count message
+     set a [banana preset]
+     set aa [SplitReply $a]
+     set b [banana CountMode]
+     set bb [SplitReply $b]
+     ClientPut [format " Starting counting in %s mode with a preset of %s" \
+               $bb $aa] 
+#------- count
+     banana InitVal 0
+     banana count
+     Success
+#------- StoreData
+#     ClientPut [StoreData]
+}
+#---------------- Repeat -----------------------------------------------
+proc repeat { num {mode  NULL} {preset NULL} }  {
+     for { set i 0 } { $i < $num } { incr i } {
+        count $mode $preset
+     }
+}