widgets.tcl
1:
2: set move(lastX) 0
3: set move(lastY) 0
4:
5: proc hxB2decN {hnm} {
6: set ln [string length $hnm]
7: if $ln!=2 then {return "input must be 1 byte"}
8: set y1 [binary format H2 $hnm]
9: binary scan $y1 c* y2
10: set y2 [expr {($y2 + 0x100 ) % 0x100}]
11: return $y2
12: }
13:
14: proc decN2Hx {dn} {
15: if $dn>255 then {return "input must be 1 byte"}
16: binary scan [binary format c $dn] H2 hc
17: return $hc
18: }
19:
20: proc plotMove {w i x y} {
21: global move
22: global PLOT
23: if {$x - $PLOT($i,x) > [expr $PLOT($i,w) / 2]} {
24: incr PLOT($i,w) [expr {$x-$move(lastX)}]
25: incr PLOT($i,h) [expr {$y-$move(lastY)}]
26: } else {
27: incr PLOT($i,x) [expr {$x-$move(lastX)}]
28: incr PLOT($i,y) [expr {$y-$move(lastY)}]
29:
30: .n.f0.frameC.curve move "curve_frame_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
31: .n.f0.frameC.curve move "curve_scale_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
32: .n.f0.frameC.curve move "curve_bg_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
33: .n.f0.frameC.curve move "curve_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
34: }
35: set move(lastX) $x
36: set move(lastY) $y
37: if {$x - $PLOT($i,x) > [expr $PLOT($i,w) / 2]} {
38: plot_bg $i
39: plot_draw_data $i
40: }
41: }
42:
43: proc plotSet {x y} {
44: global move
45: set move(lastX) $x
46: set move(lastY) $y
47: }
48:
49: proc plotMoveEnd {i} {
50: plot_redraw $i
51: }
52:
53: proc set_point {i L POINT UPDOWN} {
54: global PLOT
55: set VAL [expr [lindex $PLOT($i,ydata,$L) $POINT] + $UPDOWN]
56: set PLOT($i,ydata,$L) [lreplace $PLOT($i,ydata,$L) $POINT $POINT $VAL]
57: eval .frame$L.point_$POINT.label configure -text "[lindex $PLOT($i,ydata,$L) $POINT]"
58: plot_draw_data 1
59: puts "## $L $POINT $UPDOWN ##"
60: }
61:
62: proc plot_draw_data {i} {
63: global PLOT
64: global tk_library
65:
66: .n.f0.frameC.curve delete "curve_$i"
67: .n.f0.frameC.curve delete "curve_scale_$i"
68:
69: set X_OFF $PLOT($i,x)
70: set Y_OFF $PLOT($i,y)
71: set W $PLOT($i,w)
72: set H $PLOT($i,h)
73: set TITLE_X $PLOT($i,title_x)
74: set TITLE $PLOT($i,title)
75: set PAD_X $PLOT($i,pad_x1)
76: set PAD_X2 $PLOT($i,pad_x2)
77: set PAD_Y $PLOT($i,pad_y2)
78: set PAD_Y2 $PLOT($i,pad_y1)
79:
80: set L [expr ($W - $PAD_X - $PAD_X2) / 200.0]
81: set VMIN 1000000
82: set VMAX -1000000
83: foreach POINT_VAL $PLOT($i,udata) {
84: if {$VMIN > $POINT_VAL} {
85: set VMIN $POINT_VAL
86: } elseif {$VMAX < $POINT_VAL} {
87: set VMAX $POINT_VAL
88: }
89: }
90:
91: set VMIN [expr $VMIN - 0.0]
92: set VMAX [expr $VMAX + 0.0]
93: set MAX [expr $VMAX - $VMIN]
94:
95: set PM 0
96: while {[info exist PLOT($i,ydata,$PM)]} {
97: incr PM
98: }
99: if {$PAD_X2 == -1} {
100: set PAD_X2 [expr ($PM - 1) * $PAD_X]
101: }
102: if {$PAD_Y == -1} {
103: set PAD_Y 40
104: }
105:
106: set L_X $L
107: set VMIN_X $VMIN
108: set VMAX_X $VMAX
109: set MAX_X $MAX
110:
111:
112:
113: # Border
114: .n.f0.frameC.curve create line [expr $X_OFF + $PAD_X] [expr $Y_OFF + $H - $PAD_Y] [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $H - $PAD_Y] -width 2 -fill "$PLOT($i,hl_color_x)" -tag "curve_scale_$i"
115: .n.f0.frameC.curve create line [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $H - $PAD_Y] -width 2 -fill "$PLOT($i,hl_color_y)" -tag "curve_scale_$i"
116: .n.f0.frameC.curve create line [expr $X_OFF + $PAD_X] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $PAD_Y2] -width 2 -fill "$PLOT($i,hl_color_x)" -tag "curve_scale_$i"
117: .n.f0.frameC.curve create line [expr $X_OFF + $PAD_X] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $PAD_X] [expr $Y_OFF + $H - $PAD_Y] -width 2 -fill "$PLOT($i,hl_color_y)" -tag "curve_scale_$i"
118:
119:
120: # Scale X
121: if {$PLOT($i,udata_text) == ""} {
122: set XSDATA $PLOT($i,udata)
123: } else {
124: set XSDATA $PLOT($i,udata_text)
125: }
126: set NUM 0
127: foreach POINT_VAL $XSDATA {
128: set X [expr $PAD_X + ([expr $W - $PAD_X - $PAD_X2] * ([lindex $PLOT($i,udata) $NUM] + ($VMIN_X * -1)) / $MAX_X)]
129: .n.f0.frameC.curve create line [expr $X_OFF + $X] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $X] [expr $Y_OFF + $H - $PAD_Y + 2] -width 1 -fill "$PLOT($i,hl_color_x)" -tag "curve_$i"
130: # .n.f0.frameC.curve create text [expr $X_OFF + $X + 1] [expr $Y_OFF + $H - $PAD_Y / 3 * 2 + 1] -text "[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor c -tag "curve_$i"
131: # .n.f0.frameC.curve create text [expr $X_OFF + $X] [expr $Y_OFF + $H - $PAD_Y / 3 * 2] -text "[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,title_color)" -anchor c -tag "curve_$i"
132: .n.f0.frameC.curve create text [expr $X_OFF + $X + 1] [expr $Y_OFF + $H - $PAD_Y + 5 + 1] -text "[string trim $POINT_VAL " "]" -fill "$PLOT($i,shadow_color)" -anchor n -tag "curve_$i" -width 1
133: .n.f0.frameC.curve create text [expr $X_OFF + $X] [expr $Y_OFF + $H - $PAD_Y + 5] -text "[string trim $POINT_VAL " "]" -fill "$PLOT($i,title_color)" -anchor n -tag "curve_$i" -width 1
134: incr NUM
135: }
136:
137: set PN 0
138: while {[info exist PLOT($i,ydata,$PN)]} {
139:
140: if {! [info exist PLOT($i,title_y,$PN)]} {
141: set PLOT($i,title_y,$PN) "title-y $PN"
142: }
143: if {! [info exist PLOT($i,data_color,$PN)]} {
144: set PLOT($i,data_color,$PN) "#ABABAB"
145: }
146:
147: set VMIN 1000000
148: set VMAX -1000000
149:
150: if {$PLOT($i,ysync) == 1} {
151: set PN2 0
152: while {[info exist PLOT($i,ydata,$PN2)]} {
153: foreach POINT_VAL $PLOT($i,ydata,$PN2) {
154: if {$VMIN > $POINT_VAL} {
155: set VMIN $POINT_VAL
156: } elseif {$VMAX < $POINT_VAL} {
157: set VMAX $POINT_VAL
158: }
159: }
160: incr PN2
161: }
162: } else {
163: foreach POINT_VAL $PLOT($i,ydata,$PN) {
164: if {$VMIN > $POINT_VAL} {
165: set VMIN $POINT_VAL
166: } elseif {$VMAX < $POINT_VAL} {
167: set VMAX $POINT_VAL
168: }
169: }
170: }
171: set VMIN [expr $VMIN - 1.0]
172: set VMAX [expr $VMAX + 1.0]
173: if {$PLOT($i,min,$PN) != ""} {
174: set VMIN $PLOT($i,min,$PN)
175: }
176: if {$PLOT($i,max,$PN) != ""} {
177: set VMAX $PLOT($i,max,$PN)
178: }
179:
180: set MAX [expr $VMAX - $VMIN]
181: set DMAX [llength $PLOT($i,udata)]
182:
183: set X $PAD_X
184: set Y [expr [expr $H - $PAD_Y - $PAD_Y2] - ([expr $H - $PAD_Y - $PAD_Y2] * ([lindex $PLOT($i,ydata,$PN) 0] + ($VMIN * -1)) / $MAX)]
185: set LAST_Y $Y
186: set LAST_X $X
187: set NUM 0
188: foreach POINT_VAL $PLOT($i,ydata,$PN) {
189: set Y [expr [expr $H - $PAD_Y - $PAD_Y2] - ([expr $H - $PAD_Y - $PAD_Y2] * ($POINT_VAL + ($VMIN * -1)) / $MAX)]
190: set X [expr $PAD_X + ([expr $W - $PAD_X - $PAD_X2] * ([lindex $PLOT($i,udata) $NUM] + ($VMIN_X * -1)) / $MAX_X)]
191: if {$PN == 0 && $PLOT($i,fill,$PN) == 1} {
192: .n.f0.frameC.curve create polygon \
193: [expr $X_OFF + $LAST_X] \
194: [expr $Y_OFF + $LAST_Y + $PAD_Y2] \
195: [expr $X_OFF + $X] \
196: [expr $Y_OFF + $Y + $PAD_Y2] \
197: [expr $X_OFF + $X] \
198: [expr $Y_OFF + $H - $PAD_Y] \
199: [expr $X_OFF + $LAST_X] \
200: [expr $Y_OFF + $H - $PAD_Y] \
201: -fill "#ABABAB" \
202: -tag "curve_$i"
203: } elseif {$PLOT($i,fill,$PN) == 1} {
204: .n.f0.frameC.curve create polygon \
205: [expr $X_OFF + $LAST_X] \
206: [expr $Y_OFF + $LAST_Y + $PAD_Y2] \
207: [expr $X_OFF + $X] \
208: [expr $Y_OFF + $Y + $PAD_Y2] \
209: [expr $X_OFF + $X] \
210: [expr $Y_OFF + $H - $PAD_Y] \
211: [expr $X_OFF + $LAST_X] \
212: [expr $Y_OFF + $H - $PAD_Y] \
213: -fill "#DEDEDE" \
214: -stipple @[file join $tk_library demos images gray25.bmp] \
215: -tag "curve_$i"
216: }
217:
218: if {$PLOT($i,bar,$PN) > 0} {
219: if {$PLOT($i,udata_color) == ""} {
220: set COLOR $PLOT($i,data_color_fill,$PN)
221: } else {
222: set COLOR [lindex $PLOT($i,udata_color) $NUM]
223: }
224: .n.f0.frameC.curve create rectangle [expr $X_OFF + $X + ($PN * 5) - ($PLOT($i,bar,$PN) / 2)] [expr $Y_OFF + $PAD_Y2 + $Y] [expr $X_OFF + $X + ($PN * 5) + ($PLOT($i,bar,$PN) / 2 + 1)] [expr $Y_OFF + $H - $PAD_Y] -width 1 -fill "$COLOR" -outline "$COLOR" -tag "curve_$i"
225: } else {
226: .n.f0.frameC.curve create line [expr $X_OFF + $LAST_X] [expr $Y_OFF + $LAST_Y + $PAD_Y2] [expr $X_OFF + $X] [expr $Y_OFF + $Y + $PAD_Y2] -width 1 -fill "$PLOT($i,data_color,$PN)" -tag "curve_$i"
227: # .n.f0.frameC.curve create line [expr $X_OFF + $LAST_X] [expr $Y_OFF + $LAST_Y + $PAD_Y2] [expr $X_OFF + $X] [expr $Y_OFF + $Y + $PAD_Y2] -width 4 -fill "#005500" -tag "curve_$i"
228: # .n.f0.frameC.curve create line [expr $X_OFF + $LAST_X] [expr $Y_OFF + $LAST_Y + $PAD_Y2] [expr $X_OFF + $X] [expr $Y_OFF + $Y + $PAD_Y2] -width 1 -fill "#00FF00" -tag "curve_$i"
229: }
230:
231:
232: set LAST_X $X
233: set LAST_Y $Y
234: incr NUM
235: }
236:
237: set X $PAD_X
238: set Y [expr [expr $H - $PAD_Y - $PAD_Y2] - ([expr $H - $PAD_Y - $PAD_Y2] * ([lindex $PLOT($i,ydata,$PN) 0] + ($VMIN * -1)) / $MAX)]
239: set LAST_Y $Y
240: set LAST_X $X
241: set NUM 0
242: foreach POINT_VAL $PLOT($i,ydata,$PN) {
243: set Y [expr [expr $H - $PAD_Y - $PAD_Y2] - ([expr $H - $PAD_Y - $PAD_Y2] * ($POINT_VAL + ($VMIN * -1)) / $MAX)]
244: set X [expr $PAD_X + ([expr $W - $PAD_X - $PAD_X2] * ([lindex $PLOT($i,udata) $NUM] + ($VMIN_X * -1)) / $MAX_X)]
245: if {$NUM > 0} {
246: if {$PLOT($i,point,$PN) == 1} {
247: .n.f0.frameC.curve create text [expr $X_OFF + $X - 1] [expr $Y_OFF + $Y + $PAD_Y2 - 1] -text "[lindex $PLOT($i,udata) $NUM].[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor s -tag "curve_scale_$i"
248: .n.f0.frameC.curve create text [expr $X_OFF + $X + 1] [expr $Y_OFF + $Y + $PAD_Y2 + 1] -text "[lindex $PLOT($i,udata) $NUM].[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor s -tag "curve_scale_$i"
249: .n.f0.frameC.curve create text [expr $X_OFF + $X - 1] [expr $Y_OFF + $Y + $PAD_Y2 - 1] -text "[lindex $PLOT($i,udata) $NUM].[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor s -tag "curve_scale_$i"
250: .n.f0.frameC.curve create text [expr $X_OFF + $X + 1] [expr $Y_OFF + $Y + $PAD_Y2 + 1] -text "[lindex $PLOT($i,udata) $NUM].[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor s -tag "curve_scale_$i"
251: .n.f0.frameC.curve create text [expr $X_OFF + $X] [expr $Y_OFF + $Y + $PAD_Y2] -text "[lindex $PLOT($i,udata) $NUM].[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,data_color,$PN)" -anchor s -tag "curve_scale_$i"
252: }
253:
254: #.n.f0.frameC.curve delete "curve_scale-a_$i-$PN-$NUM"
255: #.n.f0.frameC.curve delete "curve_scale-b_$i-$PN-$NUM"
256: #.n.f0.frameC.curve create rectangle [expr $X_OFF + $X - 5] [expr $Y_OFF + $Y + $PAD_Y2 - 10] [expr $X_OFF + $X + 5] [expr $Y_OFF + $Y + $PAD_Y2] -fill "$PLOT($i,data_color,$PN)" -tag "curve_scale-a_$i-$PN-$NUM"
257: #.n.f0.frameC.curve create rectangle [expr $X_OFF + $X - 5] [expr $Y_OFF + $Y + $PAD_Y2] [expr $X_OFF + $X + 5] [expr $Y_OFF + $Y + $PAD_Y2 + 10] -fill "$PLOT($i,data_color,$PN)" -tag "curve_scale-b_$i-$PN-$NUM"
258: #eval .n.f0.frameC.curve bind "curve_scale-a_$i-$PN-$NUM" <ButtonPress-1> \{set_point $i $PN $NUM 1\}
259: #eval .n.f0.frameC.curve bind "curve_scale-b_$i-$PN-$NUM" <ButtonPress-1> \{set_point $i $PN $NUM -1\}
260: }
261: set LAST_X $X
262: set LAST_Y $Y
263: incr NUM
264: }
265:
266: # Scale Y
267: set L [expr ($H - $PAD_Y - $PAD_Y2) / 25.0]
268: for {set POINT_VAL $VMIN} {$POINT_VAL <= $VMAX} {set POINT_VAL [expr $POINT_VAL + ($MAX / $L)]} {
269: set Y [expr [expr $H - $PAD_Y - $PAD_Y2] - ([expr $H - $PAD_Y - $PAD_Y2] * ($POINT_VAL + ($VMIN * -1)) / $MAX)]
270: if {$PN == 0} {
271: if {$PLOT($i,ysync) == 1} {
272: .n.f0.frameC.curve create line [expr $X_OFF + $PAD_X - 5] [expr $Y_OFF + $Y + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $Y + $PAD_Y2] -width 1 -fill "$PLOT($i,hl_color_y)" -tag "curve_scale_$i"
273: } else {
274: .n.f0.frameC.curve create line [expr $X_OFF + $PAD_X - 5] [expr $Y_OFF + $Y + $PAD_Y2] [expr $X_OFF + $PAD_X] [expr $Y_OFF + $Y + $PAD_Y2] -width 1 -fill "$PLOT($i,data_color,$PN)" -tag "curve_scale_$i"
275: }
276: .n.f0.frameC.curve create text [expr $X_OFF + $PAD_X / 3 * 2 + 1] [expr $Y_OFF + $Y + $PAD_Y2 + 1] -text "[expr round($POINT_VAL * 100) / 100]" -fill "$PLOT($i,shadow_color)" -anchor c -tag "curve_scale_$i"
277: .n.f0.frameC.curve create text [expr $X_OFF + $PAD_X / 3 * 2] [expr $Y_OFF + $Y + $PAD_Y2] -text "[expr round($POINT_VAL * 100) / 100]" -fill "$PLOT($i,data_color,$PN)" -anchor c -tag "curve_scale_$i"
278: } else {
279: .n.f0.frameC.curve create line [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 0)] [expr $Y_OFF + $Y + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 0) + 5] [expr $Y_OFF + $Y + $PAD_Y2] -width 1 -fill "$PLOT($i,data_color,$PN)" -tag "curve_scale_$i"
280: .n.f0.frameC.curve create text [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 1) + 1] [expr $Y_OFF + $Y + $PAD_Y2 + 1] -text "[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,shadow_color)" -anchor c -tag "curve_scale_$i"
281: .n.f0.frameC.curve create text [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 1)] [expr $Y_OFF + $Y + $PAD_Y2] -text "[expr round($POINT_VAL * 100) / 100.0]" -fill "$PLOT($i,data_color,$PN)" -anchor c -tag "curve_scale_$i"
282: }
283: }
284:
285:
286: destroy .n.f0.frameC.curve.sync2-$i-$PN
287: eval checkbutton .n.f0.frameC.curve.sync2-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,point,$PN) -command \{ \
288: plot_redraw $i \
289: \}
290:
291: destroy .n.f0.frameC.curve.sync3-$i-$PN
292: eval checkbutton .n.f0.frameC.curve.sync3-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,fill,$PN) -command \{ \
293: plot_redraw $i \
294: \}
295:
296: destroy .n.f0.frameC.curve.sync4-$i-$PN
297: eval checkbutton .n.f0.frameC.curve.sync4-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,bar,$PN) -command \{ \
298: plot_redraw $i \
299: \}
300:
301: if {$PN == 0} {
302: .n.f0.frameC.curve create text [expr $X_OFF + $PAD_X / 3 + 1] [expr $Y_OFF + ($H - $PAD_Y - $PAD_Y2) / 2 + $PAD_Y2 + 1] -width 1 -text "$PLOT($i,title_y,$PN)" -fill "$PLOT($i,shadow_color)" -anchor c -justify center -tag "curve_scale_$i"
303: .n.f0.frameC.curve create text [expr $X_OFF + $PAD_X / 3] [expr $Y_OFF + ($H - $PAD_Y - $PAD_Y2) / 2 + $PAD_Y2] -width 1 -text "$PLOT($i,title_y,$PN)" -fill "$PLOT($i,data_color,$PN)" -anchor c -justify center -tag "curve_scale_$i"
304:
305: # .n.f0.frameC.curve create window [expr $X_OFF + $PAD_X / 3] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync2-$i-$PN -tag "curve_bg_$i-$PN"
306: # .n.f0.frameC.curve create window [expr $X_OFF + $PAD_X / 3 + 15] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync3-$i-$PN -tag "curve_bg_$i-$PN"
307: # .n.f0.frameC.curve create window [expr $X_OFF + $PAD_X / 3 + 30] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync4-$i-$PN -tag "curve_bg_$i-$PN"
308: } else {
309: .n.f0.frameC.curve create line [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 0) + 1] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 0) + 1] [expr $Y_OFF + $H - $PAD_Y] -width 1 -fill "$PLOT($i,data_color,$PN)" -tag "curve_scale_$i"
310: .n.f0.frameC.curve create text [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 2) + 1] [expr $Y_OFF + ($H - $PAD_Y - $PAD_Y2) / 2 + $PAD_Y2 + 1] -width 1 -text "$PLOT($i,title_y,$PN)" -fill "$PLOT($i,shadow_color)" -anchor c -justify center -tag "curve_scale_$i"
311: .n.f0.frameC.curve create text [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 2)] [expr $Y_OFF + ($H - $PAD_Y - $PAD_Y2) / 2 + $PAD_Y2] -width 1 -text "$PLOT($i,title_y,$PN)" -fill "$PLOT($i,data_color,$PN)" -anchor c -justify center -tag "curve_scale_$i"
312:
313: # .n.f0.frameC.curve create window [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 1) + 0] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync2-$i-$PN -tag "curve_bg_$i-$PN"
314: # .n.f0.frameC.curve create window [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 1) + 15] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync3-$i-$PN -tag "curve_bg_$i-$PN"
315: # .n.f0.frameC.curve create window [expr $X_OFF + $W - $PAD_X2 + $PAD_X2 / (($PM - 1) * 3) * (($PN - 1) * 3 + 1) + 30] [expr $Y_OFF + $H - 5] -anchor s -window .n.f0.frameC.curve.sync4-$i-$PN -tag "curve_bg_$i-$PN"
316: }
317: incr PN
318: }
319: }
320:
321: proc plot_bg {i} {
322: global PLOT
323: set X_OFF $PLOT($i,x)
324: set Y_OFF $PLOT($i,y)
325: set W $PLOT($i,w)
326: set H $PLOT($i,h)
327: set PAD_X $PLOT($i,pad_x1)
328: set PAD_X2 $PLOT($i,pad_x2)
329: set PAD_Y $PLOT($i,pad_y2)
330: set TITLE_X $PLOT($i,title_x)
331: set TITLE $PLOT($i,title)
332: set PAD_X $PLOT($i,pad_x1)
333: set PAD_X2 $PLOT($i,pad_x2)
334: set PAD_Y $PLOT($i,pad_y2)
335: set PAD_Y2 $PLOT($i,pad_y1)
336:
337: .n.f0.frameC.curve delete "curve_bg_$i"
338:
339: set PM 0
340: while {[info exist PLOT($i,ydata,$PM)]} {
341: incr PM
342: }
343: if {$PAD_X2 == -1} {
344: set PAD_X2 [expr ($PM - 1) * $PAD_X]
345: }
346: if {$PAD_Y == -1} {
347: set PAD_Y 40
348: }
349:
350: .n.f0.frameC.curve create rectangle $X_OFF $Y_OFF [expr $X_OFF + $W] [expr $Y_OFF + $H] -width 1 -fill "$PLOT($i,frame_color)" -tag "curve_frame_$i"
351: .n.f0.frameC.curve create rectangle [expr $X_OFF + $PAD_X] [expr $Y_OFF + $PAD_Y2] [expr $X_OFF + $W - $PAD_X2] [expr $Y_OFF + $H - $PAD_Y] -width 0 -fill "$PLOT($i,bg_color)" -tag "curve_bg_$i"
352:
353:
354: for {set SY 0} {$SY < $H} {incr SY} {
355: set R 0
356: set G 0
357: set B [expr $SY * 40 / $H]
358: .n.f0.frameC.curve create line $X_OFF [expr $SY + $Y_OFF] [expr $X_OFF + $W] [expr $SY + $Y_OFF] -width 1 -fill "#[decN2Hx $R][decN2Hx $G][decN2Hx $B]" -tag "curve_frame_$i"
359: }
360:
361:
362: .n.f0.frameC.curve create text [expr $X_OFF + $W / 2 + 1] [expr $Y_OFF + $PAD_Y2 / 2 + 1] -text "$TITLE" -fill "$PLOT($i,title_bg_color)" -anchor c -justify center -tag "curve_bg_$i" -font "12x24"
363: .n.f0.frameC.curve create text [expr $X_OFF + $W / 2] [expr $Y_OFF + $PAD_Y2 / 2] -text "$TITLE" -fill "$PLOT($i,title_color)" -anchor c -justify center -tag "curve_bg_$i" -font "12x24"
364:
365: .n.f0.frameC.curve create line $X_OFF [expr $Y_OFF + $H] [expr $X_OFF + $W] [expr $Y_OFF + $H] -width 2 -fill "#ABABAB" -tag "curve_bg_$i"
366: .n.f0.frameC.curve create line [expr $X_OFF + $W] $Y_OFF [expr $X_OFF + $W] [expr $Y_OFF + $H] -width 2 -fill "#ABABAB" -tag "curve_bg_$i"
367: .n.f0.frameC.curve create line $X_OFF $Y_OFF [expr $X_OFF + $W] $Y_OFF -width 2 -fill "#EFEFEF" -tag "curve_bg_$i"
368: .n.f0.frameC.curve create line $X_OFF $Y_OFF $X_OFF [expr $Y_OFF + $H] -width 2 -fill "#EFEFEF" -tag "curve_bg_$i"
369:
370: destroy .n.f0.frameC.curve.sync-$i
371: eval checkbutton .n.f0.frameC.curve.sync-$i -text \"Sync-Y\" -variable wipers -relief flat -variable PLOT($i,ysync) -command \{ \
372: plot_redraw $i\
373: \}
374: # .n.f0.frameC.curve create window [expr $X_OFF + 10] [expr $Y_OFF + 10] -anchor nw -window .n.f0.frameC.curve.sync-$i -tag "curve_bg_$i"
375:
376: # destroy .n.f0.frameC.curve.padx-$i
377: # spinbox .n.f0.frameC.curve.padx-$i -from 0 -to 300 -increment 5 -format %05.2f -width 10 -textvariable PLOT($i,pad_x1) -command {
378: # plot_redraw $i\
379: # }
380: # .n.f0.frameC.curve create window [expr $X_OFF + 110] [expr $Y_OFF + 10] -anchor nw -window .n.f0.frameC.curve.padx-$i -tag "curve_bg_$i"
381: # eval bind .n.f0.frameC.curve.padx-$i <ButtonPress-4> \{set PLOT($i,pad_x1) \[expr \$PLOT($i,pad_x1) + 1\]\nplot_bg $i\nplot_draw_data $i\}
382: # eval bind .n.f0.frameC.curve.padx-$i <ButtonPress-5> \{set PLOT($i,pad_x1) \[expr \$PLOT($i,pad_x1) - 1\]\nplot_bg $i\nplot_draw_data $i\}
383:
384: .n.f0.frameC.curve bind curve_frame_$i <B1-Motion> "plotMove .n.f0.frameC.curve $i %x %y"
385: .n.f0.frameC.curve bind curve_frame_$i <ButtonPress-1> "plotSet %x %y"
386: .n.f0.frameC.curve bind curve_frame_$i <ButtonRelease-1> "plotMoveEnd $i"
387: }
388:
389: proc plot_redraw {i} {
390: .n.f0.frameC.curve delete curve_frame_$i
391: plot_bg $i
392: plot_draw_data $i
393: }
394:
395: proc plot_add {NUM DATA} {
396: global PLOT
397: set PN 0
398: while {[info exist PLOT($NUM,ydata,$PN)]} {
399: incr PN
400: }
401: set PLOT($NUM,ydata,$PN) $DATA
402: set PLOT($NUM,title_y,$PN) "title_y0"
403: if {$PN == 1} {
404: set PLOT($NUM,data_color,$PN) "#00FF00"
405: set PLOT($NUM,data_color_fill,$PN) "#00FFF0"
406: } elseif {$PN == 2} {
407: set PLOT($NUM,data_color,$PN) "#0000FF"
408: set PLOT($NUM,data_color_fill,$PN) "#000FFF"
409: } else {
410: set PLOT($NUM,data_color,$PN) "#FFFF00"
411: set PLOT($NUM,data_color_fill,$PN) "#FFF000"
412: }
413:
414: set PLOT($NUM,point,$PN) "0"
415: set PLOT($NUM,fill,$PN) "0"
416: set PLOT($NUM,bar,$PN) "0"
417: set PLOT($NUM,min,$PN) ""
418: set PLOT($NUM,max,$PN) ""
419: }
420:
421: proc plot_new {X Y W H UDATA DATA} {
422: global PLOT
423: set NUM 1
424: while {[info exist PLOT($NUM,x)]} {
425: incr NUM
426: }
427: set PLOT($NUM,udata) $UDATA
428: set PLOT($NUM,udata_text) ""
429: set PLOT($NUM,udata_color) ""
430: set PLOT($NUM,x) $X
431: set PLOT($NUM,y) $Y
432: set PLOT($NUM,w) $W
433: set PLOT($NUM,h) $H
434: set PLOT($NUM,pad_x1) 70
435: set PLOT($NUM,pad_x2) -1
436: set PLOT($NUM,pad_y1) 70
437: set PLOT($NUM,pad_y2) 70
438: set PLOT($NUM,title_x) "title_x"
439: set PLOT($NUM,title) "title"
440:
441: set PLOT($NUM,shadow_color) "#676767"
442:
443: set PLOT($NUM,ydata,0) $DATA
444: set PLOT($NUM,title_y,0) "title_y0"
445: set PLOT($NUM,data_color,0) "#FF0000"
446: set PLOT($NUM,data_color_fill,0) "#FFF000"
447: set PLOT($NUM,point,0) "0"
448: set PLOT($NUM,fill,0) "0"
449: set PLOT($NUM,bar,0) "0"
450: set PLOT($NUM,min,0) ""
451: set PLOT($NUM,max,0) ""
452:
453: # set PLOT($NUM,frame_color) "#BCBCBC"
454: set PLOT($NUM,frame_color) "#000000"
455:
456: # set PLOT($NUM,bg_color) "#343434"
457: set PLOT($NUM,bg_color) "#000000"
458:
459: set PLOT($NUM,title_color) "#FFFFFF"
460: set PLOT($NUM,title_bg_color) "#000000"
461: set PLOT($NUM,hl_color_x) "#440000"
462: set PLOT($NUM,hl_color_y) "#440000"
463:
464: set PLOT($NUM,ysync) "1"
465:
466: return $NUM
467: }
468:
469: proc plot_configure {NUM NAME VALUE} {
470: global PLOT
471: set PLOT($NUM,$NAME) $VALUE
472: }
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491: proc LabelFrame:create {w args} {
492: frame $w -bd 0
493: label $w.l
494: frame $w.f -bd 2 -relief groove
495: frame $w.f.f
496: pack $w.f.f
497: set text {}
498: set font {}
499: set padx 3
500: set pady 7
501: set ipadx 2
502: set ipady 9
503: foreach {tag value} $args {
504: switch -- $tag {
505: -font {set font $value}
506: -text {set text $value}
507: -padx {set padx $value}
508: -pady {set pady $value}
509: -ipadx {set ipadx $value}
510: -ipady {set ipady $value}
511: -bd {$w.f config -bd $value}
512: -relief {$w.f config -relief $value}
513: }
514: }
515: if {"$font"!=""} {
516: $w.l config -font $font
517: }
518: $w.l config -text $text
519: pack $w.f -padx $padx -pady $pady -fill both -expand 1
520: place $w.l -x [expr $padx+10] -y $pady -anchor w
521: pack $w.f.f -padx $ipadx -pady $ipady -fill both -expand 1
522: raise $w.l
523: return $w.f.f
524: }
525:
526: #################################
527: # The following code implements an example of using the
528: # labeled frame widget.
529: #
530: #set f1 [LabelFrame:create .f1 -text "Frame One"]
531: #label $f1.l1 -text "The interior\nof Frame One" -bg skyblue
532: #pack $f1.l1 -fill both -expand 1
533: #pack .f1 -side right -fill both -expand 1 -padx 5 -pady 5
534: #
535: #set f2 [LabelFrame:create .f2 -text "Frame Two" -font fixed]
536: #label $f2.l -text "This frame has a\nfixed pitch font\non its label"
537: #pack $f2.l -fill both -expand 1
538: #pack .f2 -side bottom -fill both -expand 1 -padx 5 -pady 5
539: #
540: #set f3 [LabelFrame:create .f3 -text "Buttons" -relief ridge]
541: #button $f3.b -text OK -command exit
542: #button $f3.c -text Cancel -command exit
543: #pack $f3.b $f3.c -side left
544: #pack .f3 -side top -fill both -expand 1 -padx 5 -pady 5
545:
546: ###################################################################################################
547:
548: proc Notebook:create {w args} {
549: global Notebook
550: set Notebook($w,width) 400
551: set Notebook($w,height) 300
552: set Notebook($w,pages) {}
553: set Notebook($w,top) 0
554: set Notebook($w,pad) 5
555: set Notebook($w,fg,on) black
556: set Notebook($w,fg,off) grey50
557: canvas $w -bd 0 -highlightthickness 0 -takefocus 0
558: set Notebook($w,bg) [$w cget -bg]
559: bind $w <1> "Notebook:click $w %x %y"
560: bind $w <Configure> "Notebook:scheduleExpand $w"
561: eval Notebook:config $w $args
562: }
563:
564: #
565: # Change configuration options for the notebook widget
566: #
567: proc Notebook:config {w args} {
568: global Notebook
569: foreach {tag value} $args {
570: switch -- $tag {
571: -width {
572: set Notebook($w,width) $value
573: }
574: -height {
575: set Notebook($w,height) $value
576: }
577: -pages {
578: set Notebook($w,pages) $value
579: }
580: -pad {
581: set Notebook($w,pad) $value
582: }
583: -bg {
584: set Notebook($w,bg) $value
585: }
586: -fg {
587: set Notebook($w,fg,on) $value
588: }
589: -disabledforeground {
590: set Notebook($w,fg,off) $value
591: }
592: }
593: }
594:
595: #
596: # After getting new configuration values, reconstruct the widget
597: #
598: $w delete all
599: set Notebook($w,x1) $Notebook($w,pad)
600: set Notebook($w,x2) [expr $Notebook($w,x1)+2]
601: set Notebook($w,x3) [expr $Notebook($w,x2)+$Notebook($w,width)]
602: set Notebook($w,x4) [expr $Notebook($w,x3)+2]
603: set Notebook($w,y1) [expr $Notebook($w,pad)+2]
604: set Notebook($w,y2) [expr $Notebook($w,y1)+2]
605: set Notebook($w,y5) [expr $Notebook($w,y1)+30]
606: set Notebook($w,y6) [expr $Notebook($w,y5)+2]
607: set Notebook($w,y3) [expr $Notebook($w,y6)+$Notebook($w,height)]
608: set Notebook($w,y4) [expr $Notebook($w,y3)+2]
609: set x $Notebook($w,x1)
610: set cnt 0
611: set y7 [expr $Notebook($w,y1)+10]
612: foreach p $Notebook($w,pages) {
613: set Notebook($w,p$cnt,x5) $x
614: set id [$w create text 0 0 -text $p -anchor nw -tags "p$cnt t$cnt"]
615: set bbox [$w bbox $id]
616: set width [lindex $bbox 2]
617: $w move $id [expr $x+10] $y7
618: $w create line \
619: $x $Notebook($w,y5)\
620: $x $Notebook($w,y2) \
621: [expr $x+2] $Notebook($w,y1) \
622: [expr $x+$width+16] $Notebook($w,y1) \
623: -width 2 -fill white -tags p$cnt
624: $w create line \
625: [expr $x+$width+16] $Notebook($w,y1) \
626: [expr $x+$width+18] $Notebook($w,y2) \
627: [expr $x+$width+18] $Notebook($w,y5) \
628: -width 2 -fill black -tags p$cnt
629: set x [expr $x+$width+20]
630: set Notebook($w,p$cnt,x6) [expr $x-2]
631: if {![winfo exists $w.f$cnt]} {
632: frame $w.f$cnt -bd 0
633: }
634: $w.f$cnt config -bg $Notebook($w,bg)
635: place $w.f$cnt -x $Notebook($w,x2) -y $Notebook($w,y6) \
636: -width $Notebook($w,width) -height $Notebook($w,height)
637: incr cnt
638: }
639: $w create line \
640: $Notebook($w,x1) [expr $Notebook($w,y5)-2] \
641: $Notebook($w,x1) $Notebook($w,y3) \
642: -width 2 -fill white
643: $w create line \
644: $Notebook($w,x1) $Notebook($w,y3) \
645: $Notebook($w,x2) $Notebook($w,y4) \
646: $Notebook($w,x3) $Notebook($w,y4) \
647: $Notebook($w,x4) $Notebook($w,y3) \
648: $Notebook($w,x4) $Notebook($w,y6) \
649: $Notebook($w,x3) $Notebook($w,y5) \
650: -width 2 -fill black
651: $w config -width [expr $Notebook($w,x4)+$Notebook($w,pad)] \
652: -height [expr $Notebook($w,y4)+$Notebook($w,pad)] \
653: -bg $Notebook($w,bg)
654: set top $Notebook($w,top)
655: set Notebook($w,top) -1
656: Notebook:raise.page $w $top
657: }
658:
659: #
660: # This routine is called whenever the mouse-button is pressed over
661: # the notebook. It determines if any page should be raised and raises
662: # that page.
663: #
664: proc Notebook:click {w x y} {
665: global Notebook
666: if {$y<$Notebook($w,y1) || $y>$Notebook($w,y6)} return
667: set N [llength $Notebook($w,pages)]
668: for {set i 0} {$i<$N} {incr i} {
669: if {$x>=$Notebook($w,p$i,x5) && $x<=$Notebook($w,p$i,x6)} {
670: Notebook:raise.page $w $i
671: break
672: }
673: }
674: }
675:
676: #
677: # For internal use only. This procedure raised the n-th page of
678: # the notebook
679: #
680: proc Notebook:raise.page {w n} {
681: global Notebook
682: if {$n<0 || $n>=[llength $Notebook($w,pages)]} return
683: set top $Notebook($w,top)
684: if {$top>=0 && $top<[llength $Notebook($w,pages)]} {
685: $w move p$top 0 2
686: }
687: $w move p$n 0 -2
688: $w delete topline
689: if {$n>0} {
690: $w create line \
691: $Notebook($w,x1) $Notebook($w,y6) \
692: $Notebook($w,x2) $Notebook($w,y5) \
693: $Notebook($w,p$n,x5) $Notebook($w,y5) \
694: $Notebook($w,p$n,x5) [expr $Notebook($w,y5)-2] \
695: -width 2 -fill white -tags topline
696: }
697: $w create line \
698: $Notebook($w,p$n,x6) [expr $Notebook($w,y5)-2] \
699: $Notebook($w,p$n,x6) $Notebook($w,y5) \
700: -width 2 -fill white -tags topline
701: $w create line \
702: $Notebook($w,p$n,x6) $Notebook($w,y5) \
703: $Notebook($w,x3) $Notebook($w,y5) \
704: -width 2 -fill white -tags topline
705: set Notebook($w,top) $n
706: raise $w.f$n
707: }
708:
709: #
710: # Change the page-specific configuration options for the notebook
711: #
712: proc Notebook:pageconfig {w name args} {
713: global Notebook
714: set i [lsearch $Notebook($w,pages) $name]
715: if {$i<0} return
716: foreach {tag value} $args {
717: switch -- $tag {
718: -state {
719: if {"$value"=="disabled"} {
720: $w itemconfig t$i -fg $Notebook($w,fg,off)
721: } else {
722: $w itemconfig t$i -fg $Notebook($w,fg,on)
723: }
724: }
725: -onexit {
726: set Notebook($w,p$i,onexit) $value
727: }
728: }
729: }
730: }
731:
732: #
733: # This procedure raises a notebook page given its name. But first
734: # we check the "onexit" procedure for the current page (if any) and
735: # if it returns false, we don't allow the raise to proceed.
736: #
737: proc Notebook:raise {w name} {
738: global Notebook
739: set i [lsearch $Notebook($w,pages) $name]
740: if {$i<0} return
741: if {[info exists Notebook($w,p$i,onexit)]} {
742: set onexit $Notebook($w,p$i,onexit)
743: if {"$onexit"!="" && [eval uplevel #0 $onexit]!=0} {
744: Notebook:raise.page $w $i
745: }
746: } else {
747: Notebook:raise.page $w $i
748: }
749: }
750:
751: #
752: # Return the frame associated with a given page of the notebook.
753: #
754: proc Notebook:frame {w name} {
755: global Notebook
756: set i [lsearch $Notebook($w,pages) $name]
757: if {$i>=0} {
758: return $w.f$i
759: } else {
760: return {}
761: }
762: }
763:
764: #
765: # Try to resize the notebook to the next time we become idle.
766: #
767: proc Notebook:scheduleExpand w {
768: global Notebook
769: if {[info exists Notebook($w,expand)]} return
770: set Notebook($w,expand) 1
771: after idle "Notebook:expand $w"
772: }
773:
774: #
775: # Resize the notebook to fit inside its containing widget.
776: #
777: proc Notebook:expand w {
778: global Notebook
779: set wi [expr [winfo width $w]-($Notebook($w,pad)*2+4)]
780: set hi [expr [winfo height $w]-($Notebook($w,pad)*2+36)]
781: Notebook:config $w -width $wi -height $hi
782: catch {unset Notebook($w,expand)}
783: }
784: