1#!/bin/sh
2# the next line restarts using tclsh \
3exec tclsh "$0" "$@"
4
5# $Id: jitter.tcl,v 1.7 2004/08/25 19:26:26 baum Exp $
6
7# ensure that "." is the decimal point
8unset -nocomplain env(LC_ALL)
9set ::env(LC_NUMERIC) "C"
10
11set done 0
12set last0 0
13set last1 0
14set bgVal 0.1
15set exit 0
16
17proc background { } {
18   global bgVal
19   set bgVal [expr {sin( $bgVal )}]
20   after 1 background
21}
22
23proc callFunc { interval isTcl } {
24   set numCalls 10
25
26   set clock$isTcl [clock clicks -milliseconds]
27
28   global last$isTcl values$isTcl done
29   if { [set last$isTcl] != 0 } {
30      lappend values$isTcl [expr {[set clock$isTcl]-[set last$isTcl]}]
31      incr ::no$isTcl
32   } else {
33      set ::no$isTcl 0
34      set values$isTcl {}
35   }
36
37   if { [set ::no$isTcl] == $numCalls } {
38      set mean 0
39      set jitter 0
40      foreach val [set values$isTcl] {
41         incr mean $val
42      }
43      set mean [expr {$mean/double($numCalls)}]
44      set max 0
45      foreach el [set values$isTcl] {
46         set val [expr {abs($el-$mean)}]
47         if { $val > $max } {
48            set max  $val
49         }
50         set jitter [expr {$jitter+$val}]
51      }
52      set jitter [expr {$jitter/double($numCalls)}]
53
54      if { $isTcl } {
55         set name  Tcl
56      } else {
57         set name  Gnocl
58      }
59      puts [format "%6s %3d mean: %5.1f diff: %4.1f jitter: %3.1f max: %4.1f" \
60            $name $interval $mean [expr {$mean-$interval}] $jitter $max]
61      set last$isTcl 0
62      incr done
63      if { $isTcl == 0 } {
64         return -code break
65      }
66   } else {
67      set last$isTcl [clock clicks -milliseconds]
68      if { $isTcl } {
69         after $interval callFunc $interval 1
70      }
71   }
72}
73
74proc doIt { } {
75   # foreach el {0 1 5 9 10 11 20 25 50 100}
76   foreach el {11 21} {
77      callFunc $el 1
78      if { [catch {package present Gnocl}] == 0 } {
79         gnocl::callback create "callFunc $el 0" -interval $el
80         vwait ::done
81      }
82      vwait ::done
83   }
84
85   if { $::exit } {
86      exit
87   }
88}
89
90# background
91
92puts "pure Tcl"
93doIt
94
95puts "\npure Tcl with gnocl loaded"
96set auto_path [linsert $auto_path 0 [file join [file dirname [info script]] ../src]]
97package require Gnocl
98set id [gnocl::callback create {puts -nonewline ""} -interval idle ]
99after 100 "gnocl::callback delete $id"
100
101doIt
102
103
104#gnocl::callback create {puts -nonewline "A"; flush stdout} -interval 200
105#gnocl::callback create {puts -nonewline "B"; flush stdout} -interval 300
106
107puts "\ngnocl::mainLoop"
108after 500 doIt
109set exit 1
110gnocl::mainLoop -timeout 10
111
112
113
114