Changeset 143
- Timestamp:
- May 9, 2011, 5:49:55 PM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
sandbox/MultiChannelUSB/UserInterface.tcl
r85 r143 16 16 namespace import ::blt::tabnotebook 17 17 18 proc validate {max value} { 18 # ------------------------------------------------------------------------- 19 20 variable oscCodes 21 array set oscCodes { 22 1 {Channel 1} 23 2 {Channel 2} 24 3 {Channel 3} 25 4 {Channel 4} 26 5 {Channel 5} 27 6 {Trigger} 28 } 29 30 # ------------------------------------------------------------------------- 31 32 variable adcCodes 33 array set adcCodes { 34 1 {ADC 1} 35 2 {ADC 2} 36 3 {ADC 3} 37 4 {ADC 4} 38 5 {ADC 5} 39 6 {ADC 6} 40 7 {ADC 7} 41 8 {ADC 8} 42 9 {ADC 9} 43 10 {ADC 10} 44 11 {ADC 11} 45 12 {ADC 12} 46 } 47 48 # ------------------------------------------------------------------------- 49 50 variable inpCodes 51 array set inpCodes { 52 0 {r} 53 1 {f} 54 2 {d} 55 3 {c} 56 } 57 58 # ------------------------------------------------------------------------- 59 60 proc validate {max size value} { 19 61 if {![regexp {^[0-9]*$} $value]} { 62 return 0 63 } elseif {[regexp {^0[0-9]+$} $value]} { 20 64 return 0 21 65 } elseif {$value > $max} { 22 66 return 0 23 } elseif {[string length $value] > 4} {67 } elseif {[string length $value] > $size} { 24 68 return 0 25 69 } else { … … 30 74 # ------------------------------------------------------------------------- 31 75 32 Class Display 33 34 # ------------------------------------------------------------------------- 35 36 Display instproc usbCmd {command} { 37 global usb_handle 38 39 if {[catch {$usb_handle writeRaw [usb::convert $command]} result]} { 40 puts {Error during write} 41 puts $result 42 } 43 } 44 45 # ------------------------------------------------------------------------- 46 47 Display instproc usbCmdRead {command width size} { 48 global usb_handle 49 76 proc doublevalidate {max value} { 77 if {![regexp {^[0-9]{0,2}\.?[0-9]{0,3}$} $value]} { 78 return 0 79 } elseif {[regexp {^0[0-9]+$} $value]} { 80 return 0 81 } elseif {$value > $max} { 82 return 0 83 } else { 84 return 1 85 } 86 } 87 88 # ------------------------------------------------------------------------- 89 90 proc legendLabel {master row key title} { 91 label ${master}.${key}_label -anchor w -text ${title} 92 label ${master}.${key}_value -width 10 -anchor e -text {} 93 94 grid ${master}.${key}_label -row ${row} -column 1 -sticky w 95 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew 96 } 97 98 # ------------------------------------------------------------------------- 99 100 proc legendButton {master row key title var bg {fg black}} { 101 checkbutton ${master}.${key}_check -variable $var 102 label ${master}.${key}_label -anchor w -text ${title} -bg ${bg} -fg $fg 103 label ${master}.${key}_value -width 10 -anchor e -text {} -bg ${bg} -fg $fg 104 105 grid ${master}.${key}_check -row ${row} -column 0 -sticky w 106 grid ${master}.${key}_label -row ${row} -column 1 -sticky w 107 grid ${master}.${key}_value -row ${row} -column 2 -sticky ew 108 } 109 110 # ------------------------------------------------------------------------- 111 112 Class UsbController 113 114 # ------------------------------------------------------------------------- 115 116 UsbController instproc usbConnect {} { 117 my instvar handle 118 119 puts usbConnect 120 121 if {[my exists handle]} { 122 $handle disconnect 123 unset handle 124 } 125 if {1} { 126 while {[catch {usb::connect 0x09FB 0x6001 1 1 0} result]} { 127 set answer [tk_messageBox -icon error -type retrycancel \ 128 -message {Cannot access USB device} -detail $result] 129 # puts $result 130 if {[string equal $answer cancel]} exit 131 } 132 133 set handle $result 134 135 } 136 } 137 138 # ------------------------------------------------------------------------- 139 140 UsbController instproc usbHandle {} { 141 my instvar handle 142 143 if {[my exists handle]} { 144 return $handle 145 } else { 146 my usbConnect 147 } 148 } 149 150 # ------------------------------------------------------------------------- 151 152 UsbController instproc usbCmd {command} { 153 set code [catch {[my usbHandle] writeRaw [usb::convert $command]} result] 154 switch -- $code { 155 1 { 156 # puts $result 157 my usbConnect 158 } 159 } 160 161 } 162 163 # ------------------------------------------------------------------------- 164 165 UsbController instproc usbCmdReadRaw {command size data} { 50 166 my usbCmd $command 51 167 52 set usb_data {} 53 if {[catch {$usb_handle readHex $width $size} result]} { 54 puts {Error during read} 55 puts $result 56 set result {} 57 } 58 59 my set data $result 60 } 61 62 # ------------------------------------------------------------------------- 63 64 Display instproc usbCmdReadEpt {command size} { 65 global usb_handle 66 168 set code [catch {[my usbHandle] readRaw $size} result] 169 switch -- $code { 170 0 { 171 set $data $result 172 } 173 1 { 174 # puts $result 175 my usbConnect 176 } 177 5 { 178 # puts Busy 179 } 180 } 181 } 182 183 # ------------------------------------------------------------------------- 184 185 UsbController instproc usbCmdReadRaw {command size data} { 67 186 my usbCmd $command 68 187 69 set usb_data {} 70 if {[catch {$usb_handle readEpt $size} result]} { 71 puts {Error during read} 72 puts $result 73 set result {} 74 } 75 76 my set data $result 77 } 78 79 # ------------------------------------------------------------------------- 80 81 Class CfgDisplay -superclass Display -parameter { 188 set code [catch {[my usbHandle] readRaw $size} result] 189 switch -- $code { 190 0 { 191 set $data $result 192 } 193 1 { 194 # puts $result 195 my usbConnect 196 } 197 5 { 198 # puts Busy 199 } 200 } 201 } 202 203 # ------------------------------------------------------------------------- 204 205 UsbController instproc usbCmdReadHex {command width size data} { 206 my usbCmd $command 207 208 set code [catch {[my usbHandle] readHex $width $size} result] 209 switch -- $code { 210 0 { 211 set $data $result 212 } 213 1 { 214 # puts $result 215 my usbConnect 216 } 217 5 { 218 # puts Busy 219 } 220 } 221 } 222 223 # ------------------------------------------------------------------------- 224 225 Class SpiDisplay -parameter { 82 226 {master} 83 } 84 85 # ------------------------------------------------------------------------- 86 87 CfgDisplay instproc init {} { 88 89 my reset 227 {controller} 228 } 229 230 # ------------------------------------------------------------------------- 231 232 SpiDisplay instproc init {} { 90 233 91 234 my setup … … 96 239 # ------------------------------------------------------------------------- 97 240 98 CfgDisplay instproc destroy {} {241 SpiDisplay instproc destroy {} { 99 242 next 100 243 } … … 102 245 # ------------------------------------------------------------------------- 103 246 104 CfgDisplay instproc reset {} { 105 } 106 107 # ------------------------------------------------------------------------- 108 109 CfgDisplay instproc start {} { 247 SpiDisplay instproc start {} { 110 248 my instvar config 111 249 112 250 trace add variable [myvar dac1] write [myproc dac1_update] 113 251 trace add variable [myvar dac2] write [myproc dac2_update] 114 trace add variable [myvar polar] write [myproc polar_update]115 252 116 253 ${config(1)}.dac1 set 0 117 254 ${config(1)}.dac2 set 0 118 119 ${config(2)}.polar1 select 120 ${config(2)}.polar2 select 121 ${config(2)}.polar3 select 122 } 123 124 # ------------------------------------------------------------------------- 125 126 CfgDisplay instproc setup {} { 255 } 256 257 # ------------------------------------------------------------------------- 258 259 SpiDisplay instproc setup {} { 127 260 my instvar number master 128 261 my instvar config 129 262 130 263 set config(1) [labelframe ${master}.cfg1 -borderwidth 1 -relief sunken -text {DAC}] 131 set config(2) [labelframe ${master}.cfg2 -borderwidth 1 -relief sunken -text {polarity inversion}]132 264 133 265 frame ${config(1)}.limits 134 label ${config(1)}.limits.min -text {0.0V} 135 label ${config(1)}.limits.max -text {-3.3V} 136 137 scale ${config(1)}.dac1 -orient vertical -from 0 -to 4095 -tickinterval 500 -variable [myvar dac1] 138 scale ${config(1)}.dac2 -orient vertical -from 0 -to 4095 -tickinterval 0 -variable [myvar dac2] 139 140 checkbutton ${config(2)}.polar1 -text {channel 1} -variable [myvar polar(1)] 141 checkbutton ${config(2)}.polar2 -text {channel 2} -variable [myvar polar(2)] 142 checkbutton ${config(2)}.polar3 -text {channel 3} -variable [myvar polar(3)] 143 144 grid ${config(1)} -sticky ns 145 grid ${config(2)} -sticky ew -pady 7 266 label ${config(1)}.limits.min -text {2.5V} 267 label ${config(1)}.limits.max -text {0.0V} 268 269 scale ${config(1)}.dac1 -orient vertical -from 4095 -to 0 -tickinterval 0 -variable [myvar dac1] 270 scale ${config(1)}.dac2 -orient vertical -from 4095 -to 0 -tickinterval 0 -variable [myvar dac2] 146 271 147 272 pack ${config(1)}.limits.min -anchor n -side top -pady 10 … … 150 275 grid ${config(1)}.dac1 ${config(1)}.dac2 ${config(1)}.limits -sticky ns -pady 7 151 276 152 grid ${config(2)}.polar1 153 grid ${config(2)}.polar2 154 grid ${config(2)}.polar3 155 277 278 set config(2) [labelframe ${master}.cfg2 -borderwidth 1 -relief sunken -text {ADC}] 279 280 frame ${config(2)}.spc1 -width 130 -height 10 281 frame ${config(2)}.spc2 -width 130 -height 10 282 frame ${config(2)}.spc3 -width 130 -height 10 283 284 button ${config(2)}.reset -text {Reset} -command [myproc adc_reset] 285 button ${config(2)}.pattern -text {Test pattern} -command [myproc adc_pattern] 286 button ${config(2)}.ramp -text {Test ramp} -command [myproc adc_ramp] 287 button ${config(2)}.100mV -text {Test 100 mV} -command [myproc adc_100mV] 288 button ${config(2)}.150mV -text {Test 150 mV} -command [myproc adc_150mV] 289 button ${config(2)}.fltr0 -text {Filter 14MHz} -command [myproc adc_fltr0] 290 button ${config(2)}.fltr1 -text {Filter 10MHz} -command [myproc adc_fltr1] 291 button ${config(2)}.fltr2 -text {Filter 7.5MHz} -command [myproc adc_fltr2] 292 293 grid ${config(2)}.spc1 294 grid ${config(2)}.reset -sticky ew -pady 3 -padx 5 295 grid ${config(2)}.spc2 296 grid ${config(2)}.pattern -sticky ew -pady 3 -padx 5 297 grid ${config(2)}.ramp -sticky ew -pady 3 -padx 5 298 grid ${config(2)}.100mV -sticky ew -pady 3 -padx 5 299 grid ${config(2)}.150mV -sticky ew -pady 3 -padx 5 300 grid ${config(2)}.spc3 301 grid ${config(2)}.fltr0 -sticky ew -pady 3 -padx 5 302 grid ${config(2)}.fltr1 -sticky ew -pady 3 -padx 5 303 grid ${config(2)}.fltr2 -sticky ew -pady 3 -padx 5 304 305 grid ${config(1)} -row 1 -column 1 -sticky ns 306 grid ${config(2)} -row 1 -column 2 -sticky ns 307 308 grid columnconfigure ${master} 0 -weight 1 309 grid columnconfigure ${master} 1 -weight 1 310 grid columnconfigure ${master} 2 -weight 1 311 grid columnconfigure ${master} 3 -weight 1 312 313 grid rowconfigure ${master} 0 -weight 0 314 grid rowconfigure ${master} 1 -weight 1 315 grid rowconfigure ${master} 2 -weight 0 316 317 grid rowconfigure ${config(1)} 0 -weight 1 318 } 319 320 # ------------------------------------------------------------------------- 321 322 SpiDisplay instproc dac1_update args { 323 my instvar controller dac1 324 325 set value [format {3%03x} $dac1] 326 327 set prefix [format {%x} 12] 328 329 set command {} 330 append command 0001${prefix}00000020000000402[string range $value 0 1] 331 append command 0001${prefix}000000200000004[string range $value 2 3]00 332 333 $controller usbCmd $command 334 } 335 336 # ------------------------------------------------------------------------- 337 338 SpiDisplay instproc dac2_update args { 339 my instvar controller dac2 340 341 set value [format {b%03x} $dac1] 342 343 set prefix [format {%x} 12] 344 345 set command {} 346 append command 0001${prefix}00000020000000402[string range $value 0 1] 347 append command 0001${prefix}000000200000004[string range $value 2 3]00 348 349 $controller usbCmd $command 350 } 351 352 # ------------------------------------------------------------------------- 353 354 SpiDisplay instproc adc_reset args { 355 my instvar controller 356 357 set prefix [format {%x} 12] 358 359 set command {} 360 361 set value {000001} 362 append command 0001${prefix}00000020000000401[string range $value 0 1] 363 append command 0001${prefix}000000200000004[string range $value 2 5] 364 365 set value {040008} 366 append command 0001${prefix}00000020000000401[string range $value 0 1] 367 append command 0001${prefix}000000200000004[string range $value 2 5] 368 369 $controller usbCmd $command 370 } 371 372 # ------------------------------------------------------------------------- 373 374 SpiDisplay instproc adc_pattern args { 375 my instvar controller 376 377 set value {022000} 378 379 set prefix [format {%x} 12] 380 381 set command {} 382 append command 0001${prefix}00000020000000401[string range $value 0 1] 383 append command 0001${prefix}000000200000004[string range $value 2 5] 384 385 $controller usbCmd $command 386 } 387 388 # ------------------------------------------------------------------------- 389 390 SpiDisplay instproc adc_ramp args { 391 my instvar controller 392 393 set value {02E000} 394 395 set prefix [format {%x} 12] 396 397 set command {} 398 append command 0001${prefix}00000020000000401[string range $value 0 1] 399 append command 0001${prefix}000000200000004[string range $value 2 5] 400 401 $controller usbCmd $command 402 } 403 404 # ------------------------------------------------------------------------- 405 406 SpiDisplay instproc adc_100mV args { 407 my instvar controller 408 409 set value {070080} 410 411 set prefix [format {%x} 12] 412 413 set command {} 414 append command 0001${prefix}00000020000000401[string range $value 0 1] 415 append command 0001${prefix}000000200000004[string range $value 2 5] 416 417 $controller usbCmd $command 418 } 419 420 # ------------------------------------------------------------------------- 421 422 SpiDisplay instproc adc_150mV args { 423 my instvar controller 424 425 set value {070180} 426 427 set prefix [format {%x} 12] 428 429 set command {} 430 append command 0001${prefix}00000020000000401[string range $value 0 1] 431 append command 0001${prefix}000000200000004[string range $value 2 5] 432 433 $controller usbCmd $command 434 } 435 436 # ------------------------------------------------------------------------- 437 438 SpiDisplay instproc adc_fltr0 args { 439 my instvar controller 440 441 set value {070000} 442 443 set prefix [format {%x} 12] 444 445 set command {} 446 append command 0001${prefix}00000020000000401[string range $value 0 1] 447 append command 0001${prefix}000000200000004[string range $value 2 5] 448 449 $controller usbCmd $command 450 } 451 452 # ------------------------------------------------------------------------- 453 454 SpiDisplay instproc adc_fltr1 args { 455 my instvar controller 456 457 set value {070004} 458 459 set prefix [format {%x} 12] 460 461 set command {} 462 append command 0001${prefix}00000020000000401[string range $value 0 1] 463 append command 0001${prefix}000000200000004[string range $value 2 5] 464 465 $controller usbCmd $command 466 } 467 468 # ------------------------------------------------------------------------- 469 470 SpiDisplay instproc adc_fltr2 args { 471 my instvar controller 472 473 set value {070008} 474 475 set prefix [format {%x} 12] 476 477 set command {} 478 append command 0001${prefix}00000020000000401[string range $value 0 1] 479 append command 0001${prefix}000000200000004[string range $value 2 5] 480 481 $controller usbCmd $command 482 } 483 484 # ------------------------------------------------------------------------- 485 486 Class MuxDisplay -parameter { 487 {master} 488 {controller} 489 } 490 491 # ------------------------------------------------------------------------- 492 493 MuxDisplay instproc init {} { 494 495 my setup 496 497 next 498 } 499 500 # ------------------------------------------------------------------------- 501 502 MuxDisplay instproc destroy {} { 503 next 504 } 505 506 # ------------------------------------------------------------------------- 507 508 MuxDisplay instproc start {} { 509 variable adcCodes 510 my instvar config chan_val 511 512 set chan_val(1) 0 513 set chan_val(2) 0 514 set chan_val(3) 0 515 set chan_val(4) 0 516 set chan_val(5) 0 517 set chan_val(6) 0 518 519 trace add variable [myvar chan_val] write [myproc chan_val_update] 520 trace add variable [myvar polar] write [myproc polar_update] 521 522 $config(1).chan_0_1 select 523 $config(2).chan_0_2 select 524 $config(3).chan_0_3 select 525 $config(4).chan_0_4 select 526 $config(5).chan_0_5 select 527 $config(6).chan_0_1 select 528 529 foreach {ch dummy} [array get adcCodes] { 530 $config(inv).polar_${ch} deselect 531 } 532 } 533 534 # ------------------------------------------------------------------------- 535 536 MuxDisplay instproc setup {} { 537 variable oscCodes 538 variable adcCodes 539 variable inpCodes 540 my instvar master 541 my instvar config 542 543 set size [array size inpCodes] 544 set oscList [array get oscCodes] 545 set adcList [array get adcCodes] 546 set inpList [array get inpCodes] 547 548 set mux [frame ${master}.mux] 549 set key [frame ${master}.key] 550 set inv [frame ${master}.inv] 551 552 foreach {osc title} $oscList { 553 set config($osc) [labelframe ${mux}.$osc -borderwidth 1 -relief sunken -text $title] 554 set column 1 555 foreach {code input} $inpList { 556 label $config($osc).input_${input} -text " ${input}" 557 grid $config($osc).input_${input} -row 0 -column ${column} -sticky w 558 incr column 559 } 560 foreach {ch dummy} $adcList { 561 label $config($osc).chan_${ch} -text "${ch} " 562 grid $config($osc).chan_${ch} -row ${ch} -column 0 -sticky ew 563 foreach {code input} $inpList { 564 set column [expr {$code + 1}] 565 set value [expr {$size * ($ch - 1) + $code}] 566 radiobutton $config($osc).chan_${code}_${ch} -variable [myvar chan_val($osc)] -value ${value} 567 grid $config($osc).chan_${code}_${ch} -row ${ch} -column ${column} -sticky w 568 } 569 } 570 set column [expr {($osc - 1) % 6}] 571 set row [expr {($osc - 1) / 6}] 572 grid $config($osc) -row ${row} -column ${column} -sticky news -padx 10 573 } 574 575 set config(key) [labelframe ${key}.frame -borderwidth 1 -relief sunken -text {legend}] 576 577 label $config(key).r -text "r - raw signal" 578 grid $config(key).r -row 0 -column 0 -sticky news 579 580 label $config(key).f -text "f - filtered signal" 581 grid $config(key).f -row 0 -column 1 -sticky news 582 583 label $config(key).d -text "d - deconvoluted signal" 584 grid $config(key).d -row 0 -column 2 -sticky news 585 586 label $config(key).c -text "c - clipped signal" 587 grid $config(key).c -row 0 -column 3 -sticky news 588 589 grid $config(key) -row 0 -column 0 -sticky news -padx 10 590 591 592 set config(inv) [labelframe ${inv}.frame -borderwidth 1 -relief sunken -text {polarity inversion}] 593 label $config(inv).chan_label -text "channel " 594 grid $config(inv).chan_label -row 0 -column 0 -sticky e 595 label $config(inv).polar_label -text "polarity" 596 grid $config(inv).polar_label -row 1 -column 0 -sticky e 597 foreach {ch dummy} $adcList { 598 label $config(inv).chan_${ch} -text "${ch} " 599 grid $config(inv).chan_${ch} -row 0 -column ${ch} -sticky ew 600 checkbutton $config(inv).polar_${ch} -variable [myvar polar($ch)] 601 grid $config(inv).polar_${ch} -row 1 -column ${ch} -sticky w 602 } 603 grid $config(inv) -row 0 -column 0 -sticky news -padx 10 604 605 grid ${key} -row 0 -column 0 -sticky news 606 grid ${mux} -row 1 -column 0 -sticky news 607 grid ${inv} -row 2 -column 0 -sticky news 608 609 grid columnconfigure ${master} 0 -weight 1 156 610 grid rowconfigure ${master} 0 -weight 1 157 grid rowconfigure ${config(1)} 0 -weight 1 158 grid rowconfigure ${config(2)} 0 -weight 1 159 } 160 161 # ------------------------------------------------------------------------- 162 163 CfgDisplay instproc dac1_update args { 164 my instvar dac1 165 166 set value [format {%03x} $dac1] 167 set command 0005012000050030000500[string range $value 0 1]000502[string index $value 2]0 168 169 my usbCmd $command 170 } 171 172 # ------------------------------------------------------------------------- 173 174 CfgDisplay instproc dac2_update args { 175 my instvar dac2 176 177 set value [format {%03x} $dac2] 178 set command 0005012400050030000500[string range $value 0 1]000502[string index $value 2]0 179 180 my usbCmd $command 181 } 182 183 # ------------------------------------------------------------------------- 184 185 CfgDisplay instproc polar_update args { 186 my instvar polar 187 188 set value [format {0%x%x%x} $polar(3) $polar(2) $polar(1)] 189 190 my usbCmd 000A${value} 191 } 192 193 # ------------------------------------------------------------------------- 194 195 Class OscDisplay -superclass Display -parameter { 611 grid rowconfigure ${master} 1 -weight 1 612 grid rowconfigure ${master} 2 -weight 1 613 614 grid columnconfigure ${inv} 0 -weight 1 615 616 grid columnconfigure ${key} 0 -weight 1 617 grid columnconfigure $config(key) 0 -weight 1 618 grid columnconfigure $config(key) 1 -weight 1 619 grid columnconfigure $config(key) 2 -weight 1 620 grid columnconfigure $config(key) 3 -weight 1 621 622 623 grid columnconfigure ${mux} 0 -weight 1 624 grid columnconfigure ${mux} 1 -weight 1 625 grid columnconfigure ${mux} 2 -weight 1 626 grid columnconfigure ${mux} 3 -weight 1 627 grid columnconfigure ${mux} 4 -weight 1 628 grid columnconfigure ${mux} 5 -weight 1 629 630 631 } 632 633 634 # ------------------------------------------------------------------------ 635 636 MuxDisplay instproc chan_val_update args { 637 my instvar controller chan_val 638 639 set byte1 [format {%02x%02x} $chan_val(2) $chan_val(1)] 640 set byte2 [format {%02x%02x} $chan_val(4) $chan_val(3)] 641 set byte3 [format {%02x%02x} $chan_val(6) $chan_val(5)] 642 643 $controller usbCmd 000200020004${byte1}000200030004${byte2}000200040004${byte3} 644 } 645 646 # ------------------------------------------------------------------------- 647 648 MuxDisplay instproc polar_update args { 649 my instvar controller polar 650 651 set value {0b} 652 for {set i 12} {$i >= 1} {incr i -1} { 653 append value $polar($i) 654 } 655 656 set value [format {%04x} $value] 657 658 $controller usbCmd 000200010004${value} 659 } 660 661 # ------------------------------------------------------------------------- 662 663 Class HstDisplay -parameter { 196 664 {number} 197 665 {master} 198 } 199 200 # ------------------------------------------------------------------------- 201 202 OscDisplay instproc init {} { 203 my instvar data xvec yvec 204 205 set xvec [vector #auto] 206 set yvec [vector #auto] 207 # fill one vector for the x axis with 1025 points 208 $xvec seq 0 1024 209 210 my reset 666 {controller} 667 } 668 669 # ------------------------------------------------------------------------- 670 671 HstDisplay instproc init {} { 672 673 my set data {} 674 675 vector create [myvar xvec](4096) 676 vector create [myvar yvec](4096) 677 678 # fill one vector for the x axis with 4096 points 679 [myvar xvec] seq -0.5 4095.5 211 680 212 681 my setup … … 217 686 # ------------------------------------------------------------------------- 218 687 219 OscDisplay instproc destroy {} {688 HstDisplay instproc destroy {} { 220 689 next 221 690 } … … 223 692 # ------------------------------------------------------------------------- 224 693 225 OscDisplay instproc reset {} { 226 my instvar data xvec yvec 227 228 set data {} 229 230 $yvec set {} 231 } 232 233 # ------------------------------------------------------------------------- 234 235 OscDisplay instproc start {} { 236 my instvar config trig_mux disp_mux 237 238 set trig_mux 2 239 set disp_mux 2 694 HstDisplay instproc start {} { 695 my instvar config 240 696 241 697 trace add variable [myvar data] write [myproc data_update] 242 trace add variable [myvar auto] write [myproc auto_update] 698 trace add variable [myvar cntr_val] write [myproc cntr_val_update] 699 trace add variable [myvar rate_val] write [myproc rate_val_update] 700 701 trace add variable [myvar axis] write [myproc axis_update] 243 702 trace add variable [myvar thrs] write [myproc thrs_update] 244 trace add variable [myvar thrs_val] write [myproc thrs_val_update] 245 trace add variable [myvar disp_val] write [myproc disp_val_update] 246 trace add variable [myvar trig_val] write [myproc trig_val_update] 247 248 ${config}.auto_check select 703 trace add variable [myvar thrs_val] write [myproc thrs_update] 704 trace add variable [myvar base] write [myproc base_update] 705 trace add variable [myvar base_typ] write [myproc base_typ_update] 706 trace add variable [myvar base_val] write [myproc base_val_update] 707 708 ${config}.axis_check select 709 249 710 ${config}.thrs_check select 250 ${config}.thrs_field set 1278 251 ${config}.disp_uwt2 select 252 ${config}.trig_uwt2 select 253 } 254 255 # ------------------------------------------------------------------------- 256 257 OscDisplay instproc setup {} { 711 ${config}.thrs_field set 25 712 713 ${config}.base_auto select 714 ${config}.base_field set 20 715 ${config}.base_check select 716 717 set cntr_tmp 1200000000 718 my set cntr_val $cntr_tmp 719 my set cntr_bak $cntr_tmp 720 my set cntr_old $cntr_tmp 721 my set yvec_bak 0.0 722 my set yvec_old 0.0 723 724 my set rate_val(inst) 0.0 725 my set rate_val(mean) 0.0 726 727 # my cntr_reset 728 } 729 730 # ------------------------------------------------------------------------- 731 732 HstDisplay instproc setup {} { 258 733 my instvar number master 259 my instvar data xvec yvec 260 my instvar config auto thrs thrs_val disp_val trig_val 734 my instvar xvec yvec graph 735 my instvar config thrs thrs_val base base_typ base_val 736 my instvar cntr_h cntr_m cntr_s 261 737 262 738 # create a graph widget and show a grid 263 739 set graph [graph ${master}.graph -height 250 -leftmargin 80] 264 $graph crosshairs configure -hide no -linewidth 2 -dashes { 1 1}740 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} 265 741 $graph grid configure -hide no 266 742 $graph legend configure -hide yes 267 $graph axis configure x -min 0 -max 1024 268 $graph axis configure y -min 0 -max 4100 269 270 set config [frame ${master}.config] 271 272 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto] 273 274 frame ${config}.spc1 -width 10 -height 10 743 $graph axis configure x -min 0 -max 4096 744 745 set config [frame ${master}.config -width 170] 746 747 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis] 748 749 frame ${config}.spc1 -width 170 -height 30 750 751 frame ${config}.rate_frame -borderwidth 0 -width 170 752 legendLabel ${config}.rate_frame 0 inst {Inst. rate, 1/s} 753 legendLabel ${config}.rate_frame 1 mean {Avg. rate, 1/s} 754 755 frame ${config}.spc2 -width 170 -height 30 756 757 frame ${config}.chan_frame -borderwidth 0 -width 170 758 legendLabel ${config}.chan_frame 0 axisy {Bin entries} 759 legendLabel ${config}.chan_frame 1 axisx {Bin number} 760 761 frame ${config}.spc3 -width 170 -height 30 762 763 frame ${config}.cntr_frame -borderwidth 0 -width 170 764 765 label ${config}.cntr_frame.h -width 3 -anchor w -text {h} 766 entry ${config}.cntr_frame.h_field -width 3 -textvariable [myvar cntr_h] \ 767 -validate all -vcmd {::mca::validate 999 3 %P} 768 label ${config}.cntr_frame.m -width 3 -anchor w -text {m} 769 entry ${config}.cntr_frame.m_field -width 3 -textvariable [myvar cntr_m] \ 770 -validate all -vcmd {::mca::validate 59 2 %P} 771 label ${config}.cntr_frame.s -width 3 -anchor w -text {s} 772 entry ${config}.cntr_frame.s_field -width 6 -textvariable [myvar cntr_s] \ 773 -validate all -vcmd {::mca::doublevalidate 59.999 %P} 774 775 grid ${config}.cntr_frame.h_field ${config}.cntr_frame.h \ 776 ${config}.cntr_frame.m_field ${config}.cntr_frame.m ${config}.cntr_frame.s_field ${config}.cntr_frame.s 777 778 frame ${config}.spc4 -width 170 -height 10 779 780 button ${config}.start -text Start \ 781 -bg yellow -activebackground yellow -command [myproc cntr_start] 782 button ${config}.reset -text Reset \ 783 -bg red -activebackground red -command [myproc cntr_reset] 784 785 frame ${config}.spc5 -width 170 -height 30 275 786 276 787 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs] 277 788 spinbox ${config}.thrs_field -from 1 -to 4095 \ 278 789 -increment 5 -width 10 -textvariable [myvar thrs_val] \ 279 -validate all -vcmd {::mca::validate 4095 %P} 280 281 frame ${config}.spc2 -width 10 -height 10 282 283 label ${config}.disp -text {display input} 284 radiobutton ${config}.disp_data -text {raw data} -variable [myvar disp_val] -value data 285 radiobutton ${config}.disp_uwt1 -text {filter 1} -variable [myvar disp_val] -value uwt1 286 radiobutton ${config}.disp_uwt2 -text {filter 2} -variable [myvar disp_val] -value uwt2 287 radiobutton ${config}.disp_uwt3 -text {filter 3} -variable [myvar disp_val] -value uwt3 288 radiobutton ${config}.disp_base -text {baseline} -variable [myvar disp_val] -value base 289 # radiobutton ${config}.disp_sum8 -text {sum of 8} -variable [myvar disp_val] -value sum8 290 291 frame ${config}.spc3 -width 10 -height 10 292 293 label ${config}.trig -text {trigger input} 294 radiobutton ${config}.trig_data -text {raw data} -variable [myvar trig_val] -value data 295 radiobutton ${config}.trig_uwt1 -text {filter 1} -variable [myvar trig_val] -value uwt1 296 radiobutton ${config}.trig_uwt2 -text {filter 2} -variable [myvar trig_val] -value uwt2 297 radiobutton ${config}.trig_uwt3 -text {filter 3} -variable [myvar trig_val] -value uwt3 298 radiobutton ${config}.trig_base -text {baseline} -variable [myvar trig_val] -value base 299 # radiobutton ${config}.trig_sum8 -text {sum of 8} -variable [myvar trig_val] -value sum8 300 301 frame ${config}.spc4 -width 10 -height 10 302 303 button ${config}.acquire -text Acquire \ 304 -bg green -activebackground green -command [myproc acquire] 305 button ${config}.restart -text Restart \ 306 -bg yellow -activebackground yellow -command [myproc restart] 790 -validate all -vcmd {::mca::validate 4095 4 %P} 791 792 frame ${config}.spc6 -width 170 -height 30 793 794 checkbutton ${config}.base_check -text baseline -variable [myvar base] 795 radiobutton ${config}.base_auto -text automatic -variable [myvar base_typ] -value 1 796 radiobutton ${config}.base_const -text constant -variable [myvar base_typ] -value 0 797 spinbox ${config}.base_field -from 1 -to 4095 \ 798 -increment 5 -width 10 -textvariable [myvar base_val] \ 799 -validate all -vcmd {::mca::validate 4095 4 %P} 800 801 frame ${config}.spc7 -width 170 -height 30 802 307 803 button ${config}.register -text Register \ 308 804 -bg lightblue -activebackground lightblue -command [myproc register] 309 805 310 grid ${config}.a uto_check -sticky w806 grid ${config}.axis_check -sticky w 311 807 grid ${config}.spc1 808 grid ${config}.rate_frame -sticky ew -padx 5 809 grid ${config}.spc2 810 grid ${config}.chan_frame -sticky ew -padx 5 811 grid ${config}.spc3 812 grid ${config}.cntr_frame -sticky ew -padx 5 813 grid ${config}.spc4 814 grid ${config}.start -sticky ew -pady 3 -padx 5 815 grid ${config}.reset -sticky ew -pady 3 -padx 5 816 grid ${config}.spc5 312 817 grid ${config}.thrs_check -sticky w 313 818 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 314 grid ${config}.spc2 315 grid ${config}.disp -sticky w -pady 1 -padx 3 316 grid ${config}.disp_data -sticky w 317 grid ${config}.disp_uwt1 -sticky w 318 grid ${config}.disp_uwt2 -sticky w 319 grid ${config}.disp_uwt3 -sticky w 320 grid ${config}.disp_base -sticky w 321 # grid ${config}.disp_sum8 -sticky w 322 grid ${config}.spc3 323 grid ${config}.trig -sticky w -pady 1 -padx 3 324 grid ${config}.trig_data -sticky w 325 grid ${config}.trig_uwt1 -sticky w 326 grid ${config}.trig_uwt2 -sticky w 327 grid ${config}.trig_uwt3 -sticky w 328 grid ${config}.trig_base -sticky w 329 # grid ${config}.disp_sum8 -sticky w 330 grid ${config}.spc4 331 grid ${config}.acquire -sticky ew -pady 3 -padx 5 332 grid ${config}.restart -sticky ew -pady 3 -padx 5 333 grid ${config}.register -sticky ew -pady 3 -padx 5 334 335 grid ${graph} -row 0 -column 0 -sticky news 336 grid ${config} -row 0 -column 1 337 338 grid rowconfigure ${master} 0 -weight 1 339 grid columnconfigure ${master} 0 -weight 1 340 grid columnconfigure ${master} 1 -weight 0 -minsize 80 341 342 # enable zooming 343 Blt_ZoomStack $graph 344 345 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y} 346 347 # create one element with data for the x and y axis, no dots 348 $graph element create Spectrum1 -symbol none -xdata $xvec -ydata $yvec 349 } 350 351 # ------------------------------------------------------------------------- 352 353 OscDisplay instproc data_update args { 354 my instvar data yvec 355 $yvec set $data 356 } 357 358 # ------------------------------------------------------------------------- 359 360 OscDisplay instproc auto_update args { 361 my instvar config auto after_handle 362 363 if {$auto} { 364 ${config}.acquire configure -state disabled 365 ${config}.restart configure -state disabled 366 ${config}.register configure -state disabled 367 368 my acquire_restart_loop 369 } else { 370 if {[my exists after_handle]} { 371 after cancel $after_handle 372 } 373 ${config}.acquire configure -state active 374 ${config}.restart configure -state active 375 ${config}.register configure -state active 376 } 377 } 378 379 # ------------------------------------------------------------------------- 380 381 OscDisplay instproc thrs_update args { 382 my instvar config number thrs thrs_val 383 384 set val_addr [format %04x [expr {17 + ${number}}]] 385 386 if {$thrs} { 387 ${config}.thrs_field configure -state normal 388 my thrs_val_update 389 } else { 390 ${config}.thrs_field configure -state disabled 391 my usbCmd ${val_addr}0000 392 } 393 } 394 395 # ------------------------------------------------------------------------- 396 397 OscDisplay instproc thrs_val_update args { 398 my instvar config number thrs_val 399 400 if {[string equal $thrs_val {}]} { 401 set thrs_val 0 402 } 403 404 set val_addr [format %04x [expr {17 + ${number}}]] 405 set value [format %04x $thrs_val] 406 407 my usbCmd ${val_addr}${value} 408 } 409 410 # ------------------------------------------------------------------------- 411 412 OscDisplay instproc mux {} { 413 my instvar trig_mux disp_mux 414 415 format {00%x%x} $trig_mux $disp_mux 416 } 417 418 # ------------------------------------------------------------------------ 419 420 OscDisplay instproc disp_val_update args { 421 my instvar number disp_val disp_mux 422 423 set mux_addr [format %04x [expr {20 + ${number}}]] 424 425 switch -- $disp_val { 426 data { 427 set disp_mux 0 428 my usbCmd ${mux_addr}[my mux] 429 } 430 uwt1 { 431 set disp_mux 1 432 my usbCmd ${mux_addr}[my mux] 433 } 434 uwt2 { 435 set disp_mux 2 436 my usbCmd ${mux_addr}[my mux] 437 } 438 uwt3 { 439 set disp_mux 3 440 my usbCmd ${mux_addr}[my mux] 441 } 442 base { 443 set disp_mux 4 444 my usbCmd ${mux_addr}[my mux] 445 } 446 } 447 } 448 449 # ------------------------------------------------------------------------ 450 451 OscDisplay instproc trig_val_update args { 452 my instvar number trig_val trig_mux 453 454 set mux_addr [format %04x [expr {20 + ${number}}]] 455 456 switch -- $trig_val { 457 data { 458 set trig_mux 0 459 my usbCmd ${mux_addr}[my mux] 460 } 461 uwt1 { 462 set trig_mux 1 463 my usbCmd ${mux_addr}[my mux] 464 } 465 uwt2 { 466 set trig_mux 2 467 my usbCmd ${mux_addr}[my mux] 468 } 469 uwt3 { 470 set trig_mux 3 471 my usbCmd ${mux_addr}[my mux] 472 } 473 base { 474 set trig_mux 4 475 my usbCmd ${mux_addr}[my mux] 476 } 477 } 478 } 479 480 # ------------------------------------------------------------------------- 481 482 OscDisplay instproc save_data {data} { 483 set file [tk_getSaveFile] 484 if {[string equal $file {}]} { 485 return 486 } 487 488 set x [catch {set fid [open $file w+]}] 489 set y [catch {puts $fid $data}] 490 set z [catch {close $fid}] 491 492 if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } { 493 tk_messageBox -icon error \ 494 -message "An error occurred while writing to \"$file\"" 495 } else { 496 tk_messageBox -icon info \ 497 -message "File \"$file\" written successfully" 498 } 499 } 500 501 # ------------------------------------------------------------------------- 502 503 OscDisplay instproc acquire {} { 504 my instvar number 505 my usbCmdRead 0002000${number} 2 1024 506 } 507 508 # ------------------------------------------------------------------------- 509 510 OscDisplay instproc restart {} { 511 my instvar number 512 my usbCmd 0001000${number} 513 } 514 515 # ------------------------------------------------------------------------- 516 517 OscDisplay instproc register {} { 518 my save_data [my set data] 519 } 520 521 # ------------------------------------------------------------------------- 522 523 OscDisplay instproc acquire_restart_loop {} { 524 my instvar number after_handle 525 526 my acquire 527 my restart 528 529 set after_handle [after 1000 [myproc acquire_restart_loop]] 530 } 531 532 # ------------------------------------------------------------------------- 533 534 Class HstDisplay -superclass Display -parameter { 535 {number} 536 {master} 537 } 538 539 # ------------------------------------------------------------------------- 540 541 HstDisplay instproc init {} { 542 my instvar data xvec yvec 543 544 set xvec [vector #auto] 545 set yvec [vector #auto] 546 # fill one vector for the x axis with 4097 points 547 $xvec seq 0 4096 548 549 my reset 550 551 my setup 552 553 next 554 } 555 556 # ------------------------------------------------------------------------- 557 558 HstDisplay instproc destroy {} { 559 next 560 } 561 562 # ------------------------------------------------------------------------- 563 564 HstDisplay instproc reset {} { 565 my instvar data xvec yvec 566 567 set data {} 568 569 $yvec set {} 570 } 571 572 # ------------------------------------------------------------------------- 573 574 HstDisplay instproc start {} { 575 my instvar config base_mux peak_mux 576 577 set base_mux 0 578 set peak_mux 1 579 580 trace add variable [myvar axis] write [myproc axis_update] 581 trace add variable [myvar data] write [myproc data_update] 582 trace add variable [myvar auto] write [myproc auto_update] 583 trace add variable [myvar peak] write [myproc peak_update] 584 trace add variable [myvar thrs] write [myproc thrs_update] 585 trace add variable [myvar thrs_val] write [myproc thrs_val_update] 586 trace add variable [myvar base] write [myproc base_update] 587 trace add variable [myvar base_typ] write [myproc base_typ_update] 588 trace add variable [myvar base_val] write [myproc base_val_update] 589 590 ${config}.axis_check deselect 591 ${config}.auto_check select 592 ${config}.peak_check select 593 594 ${config}.thrs_check select 595 ${config}.thrs_field set 1278 596 597 ${config}.base_const select 598 ${config}.base_field set 35 599 ${config}.base_check deselect 600 } 601 602 # ------------------------------------------------------------------------- 603 604 HstDisplay instproc setup {} { 605 my instvar number master 606 my instvar data xvec yvec graph 607 my instvar config auto thrs thrs_val base base_typ base_val 608 609 # create a graph widget and show a grid 610 set graph [graph ${master}.graph -height 250 -leftmargin 80] 611 $graph crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 612 $graph grid configure -hide no 613 $graph legend configure -hide yes 614 $graph axis configure x -min 0 -max 4096 615 616 set config [frame ${master}.config] 617 618 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis] 619 620 frame ${config}.spc1 -width 10 -height 10 621 622 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto] 623 624 frame ${config}.spc2 -width 10 -height 10 625 626 checkbutton ${config}.peak_check -text {peak detect} -variable [myvar peak] 627 628 frame ${config}.spc3 -width 10 -height 10 629 630 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs] 631 spinbox ${config}.thrs_field -from 1 -to 4095 \ 632 -increment 5 -width 10 -textvariable [myvar thrs_val] \ 633 -validate all -vcmd {::mca::validate 4095 %P} 634 635 frame ${config}.spc4 -width 10 -height 10 636 637 checkbutton ${config}.base_check -text baseline -variable [myvar base] 638 radiobutton ${config}.base_auto -text automatic -variable [myvar base_typ] -value auto 639 radiobutton ${config}.base_const -text constant -variable [myvar base_typ] -value const 640 spinbox ${config}.base_field -from 1 -to 4095 \ 641 -increment 5 -width 10 -textvariable [myvar base_val] \ 642 -validate all -vcmd {::mca::validate 4095 %P} 643 644 frame ${config}.spc5 -width 10 -height 10 645 646 button ${config}.acquire -text Acquire \ 647 -bg green -activebackground green -command [myproc acquire] 648 button ${config}.restart -text Restart \ 649 -bg yellow -activebackground yellow -command [myproc restart] 650 button ${config}.register -text Register \ 651 -bg lightblue -activebackground lightblue -command [myproc register] 652 653 grid ${config}.axis_check -sticky w 654 grid ${config}.spc1 655 grid ${config}.auto_check -sticky w 656 grid ${config}.spc2 657 grid ${config}.peak_check -sticky w 658 grid ${config}.spc3 659 grid ${config}.thrs_check -sticky w 660 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 661 grid ${config}.spc4 819 grid ${config}.spc6 662 820 grid ${config}.base_check -sticky w 663 821 grid ${config}.base_auto -sticky w 664 822 grid ${config}.base_const -sticky w 665 823 grid ${config}.base_field -sticky ew -pady 1 -padx 5 666 grid ${config}.spc5 667 grid ${config}.acquire -sticky ew -pady 3 -padx 5 668 grid ${config}.restart -sticky ew -pady 3 -padx 5 824 grid ${config}.spc7 669 825 grid ${config}.register -sticky ew -pady 3 -padx 5 670 826 … … 676 832 grid columnconfigure ${master} 1 -weight 0 -minsize 80 677 833 834 grid columnconfigure ${config}.rate_frame 1 -weight 1 835 grid columnconfigure ${config}.chan_frame 1 -weight 1 836 678 837 # enable zooming 679 838 Blt_ZoomStack $graph 680 839 840 my crosshairs $graph 841 681 842 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y} 682 843 683 844 # create one element with data for the x and y axis, no dots 684 $graph element create Spectrum1 -symbol none -smooth step -xdata $xvec -ydata $yvec 845 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec] 846 } 847 848 # ------------------------------------------------------------------------- 849 850 HstDisplay instproc coor_update {W x y} { 851 my instvar config graph 852 853 $W crosshairs configure -position @${x},${y} 854 855 set index [$W axis invtransform x $x] 856 set index [::tcl::mathfunc::round $index] 857 catch { 858 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index] 859 ${config}.chan_frame.axisx_value configure -text ${index}.0 860 } 861 } 862 # ------------------------------------------------------------------------- 863 864 HstDisplay instproc crosshairs {graph} { 865 set method [myproc coor_update] 866 bind $graph <Motion> [list [self] coor_update %W %x %y] 867 bind $graph <Leave> { 868 %W crosshairs off 869 } 870 bind $graph <Enter> { 871 %W crosshairs on 872 } 685 873 } 686 874 … … 698 886 # ------------------------------------------------------------------------- 699 887 700 HstDisplay instproc data_update args {701 my instvar data yvec702 $yvec set $data703 }704 705 # -------------------------------------------------------------------------706 707 HstDisplay instproc auto_update args {708 my instvar auto after_handle709 my instvar config710 if {$auto} {711 ${config}.acquire configure -state disabled712 ${config}.register configure -state disabled713 714 my acquire_loop715 } else {716 if {[my exists after_handle]} {717 after cancel $after_handle718 }719 ${config}.acquire configure -state active720 ${config}.register configure -state active721 }722 }723 724 # -------------------------------------------------------------------------725 726 HstDisplay instproc mux {} {727 my instvar base_mux peak_mux728 729 format {00%x%x} $base_mux $peak_mux730 }731 732 # -------------------------------------------------------------------------733 734 HstDisplay instproc peak_update args {735 my instvar number peak peak_mux736 737 set mux_addr [format %04x [expr {23 + ${number}}]]738 739 if {$peak} {740 set peak_mux 1741 my usbCmd ${mux_addr}[my mux]742 } else {743 set peak_mux 0744 my usbCmd ${mux_addr}[my mux]745 }746 }747 748 # -------------------------------------------------------------------------749 750 888 HstDisplay instproc thrs_update args { 751 my instvar config number thrs thrs_val 752 753 set val_addr [format %04x [expr {14 + ${number}}]] 889 my instvar controller config number thrs thrs_val 890 891 if {[string equal $thrs_val {}]} { 892 set thrs_val 0 893 } 894 895 set val_addr [format %02x [expr {6 + 2 * ${number}}]] 754 896 755 897 if {$thrs} { 756 898 ${config}.thrs_field configure -state normal 757 my thrs_val_update899 set value [format %03x $thrs_val] 758 900 } else { 759 901 ${config}.thrs_field configure -state disabled 760 my usbCmd ${val_addr}0000 761 } 762 } 763 764 # ------------------------------------------------------------------------- 765 766 HstDisplay instproc thrs_val_update args { 767 my instvar config number thrs_val 768 769 if {[string equal $thrs_val {}]} { 770 set thrs_val 0 771 } 772 773 set val_addr [format %04x [expr {14 + ${number}}]] 774 set value [format %04x $thrs_val] 775 776 my usbCmd ${val_addr}${value} 902 set value 000 903 } 904 905 $controller usbCmd 000200${val_addr}00040${value} 777 906 } 778 907 … … 780 909 781 910 HstDisplay instproc base_update args { 782 my instvar config number base base_val base_mux 783 784 set mux_addr [format %04x [expr {23 + ${number}}]] 785 set val_addr [format %04x [expr {11 + ${number}}]] 911 my instvar controller config number base base_typ 912 913 set val_addr [format %02x [expr {7 + 2 * ${number}}]] 786 914 787 915 if {$base} { … … 793 921 ${config}.base_const configure -state disabled 794 922 ${config}.base_field configure -state disabled 795 set base_mux 0 796 my usbCmd ${mux_addr}[my mux]${val_addr}0000 923 $controller usbCmd 000200${val_addr}0004${base_typ}000 797 924 } 798 925 } … … 801 928 802 929 HstDisplay instproc base_typ_update args { 803 my instvar config number base_typ base_val base_mux 804 805 set mux_addr [format %04x [expr {23 + ${number}}]] 806 set val_addr [format %04x [expr {11 + ${number}}]] 807 set value [format %04x $base_val] 930 my instvar config base_typ 808 931 809 932 switch -- $base_typ { 810 auto{933 1 { 811 934 ${config}.base_field configure -state disabled 812 set base_mux 1813 my usbCmd ${mux_addr}[my mux]814 935 } 815 const{936 0 { 816 937 ${config}.base_field configure -state normal 817 set base_mux 0818 my usbCmd ${mux_addr}[my mux]${val_addr}${value}819 938 } 820 939 } 940 941 my base_val_update 821 942 } 822 943 … … 824 945 825 946 HstDisplay instproc base_val_update args { 826 my instvar numberbase_val947 my instvar controller number base_typ base_val 827 948 828 949 if {[string equal $base_val {}]} { … … 830 951 } 831 952 832 set val_addr [format %04x [expr {11 + ${number}}]] 833 set value [format %04x $base_val] 834 835 my usbCmd ${val_addr}${value} 953 set val_addr [format %02x [expr {7 + 2 * ${number}}]] 954 set value [format %03x $base_val] 955 956 $controller usbCmd 000200${val_addr}0004${base_typ}${value} 957 } 958 959 # ------------------------------------------------------------------------- 960 961 HstDisplay instproc rate_val_update {name key op} { 962 my instvar config rate_val 963 964 ${config}.rate_frame.${key}_value configure -text [format {%.2e} $rate_val(${key})] 965 } 966 967 # ------------------------------------------------------------------------- 968 969 HstDisplay instproc cntr_val_update args { 970 my instvar cntr_val cntr_h cntr_m cntr_s 971 972 set cntr_tmp [expr {${cntr_val}/20000}] 973 set cntr_h [expr {${cntr_tmp}/3600000}] 974 set cntr_m [expr {${cntr_tmp}%3600000/60000}] 975 set cntr_s [expr {${cntr_tmp}%3600000%60000/1000.0}] 976 } 977 978 # ------------------------------------------------------------------------- 979 980 HstDisplay instproc cntr_setup {} { 981 my instvar controller number cntr_val 982 983 set word0 [format %08x [expr {${cntr_val} & 0xFFFFFFFF}]] 984 set word1 [format %08x [expr {${cntr_val} >> 32}]] 985 986 set prefix [format %x [expr {5 + ${number}}]] 987 988 set command {} 989 append command 0001${prefix}000000200000004[string range $word0 4 7] 990 append command 0001${prefix}000000200010004[string range $word0 0 3] 991 append command 0001${prefix}000000200020004[string range $word1 4 7] 992 append command 0001${prefix}000000200030004[string range $word1 0 3] 993 994 # send counter value 995 $controller usbCmd $command 996 997 # load counter value 998 # set val_addr [format %02x [expr {12 + ${number}}]] 999 # $controller usbCmd 000200${val_addr}00040001000200${val_addr}00040000 1000 } 1001 1002 # ------------------------------------------------------------------------- 1003 1004 HstDisplay instproc cntr_reset {} { 1005 my instvar controller number after_handle 1006 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old 1007 1008 my cntr_stop 1009 1010 set value [format %04x [expr {1 << (5 + ${number})}]] 1011 $controller usbCmd 000200000004${value}0002000000040000 1012 1013 set cntr_val $cntr_bak 1014 my cntr_setup 1015 1016 set cntr_old $cntr_bak 1017 set yvec_bak 0.0 1018 set yvec_old 0.0 1019 1020 my acquire 1021 1022 my cntr_ready 1023 } 1024 1025 # ------------------------------------------------------------------------- 1026 1027 HstDisplay instproc cntr_ready {} { 1028 my instvar config cntr_val cntr_bak 1029 1030 set cntr_val $cntr_bak 1031 1032 ${config}.start configure -text Start -command [myproc cntr_start] 1033 ${config}.reset configure -state active 1034 1035 ${config}.cntr_frame.h_field configure -state normal 1036 ${config}.cntr_frame.m_field configure -state normal 1037 ${config}.cntr_frame.s_field configure -state normal 1038 } 1039 1040 # ------------------------------------------------------------------------- 1041 1042 HstDisplay instproc cntr_start {} { 1043 my instvar config 1044 my instvar cntr_h cntr_m cntr_s 1045 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old 1046 1047 set h $cntr_h 1048 set m $cntr_m 1049 set s $cntr_s 1050 1051 if {[string equal $h {}]} { 1052 set h 0 1053 } 1054 if {[string equal $m {}]} { 1055 set m 0 1056 } 1057 if {[string equal $s {}]} { 1058 set s 0 1059 } 1060 1061 set cntr_tmp [expr {${h}*3600000 + ${m}*60000 + ${s}*1000}] 1062 set cntr_tmp [expr {entier(20000 * ${cntr_tmp})}] 1063 1064 if {$cntr_tmp > 0} { 1065 ${config}.cntr_frame.h_field configure -state disabled 1066 ${config}.cntr_frame.m_field configure -state disabled 1067 ${config}.cntr_frame.s_field configure -state disabled 1068 1069 set cntr_val $cntr_tmp 1070 set cntr_bak $cntr_tmp 1071 set cntr_old $cntr_tmp 1072 set yvec_bak [usb::integrateBlt [myvar yvec] 0] 1073 set yvec_old $yvec_bak 1074 1075 my cntr_setup 1076 1077 my cntr_resume 1078 } 1079 } 1080 1081 # ------------------------------------------------------------------------- 1082 1083 HstDisplay instproc cntr_pause {} { 1084 my instvar config 1085 1086 my cntr_stop 1087 1088 ${config}.start configure -text Resume -command [myproc cntr_resume] 1089 # ${config}.reset configure -state active 1090 1091 } 1092 1093 # ------------------------------------------------------------------------- 1094 1095 HstDisplay instproc cntr_resume {} { 1096 my instvar controller config number auto 1097 1098 set val_addr [format %02x [expr {13 + ${number}}]] 1099 1100 ${config}.start configure -text Pause -command [myproc cntr_pause] 1101 # ${config}.reset configure -state disabled 1102 1103 $controller usbCmd 000200${val_addr}00040002 1104 1105 set auto 1 1106 1107 after 100 [myproc acquire_loop] 1108 } 1109 1110 # ------------------------------------------------------------------------- 1111 1112 HstDisplay instproc cntr_stop {} { 1113 my instvar controller config number auto 1114 1115 set val_addr [format %02x [expr {13 + ${number}}]] 1116 1117 $controller usbCmd 000200${val_addr}00040000 1118 1119 set auto 0 1120 } 1121 1122 # ------------------------------------------------------------------------- 1123 1124 HstDisplay instproc data_update args { 1125 my instvar data 1126 usb::convertBlt $data 4 [myvar yvec] 1127 } 1128 1129 # ------------------------------------------------------------------------- 1130 1131 HstDisplay instproc acquire_loop {} { 1132 my instvar cntr_val auto 1133 1134 my acquire 1135 1136 if {$cntr_val == 0} { 1137 my cntr_stop 1138 my cntr_ready 1139 } elseif {$auto} { 1140 after 1000 [myproc acquire_loop] 1141 } 836 1142 } 837 1143 … … 839 1145 840 1146 HstDisplay instproc acquire {} { 1147 my instvar controller config number 1148 my instvar cntr_val cntr_bak cntr_old yvec_bak yvec_old rate_val 1149 1150 set size 4096 1151 1152 set prefix [format {%x} [expr {$number + 2}]] 1153 1154 set value [format {%08x} [expr {$size * 2}]] 1155 1156 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 1157 1158 $controller usbCmdReadRaw $command [expr {$size * 4}] [myvar data] 1159 set yvec_new [usb::integrateBlt [myvar yvec]] 1160 1161 set prefix [format {%x} [expr {$number + 5}]] 1162 set command 0001${prefix}000000200000003000400050000 1163 1164 $controller usbCmdReadHex $command 8 1 [myvar cntr_val] 1165 set cntr_new $cntr_val 1166 1167 if {$cntr_new < $cntr_old} { 1168 set rate_val(inst) [expr {($yvec_new - $yvec_old)*20000000/($cntr_old - $cntr_new)}] 1169 set rate_val(mean) [expr {($yvec_new - $yvec_bak)*20000000/($cntr_bak - $cntr_new)}] 1170 set yvec_old $yvec_new 1171 set cntr_old $cntr_new 1172 } 1173 } 1174 1175 # ------------------------------------------------------------------------- 1176 1177 HstDisplay instproc save_data {data} { 841 1178 my instvar number 842 my usbCmdRead 0002001${number} 4 4096 843 } 844 845 # ------------------------------------------------------------------------- 846 847 HstDisplay instproc restart {} { 848 my instvar number 849 my usbCmd 0001001${number} 850 } 851 852 # ------------------------------------------------------------------------- 853 854 HstDisplay instproc save_data {data} { 855 set file [tk_getSaveFile] 856 if {[string equal $file {}]} { 1179 1180 set types { 1181 {{Data Files} {.dat} } 1182 {{All Files} * } 1183 } 1184 1185 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S] 1186 set fname spectrum_[expr {$number + 1}]_${stamp}.dat 1187 1188 set fname [tk_getSaveFile -filetypes $types -initialfile $fname] 1189 if {[string equal $fname {}]} { 857 1190 return 858 1191 } 859 1192 860 set x [catch {set fid [open $file w+]}] 861 set y [catch {puts $fid $data}] 862 set z [catch {close $fid}] 863 864 if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } { 1193 set x [catch { 1194 set fid [open $fname w+] 1195 puts $fid $data 1196 close $fid 1197 }] 1198 1199 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { 865 1200 tk_messageBox -icon error \ 866 -message "An error occurred while writing to \"$f ile\""1201 -message "An error occurred while writing to \"$fname\"" 867 1202 } else { 868 1203 tk_messageBox -icon info \ 869 -message "File \"$f ile\" written successfully"1204 -message "File \"$fname\" written successfully" 870 1205 } 871 1206 } … … 874 1209 875 1210 HstDisplay instproc register {} { 876 my save_data [my set data] 877 } 878 879 # ------------------------------------------------------------------------- 880 881 HstDisplay instproc acquire_loop {} { 882 my instvar number after_handle 883 884 my acquire 885 886 set after_handle [after 1000 [myproc acquire_loop]] 887 } 888 889 # ------------------------------------------------------------------------- 890 891 Class EptDisplay -superclass Display -parameter { 892 {number} 1211 my save_data [join [[myvar yvec] range 0 4095] \n] 1212 } 1213 1214 # ------------------------------------------------------------------------- 1215 1216 Class CntDisplay -parameter { 893 1217 {master} 894 } 895 896 # ------------------------------------------------------------------------- 897 898 EptDisplay instproc init {} { 899 my instvar data xvec yvec 900 901 set xvec [vector #auto] 902 903 for {set i 0} {$i < 11} {incr i} { 904 set yvec($i) [vector #auto] 905 } 906 907 # fill one vector for the x axis 908 $xvec seq 0 10000 909 910 my reset 1218 {controller} 1219 } 1220 1221 # ------------------------------------------------------------------------- 1222 1223 CntDisplay instproc init {} { 1224 1225 my set data {} 1226 my set cntr 0 1227 my set recs 0 1228 1229 vector create [myvar xvec](16384) 1230 vector create [myvar yvec](16384) 1231 1232 # fill one vector for the x axis with 16384 points 1233 [myvar xvec] seq -0.5 16384.5 911 1234 912 1235 my setup … … 917 1240 # ------------------------------------------------------------------------- 918 1241 919 EptDisplay instproc destroy {} {1242 CntDisplay instproc destroy {} { 920 1243 next 921 1244 } … … 923 1246 # ------------------------------------------------------------------------- 924 1247 925 EptDisplay instproc reset {} { 926 my instvar data xvec yvec 927 my instvar number_val directory 928 929 set data {} 930 931 set directory $::env(HOMEPATH) 932 set number_val 10 933 934 for {set i 0} {$i < 11} {incr i} { 935 $yvec($i) set {} 936 } 937 } 938 939 # ------------------------------------------------------------------------- 940 941 EptDisplay instproc start {} { 1248 CntDisplay instproc start {} { 942 1249 my instvar config 943 1250 944 trace add variable [myvar recs_val] write [myproc recs_val_update]945 1251 trace add variable [myvar data] write [myproc data_update] 946 trace add variable [myvar last] write [myproc data_update] 947 948 } 949 950 # ------------------------------------------------------------------------- 951 952 EptDisplay instproc setup {} { 1252 1253 trace add variable [myvar thrs_val] write [myproc thrs_val_update] 1254 1255 trace add variable [myvar cntr] write [myproc cntr_update] 1256 trace add variable [myvar recs] write [myproc recs_update] 1257 1258 trace add variable [myvar axis] write [myproc axis_update] 1259 1260 ${config}.axis_check select 1261 1262 my set thrs_val 100 1263 1264 my set cntr_val 100 1265 my set cntr_bak 100 1266 my set recs_val 100 1267 my set recs_bak 100 1268 1269 # my cntr_reset 1270 } 1271 1272 # ------------------------------------------------------------------------- 1273 1274 CntDisplay instproc setup {} { 953 1275 my instvar master 954 my instvar data xvec yvec graph 955 my instvar config number_val 1276 my instvar xvec yvec graph 1277 my instvar config 1278 my instvar cntr_ms 956 1279 957 1280 # create a graph widget and show a grid 958 set display [frame ${master}.display] 959 960 set graph(0) [graph ${display}.graph0 -height 200 -leftmargin 80] 961 $graph(0) crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 962 $graph(0) grid configure -hide no 963 $graph(0) legend configure -hide yes 964 $graph(0) axis configure x -min 0 -max 10000 965 $graph(0) axis configure y -min 0 -max 4100 966 967 set graph(1) [graph ${display}.graph1 -height 200 -leftmargin 80] 968 $graph(1) crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 969 $graph(1) grid configure -hide no 970 $graph(1) legend configure -hide yes 971 $graph(1) axis configure x -min 0 -max 10000 -hide yes 972 $graph(1) axis configure y -min 0 -max 4100 973 974 set graph(2) [graph ${display}.graph2 -height 200 -leftmargin 80] 975 $graph(2) crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 976 $graph(2) grid configure -hide no 977 $graph(2) legend configure -hide yes 978 $graph(2) axis configure x -min 0 -max 10000 -hide yes 979 $graph(2) axis configure y -min 0 -max 4100 980 981 set graph(3) [graph ${display}.graph3 -height 100 -leftmargin 80] 982 $graph(3) crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 983 $graph(3) grid configure -hide no 984 $graph(3) legend configure -hide yes 985 $graph(3) axis configure x -min 0 -max 10000 -hide yes 986 $graph(3) axis configure y -min 0 -max 25 987 988 scale ${master}.last -orient horizontal -from 1 -to 35 -tickinterval 0 -showvalue no -variable [myvar last] 989 990 set config [frame ${master}.config -width 120] 991 992 label ${config}.recs -text {number of records} 993 spinbox ${config}.recs_field -from 5 -to 100 \ 994 -increment 5 -width 10 -textvariable [myvar recs_val] \ 995 -validate all -vcmd {::mca::validate 100 %P} 996 997 frame ${config}.spc1 -width 10 -height 10 998 999 button ${config}.sequence -text {Start Recording} \ 1000 -bg red -activebackground red -command [myproc sequence] 1001 1002 frame ${config}.spc2 -width 10 -height 10 1003 1004 label ${config}.stat -text {} 1005 1006 frame ${config}.spc3 -width 10 -height 20 1007 1008 button ${config}.acquire -text Acquire \ 1009 -bg green -activebackground green -command [myproc acquire] 1281 set graph [graph ${master}.graph -height 250 -leftmargin 80] 1282 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} 1283 $graph grid configure -hide no 1284 $graph legend configure -hide yes 1285 $graph axis configure x -min 0 -max 16384 1286 1287 set config [frame ${master}.config -width 170] 1288 1289 checkbutton ${config}.axis_check -text {log scale} -variable [myvar axis] 1290 1291 frame ${config}.spc1 -width 170 -height 30 1292 1293 frame ${config}.chan_frame -borderwidth 0 -width 170 1294 legendLabel ${config}.chan_frame 0 mean {Mean value} 1295 legendLabel ${config}.chan_frame 1 entr {Total entries} 1296 legendLabel ${config}.chan_frame 2 empty {} 1297 legendLabel ${config}.chan_frame 3 axisy {Bin entries} 1298 legendLabel ${config}.chan_frame 4 axisx {Bin number} 1299 1300 frame ${config}.spc3 -width 170 -height 30 1301 1302 label ${config}.thrs -text {amplitude threshold} 1303 spinbox ${config}.thrs_field -from 1 -to 4095 \ 1304 -increment 5 -width 10 -textvariable [myvar thrs_val] \ 1305 -validate all -vcmd {::mca::validate 4095 4 %P} 1306 1307 frame ${config}.spc4 -width 170 -height 30 1308 1309 label ${config}.cntr -text {time of exposure (s)} 1310 spinbox ${config}.cntr_field -from 0 -to 9999 \ 1311 -increment 10 -width 10 -textvariable [myvar cntr_val] \ 1312 -validate all -vcmd {::mca::validate 9999 4 %P} 1313 1314 frame ${config}.spc5 -width 170 -height 10 1315 1316 label ${config}.recs -text {number of exposures} 1317 spinbox ${config}.recs_field -from 0 -to 99999 \ 1318 -increment 10 -width 10 -textvariable [myvar recs_val] \ 1319 -validate all -vcmd {::mca::validate 99999 5 %P} 1320 1321 frame ${config}.spc6 -width 170 -height 10 1322 1323 button ${config}.start -text {Start} \ 1324 -bg yellow -activebackground yellow -command [myproc recs_start] 1325 1326 button ${config}.reset -text Reset \ 1327 -bg red -activebackground red -command [myproc cntr_reset] 1328 1329 frame ${config}.spc7 -width 170 -height 30 1330 1010 1331 button ${config}.register -text Register \ 1011 1332 -bg lightblue -activebackground lightblue -command [myproc register] 1012 1333 1013 1334 grid ${config}.axis_check -sticky w 1335 grid ${config}.spc1 1336 grid ${config}.chan_frame -sticky ew -padx 5 1337 grid ${config}.spc3 1338 grid ${config}.thrs -sticky w -pady 1 -padx 3 1339 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 1340 grid ${config}.spc4 1341 grid ${config}.cntr -sticky w -pady 1 -padx 3 1342 grid ${config}.cntr_field -sticky ew -pady 1 -padx 5 1343 grid ${config}.spc5 1014 1344 grid ${config}.recs -sticky w -pady 1 -padx 3 1015 1345 grid ${config}.recs_field -sticky ew -pady 1 -padx 5 1346 grid ${config}.spc6 1347 grid ${config}.start -sticky ew -pady 3 -padx 5 1348 grid ${config}.reset -sticky ew -pady 3 -padx 5 1349 grid ${config}.spc7 1350 grid ${config}.register -sticky ew -pady 3 -padx 5 1351 1352 grid ${graph} -row 0 -column 0 -sticky news 1353 grid ${config} -row 0 -column 1 1354 1355 grid rowconfigure ${master} 0 -weight 1 1356 grid columnconfigure ${master} 0 -weight 1 1357 grid columnconfigure ${master} 1 -weight 0 -minsize 80 1358 1359 grid columnconfigure ${config}.chan_frame 1 -weight 1 1360 1361 # enable zooming 1362 Blt_ZoomStack $graph 1363 1364 my crosshairs $graph 1365 1366 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y} 1367 1368 # create one element with data for the x and y axis, no dots 1369 $graph element create Spectrum1 -color blue -linewidth 2 -symbol none -smooth step -xdata [myvar xvec] -ydata [myvar yvec] 1370 } 1371 1372 # ------------------------------------------------------------------------- 1373 1374 CntDisplay instproc coor_update {W x y} { 1375 my instvar config graph 1376 1377 $W crosshairs configure -position @${x},${y} 1378 1379 set index [$W axis invtransform x $x] 1380 set index [::tcl::mathfunc::round $index] 1381 catch { 1382 ${config}.chan_frame.axisy_value configure -text [[myvar yvec] index $index] 1383 ${config}.chan_frame.axisx_value configure -text ${index}.0 1384 } 1385 } 1386 # ------------------------------------------------------------------------- 1387 1388 CntDisplay instproc crosshairs {graph} { 1389 set method [myproc coor_update] 1390 bind $graph <Motion> [list [self] coor_update %W %x %y] 1391 bind $graph <Leave> { 1392 %W crosshairs off 1393 } 1394 bind $graph <Enter> { 1395 %W crosshairs on 1396 } 1397 } 1398 1399 # ------------------------------------------------------------------------- 1400 1401 CntDisplay instproc thrs_val_update args { 1402 my instvar controller config thrs_val 1403 1404 if {[string equal $thrs_val {}]} { 1405 set thrs_val 0 1406 } 1407 1408 set val_addr [format %02x 12] 1409 1410 ${config}.thrs_field configure -state normal 1411 set value [format %03x $thrs_val] 1412 1413 $controller usbCmd 000200${val_addr}00040${value} 1414 } 1415 1416 # ------------------------------------------------------------------------- 1417 1418 CntDisplay instproc cntr_update args { 1419 my instvar cntr cntr_val 1420 set cntr_val [expr {${cntr}/20000000}] 1421 1422 } 1423 1424 # ------------------------------------------------------------------------- 1425 1426 CntDisplay instproc recs_update args { 1427 my instvar recs recs_val 1428 set recs_val [expr {${recs}*1}] 1429 } 1430 1431 # ------------------------------------------------------------------------- 1432 1433 CntDisplay instproc cntr_setup {} { 1434 my instvar controller cntr_val 1435 1436 set cntr_tmp [expr {${cntr_val} * 20000000}] 1437 set word0 [format {%08x} [expr {${cntr_tmp} & 0xFFFFFFFF}]] 1438 set word1 [format {%08x} [expr {${cntr_tmp} >> 32}]] 1439 1440 set prefix [format {%x} 9] 1441 1442 set command {} 1443 append command 0001${prefix}000000200000004[string range $word0 4 7] 1444 append command 0001${prefix}000000200010004[string range $word0 0 3] 1445 append command 0001${prefix}000000200020004[string range $word1 4 7] 1446 append command 0001${prefix}000000200030004[string range $word1 0 3] 1447 1448 # send counter value 1449 $controller usbCmd $command 1450 } 1451 1452 # ------------------------------------------------------------------------- 1453 1454 CntDisplay instproc recs_setup {} { 1455 my instvar controller recs_val 1456 1457 set word0 [format {%08x} [expr {${recs_val} & 0xFFFFFFFF}]] 1458 set word1 [format {%08x} [expr {${recs_val} >> 32}]] 1459 1460 set prefix [format {%x} 10] 1461 1462 set command {} 1463 append command 0001${prefix}000000200000004[string range $word0 4 7] 1464 append command 0001${prefix}000000200010004[string range $word0 0 3] 1465 append command 0001${prefix}000000200020004[string range $word1 4 7] 1466 append command 0001${prefix}000000200030004[string range $word1 0 3] 1467 1468 # send counter value 1469 $controller usbCmd $command 1470 } 1471 1472 # ------------------------------------------------------------------------- 1473 1474 CntDisplay instproc cntr_reset {} { 1475 my instvar controller after_handle 1476 my instvar cntr_val cntr_bak recs_val recs_bak 1477 1478 my cntr_stop 1479 1480 set value [format {%04x} [expr {1 << 11}]] 1481 $controller usbCmd 000200000004${value}0002000000040000 1482 1483 my recs_stop 1484 } 1485 1486 # ------------------------------------------------------------------------- 1487 1488 CntDisplay instproc cntr_ready {} { 1489 my instvar config cntr_val cntr_bak recs_val recs_bak 1490 1491 set cntr_val $cntr_bak 1492 set recs_val $recs_bak 1493 1494 ${config}.start configure -text Start -command [myproc recs_start] 1495 ${config}.reset configure -state active 1496 1497 ${config}.start configure -state active 1498 ${config}.cntr_field configure -state normal 1499 ${config}.recs_field configure -state normal 1500 } 1501 1502 # ------------------------------------------------------------------------- 1503 1504 CntDisplay instproc recs_start {} { 1505 my instvar controller config auto 1506 my instvar cntr_val cntr_bak recs_val recs_bak 1507 1508 if {$cntr_val > 0 && $recs_val > 0} { 1509 ${config}.start configure -text {Stop} -command [myproc recs_stop] 1510 ${config}.cntr_field configure -state disabled 1511 ${config}.recs_field configure -state disabled 1512 1513 set cntr_bak $cntr_val 1514 set recs_bak $recs_val 1515 1516 my cntr_setup 1517 my recs_setup 1518 1519 set val_addr [format {%02x} 16] 1520 1521 $controller usbCmd 000200${val_addr}00040002 1522 1523 set auto 1 1524 1525 after 100 [myproc acquire_loop] 1526 } 1527 } 1528 1529 # ------------------------------------------------------------------------- 1530 1531 CntDisplay instproc recs_stop {} { 1532 my instvar cntr_val cntr_bak recs_val recs_bak 1533 1534 my cntr_stop 1535 1536 set cntr_val $cntr_bak 1537 my cntr_setup 1538 1539 set recs_val $recs_bak 1540 my recs_setup 1541 1542 my acquire 1543 1544 my cntr_ready 1545 } 1546 1547 # ------------------------------------------------------------------------- 1548 1549 CntDisplay instproc cntr_stop {} { 1550 my instvar controller config auto 1551 1552 set val_addr [format {%02x} 16] 1553 1554 $controller usbCmd 000200${val_addr}00040000 1555 1556 set auto 0 1557 } 1558 1559 # ------------------------------------------------------------------------- 1560 1561 CntDisplay instproc acquire_loop {} { 1562 my instvar recs_val auto 1563 1564 my acquire 1565 1566 if {$recs_val == 0} { 1567 my cntr_stop 1568 my cntr_ready 1569 } elseif {$auto} { 1570 after 1000 [myproc acquire_loop] 1571 } 1572 } 1573 1574 # ------------------------------------------------------------------------- 1575 1576 CntDisplay instproc data_update args { 1577 my instvar config data 1578 usb::convertBlt $data 2 [myvar yvec] 1579 1580 ${config}.chan_frame.mean_value configure \ 1581 -text [format {%.2e} [usb::integrateBlt [myvar yvec] 1]] 1582 ${config}.chan_frame.entr_value configure \ 1583 -text [usb::integrateBlt [myvar yvec] 0] 1584 1585 } 1586 1587 # ------------------------------------------------------------------------- 1588 1589 CntDisplay instproc axis_update args { 1590 my instvar axis graph 1591 if {$axis} { 1592 $graph axis configure y -min 1 -max 1E5 -logscale yes 1593 } else { 1594 $graph axis configure y -min {} -max {} -logscale no 1595 } 1596 } 1597 1598 # ------------------------------------------------------------------------- 1599 1600 CntDisplay instproc acquire {} { 1601 my instvar controller config 1602 my instvar cntr cntr_val recs recs_val 1603 1604 set size 16384 1605 1606 set prefix [format {%x} 8] 1607 1608 set value [format {%08x} $size] 1609 1610 set command 0001${prefix}000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 1611 1612 $controller usbCmdReadRaw $command [expr {$size * 2}] [myvar data] 1613 1614 set prefix [format {%x} 9] 1615 set command 0001${prefix}000000200000003000400050000 1616 1617 $controller usbCmdReadHex $command 8 1 [myvar cntr] 1618 1619 set prefix [format {%x} 10] 1620 set command 0001${prefix}000000200000003000400050000 1621 1622 $controller usbCmdReadHex $command 8 1 [myvar recs] 1623 } 1624 1625 # ------------------------------------------------------------------------- 1626 1627 CntDisplay instproc save_data {data} { 1628 1629 set types { 1630 {{Data Files} {.dat} } 1631 {{All Files} * } 1632 } 1633 1634 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S] 1635 set fname counts_${stamp}.dat 1636 1637 set fname [tk_getSaveFile -filetypes $types -initialfile $fname] 1638 if {[string equal $fname {}]} { 1639 return 1640 } 1641 1642 set x [catch { 1643 set fid [open $fname w+] 1644 puts $fid $data 1645 close $fid 1646 }] 1647 1648 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { 1649 tk_messageBox -icon error \ 1650 -message "An error occurred while writing to \"$fname\"" 1651 } else { 1652 tk_messageBox -icon info \ 1653 -message "File \"$fname\" written successfully" 1654 } 1655 } 1656 1657 # ------------------------------------------------------------------------- 1658 1659 CntDisplay instproc register {} { 1660 my save_data [join [[myvar yvec] range 0 16383] \n] 1661 } 1662 1663 # ------------------------------------------------------------------------- 1664 1665 Class OscDisplay -parameter { 1666 {master} 1667 {controller} 1668 } 1669 1670 # ------------------------------------------------------------------------- 1671 1672 OscDisplay instproc init {} { 1673 my instvar sequence data xvec yvec 1674 1675 set data {} 1676 1677 set sequence 0 1678 1679 # set xvec [vector create #auto(262144)] 1680 set xvec [vector create #auto(10000)] 1681 1682 for {set i 1} {$i <= 9} {incr i} { 1683 # dict set yvec $i [vector create #auto(262144)] 1684 dict set yvec $i [vector create #auto(10000)] 1685 } 1686 1687 # fill one vector for the x axis 1688 # $xvec seq 0 262143 1689 $xvec seq 0 10000 1690 1691 my setup 1692 1693 next 1694 } 1695 1696 # ------------------------------------------------------------------------- 1697 1698 OscDisplay instproc destroy {} { 1699 next 1700 } 1701 1702 # ------------------------------------------------------------------------- 1703 1704 OscDisplay instproc start {} { 1705 my instvar config 1706 my instvar recs_val directory 1707 1708 set directory $::env(HOMEPATH) 1709 set recs_val 100 1710 1711 trace add variable [myvar chan] write [myproc chan_update] 1712 1713 trace add variable [myvar data] write [myproc data_update] 1714 1715 trace add variable [myvar auto] write [myproc auto_update] 1716 1717 trace add variable [myvar thrs] write [myproc thrs_update 0] 1718 trace add variable [myvar thrs_val] write [myproc thrs_update 0] 1719 1720 trace add variable [myvar recs_val] write [myproc recs_val_update] 1721 1722 trace add variable [myvar last] write [myproc last_update] 1723 1724 ${config}.chan_frame.chan1_check select 1725 ${config}.chan_frame.chan2_check select 1726 ${config}.chan_frame.chan3_check select 1727 ${config}.chan_frame.chan4_check select 1728 ${config}.chan_frame.chan5_check select 1729 ${config}.chan_frame.chan6_check select 1730 1731 ${config}.thrs_check select 1732 ${config}.thrs_field set 100 1733 } 1734 1735 # ------------------------------------------------------------------------- 1736 1737 OscDisplay instproc setup {} { 1738 my instvar master 1739 my instvar xvec yvec graph 1740 my instvar config 1741 1742 # create a graph widget and show a grid 1743 set graph [graph ${master}.graph -height 250 -leftmargin 80] 1744 $graph crosshairs configure -hide no -linewidth 1 -color darkblue -dashes {2 2} 1745 $graph grid configure -hide no 1746 $graph legend configure -hide yes 1747 $graph axis configure x -min 0 -max 10000 1748 $graph axis configure y -min 0 -max 4100 1749 1750 # scale ${master}.last -orient horizontal -from 1 -to 27 -tickinterval 0 -showvalue no -variable [myvar last] 1751 1752 set config [frame ${master}.config -width 170] 1753 1754 frame ${config}.chan_frame -width 170 1755 legendButton ${config}.chan_frame 0 chan1 {Channel 1} [myvar chan(1)] turquoise2 1756 legendButton ${config}.chan_frame 1 chan2 {Channel 2} [myvar chan(2)] SpringGreen2 1757 legendButton ${config}.chan_frame 2 chan3 {Channel 3} [myvar chan(3)] orchid2 1758 legendButton ${config}.chan_frame 3 chan4 {Channel 4} [myvar chan(4)] orange2 1759 legendButton ${config}.chan_frame 4 chan5 {Channel 5} [myvar chan(5)] blue1 white 1760 legendButton ${config}.chan_frame 5 chan6 {Channel 6} [myvar chan(6)] gray65 white 1761 legendLabel ${config}.chan_frame 6 axisx {Time axis} 1762 1763 frame ${config}.spc1 -width 170 -height 30 1764 1765 checkbutton ${config}.auto_check -text {auto update} -variable [myvar auto] 1766 1767 frame ${config}.spc2 -width 170 -height 30 1768 1769 checkbutton ${config}.thrs_check -text threshold -variable [myvar thrs] 1770 spinbox ${config}.thrs_field -from 1 -to 4095 \ 1771 -increment 5 -width 10 -textvariable [myvar thrs_val] \ 1772 -validate all -vcmd {::mca::validate 4095 4 %P} 1773 1774 frame ${config}.spc3 -width 170 -height 30 1775 1776 button ${config}.acquire -text Acquire \ 1777 -bg green -activebackground green -command [myproc acquire_start] 1778 button ${config}.register -text Register \ 1779 -bg lightblue -activebackground lightblue -command [myproc register] 1780 1781 frame ${config}.spc4 -width 170 -height 30 1782 1783 label ${config}.recs -text {number of records} 1784 spinbox ${config}.recs_field -from 0 -to 10000 \ 1785 -increment 10 -width 10 -textvariable [myvar recs_val] \ 1786 -validate all -vcmd {::mca::validate 10000 5 %P} 1787 1788 frame ${config}.spc5 -width 170 -height 10 1789 1790 button ${config}.sequence -text {Start Recording} -command [myproc sequence_start] \ 1791 -bg yellow -activebackground yellow 1792 1793 frame ${config}.spc6 -width 170 -height 10 1794 1795 button ${config}.recover -text {Read file} \ 1796 -bg lightblue -activebackground lightblue -command [myproc recover] 1797 1798 grid ${config}.chan_frame -sticky ew 1016 1799 grid ${config}.spc1 1017 grid ${config}. sequence -sticky ew -pady 3 -padx 51800 grid ${config}.auto_check -sticky w 1018 1801 grid ${config}.spc2 1019 grid ${config}.stat -sticky w -pady 1 -padx 3 1802 grid ${config}.thrs_check -sticky w 1803 grid ${config}.thrs_field -sticky ew -pady 1 -padx 5 1020 1804 grid ${config}.spc3 1021 1805 grid ${config}.acquire -sticky ew -pady 3 -padx 5 1022 1806 grid ${config}.register -sticky ew -pady 3 -padx 5 1023 1024 grid ${graph(3)} -row 0 -column 0 -sticky news 1025 grid ${graph(2)} -row 1 -column 0 -sticky news 1026 grid ${graph(1)} -row 2 -column 0 -sticky news 1027 grid ${graph(0)} -row 3 -column 0 -sticky news 1028 1029 grid ${display} -row 0 -column 0 -sticky news 1807 grid ${config}.spc4 1808 grid ${config}.recs -sticky w -pady 1 -padx 3 1809 grid ${config}.recs_field -sticky ew -pady 1 -padx 5 1810 grid ${config}.spc5 1811 grid ${config}.sequence -sticky ew -pady 3 -padx 5 1812 grid ${config}.spc6 1813 grid ${config}.recover -sticky ew -pady 3 -padx 5 1814 1815 grid ${graph} -row 0 -column 0 -sticky news 1030 1816 grid ${config} -row 0 -column 1 1031 1817 1032 grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew1818 # grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew 1033 1819 1034 1820 grid rowconfigure ${master} 0 -weight 1 … … 1036 1822 grid columnconfigure ${master} 1 -weight 0 -minsize 120 1037 1823 1038 grid columnconfigure ${display} 0 -weight 1 1039 grid rowconfigure ${display} 0 -weight 1 1040 grid rowconfigure ${display} 1 -weight 1 1041 grid rowconfigure ${display} 2 -weight 1 1042 grid rowconfigure ${display} 3 -weight 1 1824 grid columnconfigure ${config}.chan_frame 2 -weight 1 1043 1825 1044 1826 # enable zooming 1045 Blt_ZoomStack $graph(0) 1046 Blt_ZoomStack $graph(1) 1047 Blt_ZoomStack $graph(2) 1048 Blt_ZoomStack $graph(3) 1049 1050 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y} 1827 Blt_ZoomStack $graph 1828 1829 my crosshairs $graph 1051 1830 1052 1831 # create one element with data for the x and y axis, no dots 1053 $graph(0) element create Spectrum0 -symbol none -xdata $xvec -ydata $yvec(0) 1054 $graph(1) element create Spectrum1 -symbol none -xdata $xvec -ydata $yvec(1) 1055 $graph(2) element create Spectrum2 -symbol none -xdata $xvec -ydata $yvec(2) 1056 for {set i 3} {$i < 11} {incr i} { 1057 $graph(3) element create Spectrum$i -symbol none -xdata $xvec -ydata $yvec($i) 1058 } 1059 } 1060 1061 # ------------------------------------------------------------------------- 1062 1063 EptDisplay instproc recs_val_update args { 1832 $graph pen create pen1 -color turquoise3 -linewidth 2 -symbol none 1833 $graph pen create pen2 -color SpringGreen3 -linewidth 2 -symbol none 1834 $graph pen create pen3 -color orchid3 -linewidth 2 -symbol none 1835 $graph pen create pen4 -color orange3 -linewidth 2 -symbol none 1836 $graph pen create pen5 -color blue2 -linewidth 2 -symbol none 1837 $graph pen create pen6 -color gray55 -linewidth 2 -symbol none 1838 1839 $graph element create Spectrum1 -pen pen1 -xdata $xvec -ydata [dict get $yvec 1] 1840 $graph element create Spectrum2 -pen pen2 -xdata $xvec -ydata [dict get $yvec 2] 1841 $graph element create Spectrum3 -pen pen3 -xdata $xvec -ydata [dict get $yvec 3] 1842 $graph element create Spectrum4 -pen pen4 -xdata $xvec -ydata [dict get $yvec 4] 1843 $graph element create Spectrum5 -pen pen5 -xdata $xvec -ydata [dict get $yvec 5] 1844 $graph element create Spectrum6 -pen pen6 -xdata $xvec -ydata [dict get $yvec 6] 1845 } 1846 1847 # ------------------------------------------------------------------------- 1848 1849 OscDisplay instproc coor_update {W x y} { 1850 my instvar xvec yvec graph 1851 my instvar config 1852 1853 $W crosshairs configure -position @${x},${y} 1854 1855 set index [$W axis invtransform x $x] 1856 set index [::tcl::mathfunc::round $index] 1857 catch { 1858 ${config}.chan_frame.chan1_value configure -text [[dict get $yvec 1] index $index] 1859 ${config}.chan_frame.chan2_value configure -text [[dict get $yvec 2] index $index] 1860 ${config}.chan_frame.chan3_value configure -text [[dict get $yvec 3] index $index] 1861 ${config}.chan_frame.chan4_value configure -text [[dict get $yvec 4] index $index] 1862 ${config}.chan_frame.chan5_value configure -text [[dict get $yvec 5] index $index] 1863 ${config}.chan_frame.chan6_value configure -text [[dict get $yvec 6] index $index] 1864 ${config}.chan_frame.axisx_value configure -text ${index}.0 1865 } 1866 } 1867 # ------------------------------------------------------------------------- 1868 1869 OscDisplay instproc crosshairs {graph} { 1870 set method [myproc coor_update] 1871 bind $graph <Motion> [list [self] coor_update %W %x %y] 1872 bind $graph <Leave> { 1873 %W crosshairs off 1874 } 1875 bind $graph <Enter> { 1876 %W crosshairs on 1877 } 1878 } 1879 1880 # ------------------------------------------------------------------------- 1881 1882 OscDisplay instproc chan_update {name key op} { 1883 my instvar config graph chan 1884 1885 if {$chan(${key})} { 1886 $graph pen configure pen${key} -linewidth 2 1887 } else { 1888 $graph pen configure pen${key} -linewidth 0 1889 } 1890 } 1891 1892 # ------------------------------------------------------------------------- 1893 1894 OscDisplay instproc recs_val_update args { 1064 1895 my instvar recs_val 1065 1896 if {[string equal $recs_val {}]} { 1066 set number_val 01067 } 1068 } 1069 1070 # ------------------------------------------------------------------------- 1071 1072 EptDisplay instproc data_update args {1073 my instvar data xvec yvecgraph last1897 set recs_val 0 1898 } 1899 } 1900 1901 # ------------------------------------------------------------------------- 1902 1903 OscDisplay instproc last_update args { 1904 my instvar graph last 1074 1905 1075 1906 set first [expr {$last - 1}] 1907 1908 $graph axis configure x -min ${first}0000 -max ${last}0000 1909 } 1910 1911 # ------------------------------------------------------------------------- 1912 1913 OscDisplay instproc thrs_update {reset args} { 1914 my instvar controller config thrs thrs_val 1915 1916 if {[string equal $thrs_val {}]} { 1917 set thrs_val 0 1918 } 1919 1920 if {$thrs} { 1921 ${config}.thrs_field configure -state normal 1922 set value [format %03x $thrs_val] 1923 } else { 1924 ${config}.thrs_field configure -state disabled 1925 set value 000 1926 } 1927 1928 set command {} 1929 if {$reset} { 1930 append command 0002000500041${value} 1931 } 1932 append command 0002000500040${value} 1933 1934 $controller usbCmd $command 1935 } 1936 1937 # ------------------------------------------------------------------------- 1938 1939 OscDisplay instproc data_update args { 1940 my instvar data yvec 1941 my instvar graph chan waiting sequence auto 1942 1943 usb::convertOsc $data $yvec 1944 1945 foreach {key value} [array get chan] { 1946 $graph pen configure pen${key} -dashes 0 1947 } 1948 1949 set waiting 0 1950 1951 if {$sequence} { 1952 my sequence_register 1953 } elseif {$auto} { 1954 after 1000 [myproc acquire_start] 1955 } 1956 } 1957 1958 # ------------------------------------------------------------------------- 1959 1960 OscDisplay instproc acquire_start {} { 1961 my instvar graph chan controller waiting 1962 1963 foreach {key value} [array get chan] { 1964 $graph pen configure pen${key} -dashes dot 1965 } 1966 1967 # restart 1968 my thrs_update 1 1969 1970 set waiting 1 1971 1972 after 200 [myproc acquire_loop] 1973 } 1974 1975 # ------------------------------------------------------------------------- 1976 1977 OscDisplay instproc acquire_loop {} { 1978 my instvar controller waiting 1979 1980 # set size 262144 1981 set size 10000 1982 1983 set value [format {%08x} [expr {$size * 4}]] 1984 1985 set command 00011000000200000001[string range $value 0 3]0003[string range $value 4 7]00050000 1076 1986 1077 $xvec seq ${first}0000 ${last}0000 1078 for {set i 0} {$i < 4} {incr i} { 1079 $graph($i) axis configure x -min ${first}0000 -max ${last}0000 1080 } 1081 1082 for {set i 0} {$i < 11} {incr i} { 1083 $yvec($i) set [lrange [lindex $data $i] ${first}0000 ${last}0000] 1084 } 1085 } 1086 1087 1088 # ------------------------------------------------------------------------- 1089 1090 EptDisplay instproc save_data {data} { 1091 set file [tk_getSaveFile] 1092 if {[string equal $file {}]} { 1987 $controller usbCmdReadRaw $command [expr {$size * 8}] [myvar data] 1988 1989 if {$waiting} { 1990 after 200 [myproc acquire_loop] 1991 } 1992 } 1993 1994 # ------------------------------------------------------------------------- 1995 1996 OscDisplay instproc auto_update args { 1997 my instvar config auto 1998 1999 if {$auto} { 2000 ${config}.recs_field configure -state disabled 2001 ${config}.sequence configure -state disabled 2002 ${config}.acquire configure -state disabled 2003 ${config}.register configure -state disabled 2004 ${config}.recover configure -state disabled 2005 2006 my acquire_start 2007 } else { 2008 ${config}.recs_field configure -state normal 2009 ${config}.sequence configure -state active 2010 ${config}.acquire configure -state active 2011 ${config}.register configure -state active 2012 ${config}.recover configure -state active 2013 } 2014 } 2015 2016 # ------------------------------------------------------------------------- 2017 2018 OscDisplay instproc save_data {fname} { 2019 my instvar data 2020 2021 set fid [open $fname w+] 2022 fconfigure $fid -translation binary -encoding binary 2023 2024 # puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"] 2025 # puts -nonewline $fid [zlib deflate $data] 2026 puts -nonewline $fid $data 2027 # puts -nonewline $fid [binary format i [zlib crc32 $data]] 2028 # puts -nonewline $fid [binary format i [string length $data]] 2029 2030 close $fid 2031 } 2032 2033 # ------------------------------------------------------------------------- 2034 2035 OscDisplay instproc open_data {} { 2036 set types { 2037 {{Data Files} {.dat} } 2038 {{All Files} * } 2039 } 2040 2041 set fname [tk_getOpenFile -filetypes $types] 2042 if {[string equal $fname {}]} { 1093 2043 return 1094 2044 } 1095 2045 1096 set x [catch {set fid [open $file w+]}] 1097 set y [catch {puts $fid $data}] 1098 set z [catch {close $fid}] 1099 1100 if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } { 2046 set x [catch { 2047 set fid [open $fname r+] 2048 fconfigure $fid -translation binary -encoding binary 2049 # set size [file size $fname] 2050 # seek $fid 10 2051 # my set data [zlib inflate [read $fid [expr {$size - 18}]]] 2052 my set data [read $fid] 2053 close $fid 2054 }] 2055 2056 if { $x || ![file exists $fname] || ![file isfile $fname] || ![file readable $fname] } { 1101 2057 tk_messageBox -icon error \ 1102 -message "An error occurred while writing to \"$file\""2058 -message "An error occurred while reading \"$fname\"" 1103 2059 } else { 1104 2060 tk_messageBox -icon info \ 1105 -message "File \"$file\" written successfully" 1106 } 1107 } 1108 1109 # ------------------------------------------------------------------------- 1110 1111 EptDisplay instproc acquire {} { 1112 my usbCmdReadEpt 00060000 2097152 1113 } 1114 1115 # ------------------------------------------------------------------------- 1116 1117 EptDisplay instproc register {} { 1118 my save_data [my set data] 1119 } 1120 1121 # ------------------------------------------------------------------------- 1122 1123 EptDisplay instproc sequence {} { 1124 my instvar config recs_val directory counter 2061 -message "File \"$fname\" read successfully" 2062 } 2063 } 2064 2065 # ------------------------------------------------------------------------- 2066 2067 OscDisplay instproc register {} { 2068 set types { 2069 {{Data Files} {.dat} } 2070 {{All Files} * } 2071 } 2072 2073 set stamp [clock format [clock seconds] -format %Y%m%d_%H%M%S] 2074 set fname oscillogram_${stamp}.dat 2075 2076 set fname [tk_getSaveFile -filetypes $types -initialfile $fname] 2077 if {[string equal $fname {}]} { 2078 return 2079 } 2080 2081 if {[catch {my save_data $fname} result]} { 2082 tk_messageBox -icon error \ 2083 -message "An error occurred while writing to \"$fname\"" 2084 } else { 2085 tk_messageBox -icon info \ 2086 -message "File \"$fname\" written successfully" 2087 } 2088 } 2089 2090 # ------------------------------------------------------------------------- 2091 2092 OscDisplay instproc recover {} { 2093 my open_data 2094 } 2095 2096 # ------------------------------------------------------------------------- 2097 2098 OscDisplay instproc sequence_start {} { 2099 my instvar config recs_val recs_bak directory counter sequence 2100 2101 set counter 1 2102 if {$counter > $recs_val} { 2103 return 2104 } 1125 2105 1126 2106 set directory [tk_chooseDirectory -initialdir $directory -title {Choose a directory}] … … 1131 2111 1132 2112 ${config}.recs_field configure -state disabled 1133 ${config}.sequence configure - state disabled2113 ${config}.sequence configure -text {Stop Recording} -command [myproc sequence_stop] 1134 2114 ${config}.acquire configure -state disabled 1135 2115 ${config}.register configure -state disabled 2116 ${config}.recover configure -state disabled 1136 2117 1137 set counter 1 2118 set recs_bak $recs_val 2119 2120 set sequence 1 2121 2122 my acquire_start 2123 } 2124 2125 # ------------------------------------------------------------------------- 2126 2127 OscDisplay instproc sequence_register {} { 2128 my instvar config recs_val recs_bak directory counter 2129 2130 set fname [file join $directory oscillogram_$counter.dat] 2131 2132 my incr counter 2133 2134 if {[catch {my save_data $fname} result]} { 2135 tk_messageBox -icon error \ 2136 -message "An error occurred while writing to \"$fname\"" 2137 } elseif {$counter <= $recs_bak} { 2138 set recs_val [expr {$recs_bak - $counter}] 2139 my acquire_start 2140 return 2141 } 1138 2142 1139 if {$counter <= $recs_val} { 1140 ${config}.stat configure -text "record $counter of $recs_val" 1141 set after_handle [after 100 [myproc acquire_register_loop]] 1142 } 1143 } 1144 1145 # ------------------------------------------------------------------------- 1146 1147 EptDisplay instproc acquire_register_loop {} { 1148 my instvar after_handle 1149 my instvar config data recs_val directory counter 1150 1151 my acquire 1152 1153 set file [file join $directory ept_$counter.dat.gz] 1154 1155 set x [catch {set fid [open $file w+]}] 1156 fconfigure $fid -translation binary -encoding binary 1157 1158 set y [catch { 1159 puts -nonewline $fid [binary format "H*iH*" "1f8b0800" [clock seconds] "0003"] 1160 puts -nonewline $fid [zlib deflate $data] 1161 puts -nonewline $fid [binary format i [zlib crc32 $data]] 1162 puts -nonewline $fid [binary format i [string length $data]] 1163 }] 1164 1165 set z [catch {close $fid}] 1166 1167 my incr counter 1168 1169 if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } { 1170 tk_messageBox -icon error -message "An error occurred while writing to \"$file\"" 1171 } elseif {$counter <= $recs_val} { 1172 ${config}.stat configure -text "record $counter of $recs_val" 1173 set after_handle [after 100 [myproc acquire_register_loop]] 1174 return 1175 } 2143 my sequence_stop 2144 } 2145 2146 # ------------------------------------------------------------------------- 2147 2148 OscDisplay instproc sequence_stop {} { 2149 my instvar config recs_val recs_bak sequence 2150 2151 set sequence 0 1176 2152 1177 ${config}.stat configure -text {} 2153 set recs_val $recs_bak 2154 1178 2155 ${config}.recs_field configure -state normal 1179 ${config}.sequence configure - state active2156 ${config}.sequence configure -text {Start Recording} -command [myproc sequence_start] 1180 2157 ${config}.acquire configure -state active 1181 2158 ${config}.register configure -state active 1182 1183 } 1184 1185 # ------------------------------------------------------------------------- 1186 1187 Class MemDisplay -superclass Display -parameter { 1188 {number} 1189 {master} 1190 } 1191 1192 # ------------------------------------------------------------------------- 1193 1194 MemDisplay instproc init {} { 1195 my instvar data xvec yvec 1196 1197 set xvec [vector #auto] 1198 set yvec [vector #auto] 1199 1200 # fill one vector for the x axis 1201 $xvec seq 0 10000 1202 1203 my reset 1204 1205 my setup 1206 1207 next 1208 } 1209 1210 # ------------------------------------------------------------------------- 1211 1212 MemDisplay instproc destroy {} { 1213 next 1214 } 1215 1216 # ------------------------------------------------------------------------- 1217 1218 MemDisplay instproc reset {} { 1219 my instvar data xvec yvec 1220 1221 set data {} 1222 1223 $yvec set {} 1224 } 1225 1226 # ------------------------------------------------------------------------- 1227 1228 MemDisplay instproc start {} { 1229 my instvar config 1230 1231 trace add variable [myvar data] write [myproc data_update] 1232 trace add variable [myvar last] write [myproc data_update] 1233 } 1234 1235 # ------------------------------------------------------------------------- 1236 1237 MemDisplay instproc setup {} { 1238 my instvar master 1239 my instvar data xvec yvec 1240 my instvar config auto thrs thrs_val disp_val trig_val 1241 1242 # create a graph widget and show a grid 1243 set graph [graph ${master}.graph -height 250 -leftmargin 80] 1244 $graph crosshairs configure -hide no -linewidth 2 -dashes { 1 1 } 1245 $graph grid configure -hide no 1246 $graph legend configure -hide yes 1247 $graph axis configure x -min 0 -max 10000 1248 # $graph axis configure y -min 0 -max 4100 1249 1250 scale ${master}.last -orient horizontal -from 1 -to 105 -tickinterval 0 -variable [myvar last] 1251 1252 set config [frame ${master}.config] 1253 1254 button ${config}.acquire -text Acquire \ 1255 -bg green -activebackground green -command [myproc acquire] 1256 button ${config}.register -text Register \ 1257 -bg lightblue -activebackground lightblue -command [myproc register] 1258 1259 grid ${config}.acquire -sticky ew -pady 3 -padx 5 1260 grid ${config}.register -sticky ew -pady 3 -padx 5 1261 1262 grid ${graph} -row 0 -column 0 -sticky news 1263 grid ${config} -row 0 -column 1 1264 1265 grid ${master}.last -row 1 -column 0 -columnspan 2 -sticky ew 1266 1267 grid rowconfigure ${master} 0 -weight 1 1268 grid columnconfigure ${master} 0 -weight 1 1269 grid columnconfigure ${master} 1 -weight 0 -minsize 80 1270 1271 # enable zooming 1272 Blt_ZoomStack $graph 1273 1274 #bind .graph <Motion> {%W crosshairs configure -position @%x,%y} 1275 1276 # create one element with data for the x and y axis, no dots 1277 $graph element create Spectrum -symbol none -xdata $xvec -ydata $yvec 1278 } 1279 1280 # ------------------------------------------------------------------------- 1281 1282 MemDisplay instproc data_update args { 1283 my instvar data yvec last 1284 1285 set first [expr {$last - 1}] 1286 $yvec set [lrange $data ${first}0000 ${last}0000] 1287 } 1288 1289 # ------------------------------------------------------------------------- 1290 1291 MemDisplay instproc save_data {data} { 1292 set file [tk_getSaveFile] 1293 if {[string equal $file {}]} { 1294 return 1295 } 1296 1297 set x [catch {set fid [open $file w+]}] 1298 set y [catch {puts $fid $data}] 1299 set z [catch {close $fid}] 1300 1301 if { $x || $y || $z || ![file exists $file] || ![file isfile $file] || ![file readable $file] } { 1302 tk_messageBox -icon error \ 1303 -message "An error occurred while writing to \"$file\"" 1304 } else { 1305 tk_messageBox -icon info \ 1306 -message "File \"$file\" written successfully" 1307 } 1308 } 1309 1310 # ------------------------------------------------------------------------- 1311 1312 MemDisplay instproc acquire {} { 1313 my usbCmdRead 00040000 1 524288 1314 # my usbCmdRead 00060000 1 1048576 1315 } 1316 1317 # ------------------------------------------------------------------------- 1318 1319 MemDisplay instproc register {} { 1320 my save_data [my set data] 1321 } 1322 1323 # ------------------------------------------------------------------------- 1324 1325 namespace export MemDisplay 1326 namespace export EptDisplay 2159 ${config}.recover configure -state active 2160 } 2161 2162 # ------------------------------------------------------------------------- 2163 2164 namespace export MuxDisplay 1327 2165 namespace export HstDisplay 2166 namespace export CntDisplay 1328 2167 namespace export OscDisplay 1329 namespace export CfgDisplay1330 2168 } 1331 2169 1332 set config [frame .config]1333 2170 set notebook [::blt::tabnotebook .notebook -borderwidth 1 -selectforeground black -side bottom] 1334 2171 1335 grid ${config} -row 0 -column 0 -sticky ns -padx 3 1336 grid ${notebook} -row 0 -column 1 -sticky news -pady 5 2172 grid ${notebook} -row 0 -column 0 -sticky news -pady 5 1337 2173 1338 2174 grid rowconfigure . 0 -weight 1 1339 grid columnconfigure . 0 -weight 0 -minsize 50 1340 grid columnconfigure . 1 -weight 1 1341 1342 foreach i {0 1 2} { 1343 set channel [expr $i + 1] 1344 1345 set window [frame ${notebook}.hst_$i] 1346 $notebook insert end -text "Histogram $channel" -window $window -fill both 1347 ::mca::HstDisplay hst_$i -number $i -master $window 1348 1349 set window [frame ${notebook}.osc_$i] 1350 $notebook insert end -text "Pulse shape $channel" -window $window -fill both 1351 ::mca::OscDisplay osc_$i -number $i -master $window 1352 } 1353 1354 #set window [frame ${notebook}.cfg] 1355 #$notebook insert end -text "Configuration" -window $window -fill both 1356 ::mca::CfgDisplay cfg -master $config 2175 grid columnconfigure . 0 -weight 1 2176 2177 ::mca::UsbController usb 2178 usb usbCmd 00000000 2179 2180 set window [frame ${notebook}.spi] 2181 $notebook insert end -text "DAC & ADC control" -window $window -fill both 2182 ::mca::SpiDisplay spi -master $window -controller usb 2183 2184 set window [frame ${notebook}.mux] 2185 $notebook insert end -text "Interconnect" -window $window -fill both 2186 ::mca::MuxDisplay mux -master $window -controller usb 1357 2187 1358 2188 set window [frame ${notebook}.ept] 1359 $notebook insert end -text "EPT" -window $window -fill both 1360 ::mca::EptDisplay ept -master $window 1361 1362 #set window [frame ${notebook}.mem] 1363 #$notebook insert end -text "Memory test" -window $window -fill both 1364 #::mca::MemDisplay mem -master $window 1365 1366 set usb_handle {} 1367 1368 while {[catch {usb::connect 0x09FB 0x6001 1 1 0} usb_handle]} { 1369 set answer [tk_messageBox -icon error -type retrycancel \ 1370 -message {Cannot access USB device} -detail $usb_handle] 1371 if {[string equal $answer cancel]} break 1372 } 1373 1374 # cfg reset 1375 cfg reset 1376 1377 cfg start 1378 1379 foreach i {0 1 2} { 1380 hst_$i start 1381 osc_$i start 1382 1383 hst_$i restart 1384 osc_$i restart 1385 } 1386 1387 ept start 1388 #mem start 2189 $notebook insert end -text "Oscilloscope" -window $window -fill both 2190 ::mca::OscDisplay osc -master $window -controller usb 2191 2192 update 2193 2194 spi start 2195 2196 mux start 2197 2198 osc start 2199 2200 spi adc_reset
Note:
See TracChangeset
for help on using the changeset viewer.