/usr/share/doc/nam/examples/tcl/NamgraphModel.tcl is in nam-examples 1.15-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 | Class NamgraphModel -superclass Observable
NamgraphModel instproc init { nid obs } {
$self next
$self instvar id_ datacount Maxy_ Maxx_ animator_id_ timeslider_swidth_
set id_ $nid
set datacount 0
set animator_id_ $obs
set Maxy_ [$obs set highest_seq($id_)]
set Maxx_ [$obs set maxtime]
}
NamgraphModel instproc id {} {
$self instvar id_
return $id_
}
NamgraphModel instproc animator {} {
$self instvar animator_id_
return $animator_id_
}
NamgraphModel instproc adddata { ob mid x y ymark } {
$self instvar dataname datacount id_ dataplotx dataploty
$self instvar plotmark plotcolor dataplotym
$self tkvar midbuilder
if ![info exists midbuilder($mid)] {
set midbuilder($mid) $datacount
set mname [$ob set filter_id($mid)]
set pmark [$ob set plotmark($id_.$mid)]
set pcolor [$ob set plotcolor($id_.$mid)]
set pcolor [$ob set colorname($pcolor)]
set dataname($datacount) $mname
set plotmark($datacount) $pmark
set plotcolor($datacount) $pcolor
incr datacount
}
set current_index $midbuilder($mid)
lappend dataplotx($current_index) $x
lappend dataploty($current_index) $y
set dataplotym($y) $ymark
}
NamgraphModel instproc verifyymark { index } {
$self instvar dataplotym
if [info exists dataplotym($index)] {
return $dataplotym($index)
}
return ""
}
NamgraphModel instproc startview {title} {
$self instvar Maxy_ Maxx_
set vob [new NamgraphView $title $self 0 $Maxx_ 0 $Maxy_ 1]
$self addObserver $vob
}
#----------------------------------------------------------------------
# NamgraphModel instproc update { arg }
# - Must have update
# - two possible args
# 1. Animator current time - single value
# 2. trace event - a list
#
# - Requires that all trace events have a -t flag with a value
#----------------------------------------------------------------------
NamgraphModel instproc update { arg } {
# Check to see if it is a trace event
set now [get_trace_item "-t" $arg]
if { $now == "" } {
# no -t flag so assume it must be a single value
set now $arg
$self notifyObservers $now
} else {
# arg is trace event, what to do ?
}
}
|