tx-tool/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: .frameC.curve move "curve_frame_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
31: .frameC.curve move "curve_scale_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
32: .frameC.curve move "curve_bg_$i" [expr {$x-$move(lastX)}] [expr {$y-$move(lastY)}]
33: .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: .frameC.curve delete "curve_$i"
67: .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_y1)
78: set PAD_Y2 $PLOT($i,pad_y2)
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: # .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: # .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: # .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: # .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: .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: # .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: # .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: .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: .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: .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: .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: .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: .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: # .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: # .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: .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: .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: .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: .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: .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: #.frameC.curve delete "curve_scale-a_$i-$PN-$NUM"
255: #.frameC.curve delete "curve_scale-b_$i-$PN-$NUM"
256: #.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: #.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 .frameC.curve bind "curve_scale-a_$i-$PN-$NUM" <ButtonPress-1> \{set_point $i $PN $NUM 1\}
259: #eval .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) / 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] - ([expr $H - $PAD_Y] * ($POINT_VAL + ($VMIN * -1)) / $MAX)]
270: if {$PN == 0} {
271: if {$PLOT($i,ysync) == 1} {
272: .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: .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: .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: .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: .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: .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: .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: destroy .frameC.curve.sync2-$i-$PN
286: eval checkbutton .frameC.curve.sync2-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,point,$PN) -command \{ \
287: plot_redraw $i \
288: \}
289:
290: destroy .frameC.curve.sync3-$i-$PN
291: eval checkbutton .frameC.curve.sync3-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,fill,$PN) -command \{ \
292: plot_redraw $i \
293: \}
294:
295: destroy .frameC.curve.sync4-$i-$PN
296: eval checkbutton .frameC.curve.sync4-$i-$PN -text \"\" -variable wipers -relief flat -variable PLOT($i,bar,$PN) -command \{ \
297: plot_redraw $i \
298: \}
299:
300:
301: if {$PN == 0} {
302: .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: .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: # .frameC.curve create window [expr $X_OFF + $PAD_X / 3] [expr $Y_OFF + $H - 5] -anchor s -window .frameC.curve.sync2-$i-$PN -tag "curve_bg_$i-$PN"
306: # .frameC.curve create window [expr $X_OFF + $PAD_X / 3 + 15] [expr $Y_OFF + $H - 5] -anchor s -window .frameC.curve.sync3-$i-$PN -tag "curve_bg_$i-$PN"
307: # .frameC.curve create window [expr $X_OFF + $PAD_X / 3 + 30] [expr $Y_OFF + $H - 5] -anchor s -window .frameC.curve.sync4-$i-$PN -tag "curve_bg_$i-$PN"
308: } else {
309: .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: .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: .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: # .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 .frameC.curve.sync2-$i-$PN -tag "curve_bg_$i-$PN"
314: # .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 .frameC.curve.sync3-$i-$PN -tag "curve_bg_$i-$PN"
315: # .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 .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_y1)
335: set PAD_Y2 $PLOT($i,pad_y2)
336:
337: .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: .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: .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: .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: .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"
362: .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 "9x18"
363:
364: .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"
365: .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"
366: .frameC.curve create line $X_OFF $Y_OFF [expr $X_OFF + $W] $Y_OFF -width 2 -fill "#EFEFEF" -tag "curve_bg_$i"
367: .frameC.curve create line $X_OFF $Y_OFF $X_OFF [expr $Y_OFF + $H] -width 2 -fill "#EFEFEF" -tag "curve_bg_$i"
368:
369: destroy .frameC.curve.sync-$i
370: eval checkbutton .frameC.curve.sync-$i -text \"Sync-Y\" -variable wipers -relief flat -variable PLOT($i,ysync) -command \{ \
371: plot_redraw $i\
372: \}
373: # .frameC.curve create window [expr $X_OFF + 10] [expr $Y_OFF + 10] -anchor nw -window .frameC.curve.sync-$i -tag "curve_bg_$i"
374:
375: # destroy .frameC.curve.padx-$i
376: # spinbox .frameC.curve.padx-$i -from 0 -to 300 -increment 5 -format %05.2f -width 10 -textvariable PLOT($i,pad_x1) -command {
377: # plot_redraw $i\
378: # }
379: # .frameC.curve create window [expr $X_OFF + 110] [expr $Y_OFF + 10] -anchor nw -window .frameC.curve.padx-$i -tag "curve_bg_$i"
380: # eval bind .frameC.curve.padx-$i <ButtonPress-4> \{set PLOT($i,pad_x1) \[expr \$PLOT($i,pad_x1) + 1\]\nplot_bg $i\nplot_draw_data $i\}
381: # eval bind .frameC.curve.padx-$i <ButtonPress-5> \{set PLOT($i,pad_x1) \[expr \$PLOT($i,pad_x1) - 1\]\nplot_bg $i\nplot_draw_data $i\}
382:
383: .frameC.curve bind curve_frame_$i <B1-Motion> "plotMove .frameC.curve $i %x %y"
384: .frameC.curve bind curve_frame_$i <ButtonPress-1> "plotSet %x %y"
385: .frameC.curve bind curve_frame_$i <ButtonRelease-1> "plotMoveEnd $i"
386: }
387:
388: proc plot_redraw {i} {
389: .frameC.curve delete curve_frame_$i
390: plot_bg $i
391: plot_draw_data $i
392: }
393:
394: proc plot_add {NUM DATA} {
395: global PLOT
396: set PN 0
397: while {[info exist PLOT($NUM,ydata,$PN)]} {
398: incr PN
399: }
400: set PLOT($NUM,ydata,$PN) $DATA
401: set PLOT($NUM,title_y,$PN) "title_y0"
402: if {$PN == 1} {
403: set PLOT($NUM,data_color,$PN) "#00FF00"
404: set PLOT($NUM,data_color_fill,$PN) "#00FFF0"
405: } elseif {$PN == 2} {
406: set PLOT($NUM,data_color,$PN) "#0000FF"
407: set PLOT($NUM,data_color_fill,$PN) "#000FFF"
408: } else {
409: set PLOT($NUM,data_color,$PN) "#FFFF00"
410: set PLOT($NUM,data_color_fill,$PN) "#FFF000"
411: }
412:
413: set PLOT($NUM,point,$PN) "0"
414: set PLOT($NUM,fill,$PN) "0"
415: set PLOT($NUM,bar,$PN) "0"
416: set PLOT($NUM,min,$PN) ""
417: set PLOT($NUM,max,$PN) ""
418: }
419:
420: proc plot_new {X Y W H UDATA DATA} {
421: global PLOT
422: set NUM 1
423: while {[info exist PLOT($NUM,x)]} {
424: incr NUM
425: }
426: set PLOT($NUM,udata) $UDATA
427: set PLOT($NUM,udata_text) ""
428: set PLOT($NUM,udata_color) ""
429: set PLOT($NUM,x) $X
430: set PLOT($NUM,y) $Y
431: set PLOT($NUM,w) $W
432: set PLOT($NUM,h) $H
433: set PLOT($NUM,pad_x1) 70
434: set PLOT($NUM,pad_x2) -1
435: set PLOT($NUM,pad_y1) 70
436: set PLOT($NUM,pad_y2) 70
437: set PLOT($NUM,title_x) "title_x"
438: set PLOT($NUM,title) "title"
439:
440: set PLOT($NUM,shadow_color) "#676767"
441:
442: set PLOT($NUM,ydata,0) $DATA
443: set PLOT($NUM,title_y,0) "title_y0"
444: set PLOT($NUM,data_color,0) "#FF0000"
445: set PLOT($NUM,data_color_fill,0) "#FFF000"
446: set PLOT($NUM,point,0) "0"
447: set PLOT($NUM,fill,0) "0"
448: set PLOT($NUM,bar,0) "0"
449: set PLOT($NUM,min,0) ""
450: set PLOT($NUM,max,0) ""
451:
452: # set PLOT($NUM,frame_color) "#BCBCBC"
453: set PLOT($NUM,frame_color) "#000000"
454:
455: # set PLOT($NUM,bg_color) "#343434"
456: set PLOT($NUM,bg_color) "#000000"
457:
458: set PLOT($NUM,title_color) "#FFFFFF"
459: set PLOT($NUM,title_bg_color) "#000000"
460: set PLOT($NUM,hl_color_x) "#440000"
461: set PLOT($NUM,hl_color_y) "#440000"
462:
463: set PLOT($NUM,ysync) "1"
464:
465: return $NUM
466: }
467:
468: proc plot_configure {NUM NAME VALUE} {
469: global PLOT
470: set PLOT($NUM,$NAME) $VALUE
471: }
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490: proc LabelFrame:create {w args} {
491: frame $w -bd 0
492: label $w.l
493: frame $w.f -bd 2 -relief groove
494: frame $w.f.f
495: pack $w.f.f
496: set text {}
497: set font {}
498: set padx 3
499: set pady 7
500: set ipadx 2
501: set ipady 9
502: foreach {tag value} $args {
503: switch -- $tag {
504: -font {set font $value}
505: -text {set text $value}
506: -padx {set padx $value}
507: -pady {set pady $value}
508: -ipadx {set ipadx $value}
509: -ipady {set ipady $value}
510: -bd {$w.f config -bd $value}
511: -relief {$w.f config -relief $value}
512: }
513: }
514: if {"$font"!=""} {
515: $w.l config -font $font
516: }
517: $w.l config -text $text
518: pack $w.f -padx $padx -pady $pady -fill both -expand 1
519: place $w.l -x [expr $padx+10] -y $pady -anchor w
520: pack $w.f.f -padx $ipadx -pady $ipady -fill both -expand 1
521: raise $w.l
522: return $w.f.f
523: }
524:
525: #################################
526: # The following code implements an example of using the
527: # labeled frame widget.
528: #
529: #set f1 [LabelFrame:create .f1 -text "Frame One"]
530: #label $f1.l1 -text "The interior\nof Frame One" -bg skyblue
531: #pack $f1.l1 -fill both -expand 1
532: #pack .f1 -side right -fill both -expand 1 -padx 5 -pady 5
533: #
534: #set f2 [LabelFrame:create .f2 -text "Frame Two" -font fixed]
535: #label $f2.l -text "This frame has a\nfixed pitch font\non its label"
536: #pack $f2.l -fill both -expand 1
537: #pack .f2 -side bottom -fill both -expand 1 -padx 5 -pady 5
538: #
539: #set f3 [LabelFrame:create .f3 -text "Buttons" -relief ridge]
540: #button $f3.b -text OK -command exit
541: #button $f3.c -text Cancel -command exit
542: #pack $f3.b $f3.c -side left
543: #pack .f3 -side top -fill both -expand 1 -padx 5 -pady 5
544:
545: ###################################################################################################
546:
547: proc Notebook:create {w args} {
548: global Notebook
549: set Notebook($w,width) 400
550: set Notebook($w,height) 300
551: set Notebook($w,pages) {}
552: set Notebook($w,top) 0
553: set Notebook($w,pad) 5
554: set Notebook($w,fg,on) black
555: set Notebook($w,fg,off) grey50
556: canvas $w -bd 0 -highlightthickness 0 -takefocus 0
557: set Notebook($w,bg) [$w cget -bg]
558: bind $w <1> "Notebook:click $w %x %y"
559: bind $w <Configure> "Notebook:scheduleExpand $w"
560: eval Notebook:config $w $args
561: }
562:
563: #
564: # Change configuration options for the notebook widget
565: #
566: proc Notebook:config {w args} {
567: global Notebook
568: foreach {tag value} $args {
569: switch -- $tag {
570: -width {
571: set Notebook($w,width) $value
572: }
573: -height {
574: set Notebook($w,height) $value
575: }
576: -pages {
577: set Notebook($w,pages) $value
578: }
579: -pad {
580: set Notebook($w,pad) $value
581: }
582: -bg {
583: set Notebook($w,bg) $value
584: }
585: -fg {
586: set Notebook($w,fg,on) $value
587: }
588: -disabledforeground {
589: set Notebook($w,fg,off) $value
590: }
591: }
592: }
593:
594: #
595: # After getting new configuration values, reconstruct the widget
596: #
597: $w delete all
598: set Notebook($w,x1) $Notebook($w,pad)
599: set Notebook($w,x2) [expr $Notebook($w,x1)+2]
600: set Notebook($w,x3) [expr $Notebook($w,x2)+$Notebook($w,width)]
601: set Notebook($w,x4) [expr $Notebook($w,x3)+2]
602: set Notebook($w,y1) [expr $Notebook($w,pad)+2]
603: set Notebook($w,y2) [expr $Notebook($w,y1)+2]
604: set Notebook($w,y5) [expr $Notebook($w,y1)+30]
605: set Notebook($w,y6) [expr $Notebook($w,y5)+2]
606: set Notebook($w,y3) [expr $Notebook($w,y6)+$Notebook($w,height)]
607: set Notebook($w,y4) [expr $Notebook($w,y3)+2]
608: set x $Notebook($w,x1)
609: set cnt 0
610: set y7 [expr $Notebook($w,y1)+10]
611: foreach p $Notebook($w,pages) {
612: set Notebook($w,p$cnt,x5) $x
613: set id [$w create text 0 0 -text $p -anchor nw -tags "p$cnt t$cnt"]
614: set bbox [$w bbox $id]
615: set width [lindex $bbox 2]
616: $w move $id [expr $x+10] $y7
617: $w create line \
618: $x $Notebook($w,y5)\
619: $x $Notebook($w,y2) \
620: [expr $x+2] $Notebook($w,y1) \
621: [expr $x+$width+16] $Notebook($w,y1) \
622: -width 2 -fill white -tags p$cnt
623: $w create line \
624: [expr $x+$width+16] $Notebook($w,y1) \
625: [expr $x+$width+18] $Notebook($w,y2) \
626: [expr $x+$width+18] $Notebook($w,y5) \
627: -width 2 -fill black -tags p$cnt
628: set x [expr $x+$width+20]
629: set Notebook($w,p$cnt,x6) [expr $x-2]
630: if {![winfo exists $w.f$cnt]} {
631: frame $w.f$cnt -bd 0
632: }
633: $w.f$cnt config -bg $Notebook($w,bg)
634: place $w.f$cnt -x $Notebook($w,x2) -y $Notebook($w,y6) \
635: -width $Notebook($w,width) -height $Notebook($w,height)
636: incr cnt
637: }
638: $w create line \
639: $Notebook($w,x1) [expr $Notebook($w,y5)-2] \
640: $Notebook($w,x1) $Notebook($w,y3) \
641: -width 2 -fill white
642: $w create line \
643: $Notebook($w,x1) $Notebook($w,y3) \
644: $Notebook($w,x2) $Notebook($w,y4) \
645: $Notebook($w,x3) $Notebook($w,y4) \
646: $Notebook($w,x4) $Notebook($w,y3) \
647: $Notebook($w,x4) $Notebook($w,y6) \
648: $Notebook($w,x3) $Notebook($w,y5) \
649: -width 2 -fill black
650: $w config -width [expr $Notebook($w,x4)+$Notebook($w,pad)] \
651: -height [expr $Notebook($w,y4)+$Notebook($w,pad)] \
652: -bg $Notebook($w,bg)
653: set top $Notebook($w,top)
654: set Notebook($w,top) -1
655: Notebook:raise.page $w $top
656: }
657:
658: #
659: # This routine is called whenever the mouse-button is pressed over
660: # the notebook. It determines if any page should be raised and raises
661: # that page.
662: #
663: proc Notebook:click {w x y} {
664: global Notebook
665: if {$y<$Notebook($w,y1) || $y>$Notebook($w,y6)} return
666: set N [llength $Notebook($w,pages)]
667: for {set i 0} {$i<$N} {incr i} {
668: if {$x>=$Notebook($w,p$i,x5) && $x<=$Notebook($w,p$i,x6)} {
669: Notebook:raise.page $w $i
670: break
671: }
672: }
673: }
674:
675: #
676: # For internal use only. This procedure raised the n-th page of
677: # the notebook
678: #
679: proc Notebook:raise.page {w n} {
680: global Notebook
681: if {$n<0 || $n>=[llength $Notebook($w,pages)]} return
682: set top $Notebook($w,top)
683: if {$top>=0 && $top<[llength $Notebook($w,pages)]} {
684: $w move p$top 0 2
685: }
686: $w move p$n 0 -2
687: $w delete topline
688: if {$n>0} {
689: $w create line \
690: $Notebook($w,x1) $Notebook($w,y6) \
691: $Notebook($w,x2) $Notebook($w,y5) \
692: $Notebook($w,p$n,x5) $Notebook($w,y5) \
693: $Notebook($w,p$n,x5) [expr $Notebook($w,y5)-2] \
694: -width 2 -fill white -tags topline
695: }
696: $w create line \
697: $Notebook($w,p$n,x6) [expr $Notebook($w,y5)-2] \
698: $Notebook($w,p$n,x6) $Notebook($w,y5) \
699: -width 2 -fill white -tags topline
700: $w create line \
701: $Notebook($w,p$n,x6) $Notebook($w,y5) \
702: $Notebook($w,x3) $Notebook($w,y5) \
703: -width 2 -fill white -tags topline
704: set Notebook($w,top) $n
705: raise $w.f$n
706: }
707:
708: #
709: # Change the page-specific configuration options for the notebook
710: #
711: proc Notebook:pageconfig {w name args} {
712: global Notebook
713: set i [lsearch $Notebook($w,pages) $name]
714: if {$i<0} return
715: foreach {tag value} $args {
716: switch -- $tag {
717: -state {
718: if {"$value"=="disabled"} {
719: $w itemconfig t$i -fg $Notebook($w,fg,off)
720: } else {
721: $w itemconfig t$i -fg $Notebook($w,fg,on)
722: }
723: }
724: -onexit {
725: set Notebook($w,p$i,onexit) $value
726: }
727: }
728: }
729: }
730:
731: #
732: # This procedure raises a notebook page given its name. But first
733: # we check the "onexit" procedure for the current page (if any) and
734: # if it returns false, we don't allow the raise to proceed.
735: #
736: proc Notebook:raise {w name} {
737: global Notebook
738: set i [lsearch $Notebook($w,pages) $name]
739: if {$i<0} return
740: if {[info exists Notebook($w,p$i,onexit)]} {
741: set onexit $Notebook($w,p$i,onexit)
742: if {"$onexit"!="" && [eval uplevel #0 $onexit]!=0} {
743: Notebook:raise.page $w $i
744: }
745: } else {
746: Notebook:raise.page $w $i
747: }
748: }
749:
750: #
751: # Return the frame associated with a given page of the notebook.
752: #
753: proc Notebook:frame {w name} {
754: global Notebook
755: set i [lsearch $Notebook($w,pages) $name]
756: if {$i>=0} {
757: return $w.f$i
758: } else {
759: return {}
760: }
761: }
762:
763: #
764: # Try to resize the notebook to the next time we become idle.
765: #
766: proc Notebook:scheduleExpand w {
767: global Notebook
768: if {[info exists Notebook($w,expand)]} return
769: set Notebook($w,expand) 1
770: after idle "Notebook:expand $w"
771: }
772:
773: #
774: # Resize the notebook to fit inside its containing widget.
775: #
776: proc Notebook:expand w {
777: global Notebook
778: set wi [expr [winfo width $w]-($Notebook($w,pad)*2+4)]
779: set hi [expr [winfo height $w]-($Notebook($w,pad)*2+36)]
780: Notebook:config $w -width $wi -height $hi
781: catch {unset Notebook($w,expand)}
782: }
783: