blob: 3f0e89fcde95464451c2af4b629ab7b4395f0ff5 (
plain) (
blame)
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
|
################################################################################
# INFO box.
################################################################################
set infoMode infoOptFr
# Current Frame information.
proc infoFrameUpdate args \
{
global version frame nframes
global frameWidth frameHeight frameDepth
global enhancement
global cpXcen cpYcen cpXoff cpYoff
global cpXmag cpYmag cpXscale cpYscale
if { [send infoOptWCS get on] } {
send client info wcs
return
} elseif {! [send infoOptFr get on]} \
return
if {$frame == 0} {
send infoText set string "initializing display..."
} else {
set line1 $version
set line2 [format "Image:\t\t%s" [send imageTitle get label]]
set line3 [format "Frame %d of %d:\t%d x %d" \
$frame $nframes $frameWidth $frameHeight]
set cmap [lindex $enhancement($frame) 0]
set brt [lindex $enhancement($frame) 1]
set con [lindex $enhancement($frame) 2]
set line4 [format "Colormap:\t%s" $cmap]
set line5 [format "Enhancement:\tBrt=%s Cont=%s" $brt $con]
set cntr [format "X: %0.1f\n\t\tY: %0.1f" $cpXcen $cpYcen]
set line6 [format "Center:\t\t%s" $cntr]
set line7 [format "Zoom:\t\tX: %0.2f\n\t\tY: %0.2f" $cpXmag $cpYmag]
set line8 [format "Scale:\t\tX: %0.2f\n\t\tY: %0.2f" $cpXscale $cpYscale]
set line9 [format "Offset:\t\tX: %0.2f\n\t\tY: %0.2f" $cpXoff $cpYoff]
send infoText set string [
format "%s\n\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n%s\n\n" \
$line1 $line2 $line3 $line4 $line5 $line6 $line7 $line8 $line9
]
}
}
set params {frame frameView nframes frameSize frameTitle enhancement}
foreach p $params { send $p addCallback infoFrameUpdate }
# Server Program State information.
proc infoOptToggle { widget type state args } \
{
global infoMode ismInfoText
if {$state} { set not False } else { set not True }
send $infoMode set on $not
set infoMode $widget
switch $widget {
infoOptFr { infoFrameUpdate }
infoOptSvr { set bp [send imagewin get basePixel]
set mc [send imagewin get maxColors]
send client info server $bp $mc
}
infoOptIsm { send infoText set string $ismInfoText }
infoOptClients { send client info clients }
infoOptWCS { send client info wcs }
infoOptFB { send client info imtoolrc }
}
}
set iopts {infoOptFr infoOptSvr infoOptIsm infoOptClients infoOptWCS infoOptFB }
foreach w $iopts { send $w addCallback infoOptToggle }
proc infoSetText { param old new } \
{
send infoText set string $new
} ; send info addCallback infoSetText
|
