File Coverage

blib/lib/Lab/Instrument/TDS2024B.pm
Criterion Covered Total %
statement 32 2349 1.3
branch 0 1166 0.0
condition 0 451 0.0
subroutine 11 216 5.0
pod 192 192 100.0
total 235 4374 5.3


line stmt bran cond sub pod time code
1             package Lab::Instrument::TDS2024B;
2             #ABSTRACT: Tektronix TDS2024B digital oscilloscope
3             $Lab::Instrument::TDS2024B::VERSION = '3.880';
4 2     2   2412 use v5.20;
  2         8  
5              
6 2     2   11 use strict;
  2         5  
  2         42  
7 2     2   13 use warnings;
  2         6  
  2         79  
8 2     2   633 use Lab::Instrument;
  2         5  
  2         121  
9 2     2   10 use Lab::SCPI;
  2         5  
  2         150  
10 2     2   12 use Carp;
  2         4  
  2         103  
11 2     2   22 use English;
  2         5  
  2         28  
12 2     2   915 use Time::HiRes qw(sleep);
  2         11  
  2         23  
13 2     2   176 use Clone 'clone';
  2         6  
  2         108  
14 2     2   150 use Data::Dumper;
  2         5  
  2         1854  
15              
16             our $DEBUG = 0;
17             our @ISA = ("Lab::Instrument");
18             our %fields = (
19             supported_connections => ['USBtmc'],
20              
21             #default settings for connections
22              
23             connection_settings => {
24             connection_type => 'USBtmc',
25             usb_vendor => 0x0699, #Tektronix
26             usb_product => 0x036a, #TDS2024A
27             usb_serial => '*', #any serial number
28             read_buffer => 1024,
29             },
30              
31             device_settings => {},
32              
33             # too many characteristics can easily be "messed with" on the front
34             # panel, so only allow changes when scope is "locked".
35              
36             device_cache => {},
37              
38             chan_cache => {},
39             default_chan_cache => {
40             channel => undef,
41             chan_bwlimit => undef,
42             chan_coupling => undef,
43             chan_current_probe => undef,
44             chan_invert => undef,
45             chan_position => undef,
46             chan_probe => undef,
47             chan_scale => undef,
48             chan_yunit => undef,
49             select => undef,
50             },
51              
52             # non-front-panel cache items
53             NFP => [
54             qw(
55             ID
56             HEADER
57             VERBOSE
58             LOCKED
59             )
60             ],
61              
62             shared_cache => {
63             ID => undef,
64             HEADER => undef,
65             VERBOSE => undef,
66             LOCKED => undef,
67             acquire_mode => undef,
68             acquire_numavg => undef,
69             acquire_stopafter => undef,
70              
71             autorange_settings => undef,
72             cursor_type => undef,
73             cursor_x1 => undef,
74             cursor_x2 => undef,
75             cursor_y1 => undef,
76             cursor_y2 => undef,
77             cursor_xunits => undef,
78             cursor_yunits => undef,
79             cursor_source => undef,
80              
81             data_encoding => undef,
82             data_destination => undef,
83             data_source => undef,
84             data_start => undef,
85             data_stop => undef,
86             data_width => undef,
87              
88             display_contrast => undef,
89             display_format => undef,
90             display_persist => undef,
91             display_style => undef,
92             hardcopy_format => undef,
93             hardcopy_layout => undef,
94             hardcopy_port => undef,
95              
96             meas_source_imm => undef,
97             meas_type_imm => undef,
98             meas_units_imm => undef,
99              
100             meas_source_1 => undef,
101             meas_type_1 => undef,
102             meas_units_1 => undef,
103              
104             meas_source_2 => undef,
105             meas_type_2 => undef,
106             meas_units_2 => undef,
107              
108             meas_source_3 => undef,
109             meas_type_3 => undef,
110             meas_units_3 => undef,
111              
112             meas_source_4 => undef,
113             meas_type_4 => undef,
114             meas_units_4 => undef,
115              
116             meas_source_5 => undef,
117             meas_type_5 => undef,
118             meas_units_4 => undef,
119              
120             horiz_view => undef,
121             horiz_position => undef,
122             horiz_scale => undef,
123             delay_position => undef,
124             delay_scale => undef,
125              
126             math_definition => undef,
127             math_position => undef,
128             math_scale => undef,
129             fft_xposition => undef,
130             fft_xscale => undef,
131             fft_position => undef,
132             fft_scale => undef,
133              
134             trig_type => undef,
135             trig_holdoff => undef,
136             trig_mode => undef,
137             trig_level => undef,
138              
139             etrig_source => undef,
140             trig_slope => undef,
141             trig_coupling => undef,
142              
143             ptrig_source => undef,
144             trig_pulse_width => undef,
145             trig_pulse_polarity => undef,
146             trig_pulse_when => undef,
147              
148             vtrig_source => undef,
149             trig_vid_line => undef,
150             trig_vid_polarity => undef,
151             trig_vid_standard => undef,
152             trig_vid_sync => undef,
153              
154             },
155              
156             channel => undef,
157              
158             scpi_override => {
159             ACQuire => {
160             NUMACq => undef,
161             NUMAVg => undef,
162             STATE => undef,
163             STOPAfter => undef,
164             },
165             AUTORate => {
166             STATE => undef,
167             },
168             AUTOScale => {
169              
170             # '' => undef;
171             SIGNAL => undef,
172             },
173             LOCk => undef,
174             CH => {
175             BANDWIDth => undef,
176             CURRENTPRObe => undef,
177             PRObe => undef,
178             SCAle => undef,
179             VOLt => undef,
180             },
181              
182             CURSor => {
183             HBArs => {
184             UNIts => undef,
185             POSITION => undef,
186             },
187             VBArs => {
188             UNIts => undef,
189             POSITION => undef,
190             },
191             SELect => {
192             SOUrce => undef,
193             },
194             },
195             CURVe => undef,
196             DATa => {
197             ENCdg => undef,
198             SOUrce => undef,
199             TARget => undef,
200             WIDth => undef,
201             },
202             DISplay => {
203             CONTRast => undef,
204             STYle => undef,
205             },
206              
207             FILESystem => {
208             DELEte => undef,
209             FREESpace => undef,
210             },
211              
212             HARDCopy => {
213             BUTTON => undef,
214             },
215              
216             HORizontal => {
217             SCAle => undef,
218             SECdiv => undef,
219             RECOrdlength => undef,
220             MAIn => {
221             SCAle => undef,
222             SECdiv => undef,
223             },
224             DELay => {
225             SCAle => undef,
226             SECdiv => undef,
227             },
228             },
229              
230             MATH => {
231             DEFINE => undef,
232             FFT => {
233             HORizontal => {
234             SCAle => undef,
235             },
236             VERtical => {
237             SCAle => undef,
238             },
239             },
240             VERtical => {
241             SCAle => undef,
242             },
243             },
244              
245             MEASUrement => {
246             IMMed => {
247             TYPe => undef,
248             UNIts => undef,
249             SOUrce => undef,
250             },
251             MEAS => {
252             TYPe => undef,
253             UNIts => undef,
254             SOUrce => undef,
255             },
256             },
257              
258             TRIGger => {
259             MAIn => {
260             EDGE => {
261             SLOpe => undef,
262             SOUrce => undef,
263             },
264             HOLDOff => {
265             VALue => undef,
266             },
267             MODe => undef,
268             TYPe => undef,
269             PULse => {
270             SOUrce => undef,
271             WIDth => {
272             WIDth => undef,
273             },
274             },
275             VIDeo => {
276             SOUrce => undef,
277             },
278             },
279             STATE => undef,
280             },
281              
282             WFMPre => {
283             BIT_Nr => undef,
284             BYT_Nr => undef,
285             BYT_Or => undef,
286             ENCdg => undef,
287             PT_Off => undef,
288             WFId => undef,
289             XINcr => undef,
290             XUNit => undef,
291             XZEro => undef,
292             YMUlt => undef,
293             YOFf => undef,
294             YUNit => undef,
295             YZEro => undef,
296             CH => {
297             WFId => undef,
298             XINcr => undef,
299             XUNit => undef,
300             XZEro => undef,
301             YMUlt => undef,
302             YOFf => undef,
303             YUNit => undef,
304             YZEro => undef,
305             },
306             MATH => {
307             WFId => undef,
308             XINcr => undef,
309             XUNit => undef,
310             XZEro => undef,
311             YMUlt => undef,
312             YOFf => undef,
313             YUNit => undef,
314             YZEro => undef,
315             },
316             REFA => {
317             WFId => undef,
318             XINcr => undef,
319             XUNit => undef,
320             XZEro => undef,
321             YMUlt => undef,
322             YOFf => undef,
323             YUNit => undef,
324             YZEro => undef,
325             },
326             REFB => {
327             WFId => undef,
328             XINcr => undef,
329             XUNit => undef,
330             XZEro => undef,
331             YMUlt => undef,
332             YOFf => undef,
333             YUNit => undef,
334             YZEro => undef,
335             },
336             REFC => {
337             WFId => undef,
338             XINcr => undef,
339             XUNit => undef,
340             XZEro => undef,
341             YMUlt => undef,
342             YOFf => undef,
343             YUNit => undef,
344             YZEro => undef,
345             },
346             REFD => {
347             WFId => undef,
348             XINcr => undef,
349             XUNit => undef,
350             XZEro => undef,
351             YMUlt => undef,
352             YOFf => undef,
353             YUNit => undef,
354             YZEro => undef,
355             },
356             },
357             },
358             );
359              
360              
361             sub new {
362 0     0 1   my $proto = shift;
363 0   0       my $class = ref($proto) || $proto;
364              
365 0           foreach my $k ( keys( %{ $fields{default_chan_cache} } ) ) {
  0            
366 0           $fields{device_cache}->{$k} = $fields{default_chan_cache}->{$k};
367             }
368              
369 0           foreach my $k ( keys( %{ $fields{shared_cache} } ) ) {
  0            
370 0           $fields{device_cache}->{$k} = $fields{shared_cache}->{$k};
371             }
372              
373 0           my $self = $class->SUPER::new(@_);
374 0           $self->${ \( __PACKAGE__ . '::_construct' ) }(__PACKAGE__);
  0            
375              
376 0           $self->{connection_settings}->{READ_BUFFER} = 1024; # TDS2024B limit?
377 0           $self->{config}->{no_cache} = 1;
378 0           $self->{config}->{default_read_mode} = 'cache';
379 0 0         $DEBUG = $self->{config}->{debug} if exists $self->{config}->{debug};
380              
381             # initialize channel caches
382 0           foreach my $ch (qw(CH1 CH2 CH3 CH4 MATH REFA REFB REFC REFD)) {
383 0           $self->{chan_cache}->{$ch} = {};
384 0           foreach my $k ( keys( %{ $self->{default_chan_cache} } ) ) {
  0            
385             $self->{chan_cache}->{$ch}->{$k}
386 0           = $self->{default_chan_cache}->{$k};
387             }
388 0           $self->{chan_cache}->{$ch}->{channel} = $ch;
389 0           foreach my $k ( keys( %{ $self->{shared_cache} } ) ) {
  0            
390 0           $self->{chan_cache}->{$ch}->{$k} = $self->{shared_cache}->{$k};
391             }
392             }
393              
394 0           $self->{device_cache} = $self->{chan_cache}->{CH1};
395 0           $self->{channel} = "CH1";
396 0           return $self;
397             }
398              
399             #initialize scope.. this means setting up status bit masking
400             #for non-destructive testing for device errors
401              
402             sub _device_init {
403 0     0     my $self = shift;
404 0           $self->write("*ESE 60")
405             ; # 0x3C -> CME+EXE+DDE+QYE to bit 5 of SBR (read with *STB?)
406 0           $self->write("*CLS"); # clear status registers
407             }
408              
409             { # keep perl from bitching about this stuff
410 2     2   19 no warnings qw(redefine);
  2         5  
  2         66582  
411              
412             # calling argument parsing; this is an extension of the
413             # _check_args and _check_args_strict routines in Instrument.pm,
414             # allowing more flexibility in how routines are called.
415             # In particular routine(a=>1,b=>2,..) and
416             # routine({a=>1,b=>2,..}) can both be used.
417              
418             # note: if this code does not properly recognize the syntax,
419             # then you have to use the {key=>value...} form.
420              
421             # calling:
422             # ($par1,$par2,$par3,$tail) = $self->_Xcheck_args(\@_,qw(par1 par2 par3));
423             # or, for compatibility:
424             # ($par1,$par2,$par3,$tail) = $self->_Xcheck_args(\@_,[qw(par1 par2 par3)]);
425              
426             sub Lab::Instrument::_check_args {
427 0     0     my $self = shift;
428 0           my $args = shift;
429 0           my $params = [@_];
430 0 0         $params = $params->[0] if ref( $params->[0] ) eq 'ARRAY';
431 0           my $arguments = {};
432              
433 0 0 0       if ( $#{$args} == 0 && ref( $args->[0] ) eq 'HASH' ) { # case 3
  0            
434 0           %{$arguments} = ( %{ $args->[0] } );
  0            
  0            
435             }
436             else {
437 0           my $simple = 1;
438 0 0         if ( $#{$args} & 1 == 1 ) { # must have even # arguments
  0            
439 0           my $found = {};
440 0           for ( my $j = 0; $j <= $#{$args}; $j += 2 ) {
  0            
441 0 0         if ( ref( $args->[$j] ) ne '' ) { # a ref for a key? no
442 0           $simple = 1;
443 0           last;
444             }
445 0           foreach my $p ( @{$params} ) { # named param
  0            
446 0 0         $simple = 0 if $p eq $args->[$j];
447             }
448 0 0         if ( exists( $found->{ $args->[$j] } ) )
449             { # key used 2x? no
450 0           $simple = 1;
451 0           last;
452             }
453 0           $found->{ $args->[$j] } = 1;
454             }
455             }
456              
457 0 0         if ($simple) { # case 1
458 0           my $i = 0;
459 0           foreach my $arg ( @{$args} ) {
  0            
460 0 0         if ( defined @{$params}[$i] ) {
  0            
461 0           $arguments->{ @{$params}[$i] } = $arg;
  0            
462             }
463 0           $i++;
464             }
465             }
466             else { # case 2
467 0           %{$arguments} = ( @{$args} );
  0            
  0            
468             }
469             }
470              
471 0           my @return_args = ();
472              
473 0           foreach my $param ( @{$params} ) {
  0            
474 0 0         if ( exists $arguments->{$param} ) {
475 0           push( @return_args, $arguments->{$param} );
476 0           delete $arguments->{$param};
477             }
478             else {
479 0           push( @return_args, undef );
480             }
481             }
482              
483 0           push( @return_args, $arguments );
484              
485 0 0         if (wantarray) {
486 0           return @return_args;
487             }
488             else {
489 0           return $return_args[0];
490             }
491             }
492              
493             sub Lab::Instrument::_check_args_strict {
494 0     0     my $self = shift;
495 0           my $args = shift;
496 0           my $params = [@_];
497 0 0         $params = $params->[0] if ref( $params->[0] ) eq 'ARRAY';
498              
499 0           my @result = $self->_check_args( $args, $params );
500              
501 0           my $num_params = @result - 1;
502              
503 0           for ( my $i = 0; $i < $num_params; ++$i ) {
504 0 0         if ( not defined $result[$i] ) {
505 0           croak("missing mandatory argument '$params->[$i]'");
506             }
507             }
508              
509 0 0         if (wantarray) {
510 0           return @result;
511             }
512             else {
513 0           return $result[0];
514             }
515             }
516              
517             }
518             #
519             # utility function: check header/verbose and parse
520             # query reply appropriately; remove quotes in present
521             # ex: $self->_parseReply('ACQ:MODE average',qw{AVE PEAK SAM})
522             # gives AVE
523             sub _parseReply {
524 0     0     my $self = shift;
525 0           my $in = shift;
526              
527 0           my $h = $self->get_header();
528 0 0         if ($h) {
529 0           my $c;
530 0           ( $c, $in ) = split( /\s+/, $in );
531 0 0 0       return '' unless defined($in) && $in ne '';
532             }
533              
534             # remove quotes on strings
535 0 0         if ( $in =~ /^\"(.*)\"$/ ) {
    0          
536 0           $in = $1;
537 0           $in =~ s/\"\"/"/g;
538             }
539             elsif ( $in =~ /^\'(.*)\'$/ ) {
540 0           $in = $1;
541 0           $in =~ s/\'\'/'/g;
542             }
543              
544 0 0         return $in unless $#_ > -1;
545 0           my $v = $self->get_verbose();
546 0 0         return $in unless $v;
547 0           return _keyword( $in, @_ );
548             }
549              
550             #
551             # select keyword
552             # example: $got = _keyword('input', qw{ IN OUT EXT } )
553             # returns $got = 'IN'
554              
555             sub _keyword {
556 0     0     my $in = shift;
557 0 0         $in = shift if ref($in) eq 'HASH'; # dispose of $self->_keyword form...
558 0           my $r;
559              
560 0           $in =~ s/^\s+//;
561 0           foreach my $k (@_) {
562 0 0         if ( $in =~ /^$k/i ) {
563 0           return $k;
564             }
565             }
566 0           Lab::Exception::CorruptParameter->throw("Invalid keyword input '$in'\n");
567             }
568              
569             # convert 'short form' keywords to long form
570              
571             sub _bloat {
572 0     0     my $in = shift;
573 0 0         $in = shift if ref($in) eq 'HASH'; # dispose of $self->_bloat
574 0           my $tr = shift; # hash of short=>long:
575              
576 0           $in =~ s/^\s+//;
577 0           $in =~ s/\s+$//;
578 0 0         return $in if $in eq '';
579              
580 0           foreach my $k ( keys( %{$tr} ) ) {
  0            
581 0 0         if ( $in =~ /^${k}/i ) {
582 0           return $tr->{$k};
583             }
584             }
585              
586 0           return uc($in); # nothing matched
587             }
588              
589             # parse a GPIB number with suffix, units
590             # $result = _parseNRf($numberstring,$unit1[,$unit2,...])
591             # _parseNRf('maximum','foo) -> 'MAX'
592             # _parseNRf('-3.7e+3kJ','j') -> -3.7e6
593             # _parseNRf('2.3ksec','s','sec') -> 2300 ('s' and 'sec' alternate units)
594             # note special cases for suffixes: MHZ, MOHM, MA
595             # also handling 'dB' -> (number)dB(magnitudesuffix)(unit V|W|etc)
596             #
597             # if problem, string returned starts 'ERR: ..message...'
598             # see IEEE std 488-2 7.7.3
599              
600             sub _parseNRf {
601 0     0     my $in = shift;
602 0 0         $in = shift if ref($in) eq 'HASH'; # $self->_parseNRf handling...
603 0           my $un = shift;
604 0 0         $un = '' unless defined $un;
605 0           my $us;
606              
607 0 0         if ( ref($un) eq 'ARRAY' ) {
    0          
    0          
608 0           $us = $un;
609             }
610             elsif ( ref($un) eq 'SCALAR' ) {
611 0           $us = [ $$un, @_ ];
612             }
613             elsif ( ref($un) eq '' ) {
614 0           $us = [ $un, @_ ];
615             }
616 0           my $str = $in;
617              
618 0           $str =~ s/^\s+//;
619 0           $str =~ s/\s+$//;
620              
621 0 0         if ( $str =~ /^MIN/i ) {
622 0           return 'MIN';
623             }
624 0 0         if ( $str =~ /^MAX/i ) {
625 0           return 'MAX';
626             }
627              
628 0           my $mant = 0;
629 0           my $exp = 0;
630 0 0         if ( $str =~ /^([+\-]?(\d+\.\d*|\d+|\d*\.\d+))\s*/i ) {
631 0           $mant = $1;
632 0           $str = $POSTMATCH;
633 0 0         return $mant if $str eq '';
634 0 0         if ( $str =~ /^e\s*([+\-]?\d+)\s*/i ) {
635 0           $exp = $1;
636 0           $str = $POSTMATCH;
637             }
638 0 0         return $mant * ( 10**$exp ) if $str eq '';
639              
640 0           my $kexp = $exp;
641 0           my $kstr = $str;
642 0           foreach my $u ( @{$us} ) {
  0            
643 0           $u =~ s/^\s+//;
644 0           $u =~ s/\s+$//;
645              
646 0           $str = $kstr;
647 0           $exp = $kexp;
648 0 0         if ( $u =~ /^db/i ) { # db(magnitude_suffix)?(V|W|... unit)?
649 0           my $dbt = $POSTMATCH;
650 0 0         if ( $str =~ /^dBex(${dbt})?$/i ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
651 0           $exp += 18;
652             }
653             elsif ( $str =~ /^dBpe(${dbt})?$/i ) {
654 0           $exp += 15;
655             }
656             elsif ( $str =~ /^dBt(${dbt})?$/i ) {
657 0           $exp += 12;
658             }
659             elsif ( $str =~ /^dBg(${dbt})?$/i ) {
660 0           $exp += 9;
661             }
662             elsif ( $str =~ /^dBma(${dbt})$/i ) {
663 0           $exp += 6;
664             }
665             elsif ( $str =~ /^dBk(${dbt})?$/i ) {
666 0           $exp += 3;
667             }
668             elsif ( $str =~ /^dBm(${dbt})?$/i ) {
669 0           $exp -= 3;
670             }
671             elsif ( $str =~ /^dBu(${dbt})?$/i ) {
672 0           $exp -= 6;
673             }
674             elsif ( $str =~ /^dBn(${dbt})?$/i ) {
675 0           $exp -= 9;
676             }
677             elsif ( $str =~ /^dBp(${dbt})?$/i ) {
678 0           $exp -= 12;
679             }
680             elsif ( $str =~ /^dBf(${dbt})?$/i ) {
681 0           $exp -= 15;
682             }
683             elsif ( $str =~ /^dB${dbt}$/i ) {
684 0           $exp += 0;
685             }
686             else {
687 0           next;
688             }
689             }
690             else { # regular units stuff: (magnitude_suffix)(unit)?
691 0 0 0       if ( $str =~ /^ex(${u})?$/i ) {
    0 0        
    0 0        
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
692 0           $exp += 18;
693             }
694             elsif ( $str =~ /^pe(${u})?$/i ) {
695 0           $exp += 15;
696             }
697             elsif ( $str =~ /^t(${u})?$/i ) {
698 0           $exp += 12;
699             }
700             elsif ( $str =~ /^g(${u})?$/i ) {
701 0           $exp += 9;
702             }
703             elsif ( $u =~ /(HZ|OHM)/i && $str =~ /^ma?(${u})$/i ) {
704 0           $exp += 6;
705             }
706             elsif ( $u =~ /A/i && $str =~ /^ma$/i ) {
707 0           $exp -= 3;
708             }
709             elsif ( $u !~ /(HZ|OHM)/i && $str =~ /^ma(${u})?$/i ) {
710 0           $exp += 6;
711             }
712             elsif ( $str =~ /^k(${u})?$/i ) {
713 0           $exp += 3;
714             }
715             elsif ( $str =~ /^m(${u})?$/i ) {
716 0           $exp -= 3;
717             }
718             elsif ( $str =~ /^u(${u})?$/i ) {
719 0           $exp -= 6;
720             }
721             elsif ( $str =~ /^n(${u})?$/i ) {
722 0           $exp -= 9;
723             }
724             elsif ( $str =~ /^p(${u})?$/i ) {
725 0           $exp -= 12;
726             }
727             elsif ( $str =~ /^f(${u})?$/i ) {
728 0           $exp -= 15;
729             }
730             elsif ( $str =~ /^${u}$/i ) {
731 0           $exp += 0;
732             }
733             else {
734 0           next;
735             }
736             }
737 0           return $mant * ( 10**$exp );
738             }
739             }
740 0           return "ERR: '$str' number parsing problem";
741              
742             }
743              
744              
745             sub reset {
746 0     0 1   my $self = shift;
747 0           $self->write("*RST");
748 0           $self->_debug();
749 0           $self->_reset_cache();
750             }
751              
752             our $_rst_state = {
753             LOCKED => 'NON',
754             HEADER => '1',
755             VERBOSE => '1',
756              
757             data_encoding => 'RIBINARY',
758             data_destination => 'REFA',
759             data_source => 'CH1',
760             data_start => 1,
761             data_stop => 2500,
762             data_width => 1,
763              
764             display_format => 'YT',
765             display_style => 'VECTORS',
766             display_persist => 0,
767             display_contrast => 50,
768              
769             acquire_mode => 'SAMPLE',
770             acquire_numavg => 16,
771             acquire_stopafter => 'RUNSTOP',
772             autorange_settings => 'BOTH',
773              
774             chan_probe => 10,
775             chan_current_probe => 10,
776             chan_scale => 1.0,
777             chan_position => 0.0,
778             chan_coupling => 'DC',
779             chan_bwlimit => 0,
780             chan_invert => 0,
781             chan_yunit => 'V',
782              
783             cursor_type => 'OFF',
784             cursor_source => 'CH1',
785             cursor_vbars_units => 'SECONDS',
786             cursor_x1 => -2.0e-3,
787             cursor_x2 => 2.0e-3,
788             cursor_y1 => 3.2,
789             cursor_y2 => -3.2,
790              
791             hardcopy_format => 'JPEG',
792             hardcopy_layout => 'PORTRAIT',
793             hardcopy_port => 'USB',
794              
795             horiz_view => 'MAIN',
796             horiz_scale => 5.0E-4,
797             horiz_position => 0.0E0,
798             delay_scale => 5.0E-5,
799             delay_position => 0.0E0,
800              
801             meas_type_1 => 'NONE',
802             meas_source_1 => 'CH1',
803             meas_units_1 => undef,
804              
805             meas_type_2 => 'NONE',
806             meas_source_2 => 'CH1',
807             meas_units_2 => undef,
808              
809             meas_type_3 => 'NONE',
810             meas_source_3 => 'CH1',
811             meas_units_3 => undef,
812              
813             meas_type_4 => 'NONE',
814             meas_source_4 => 'CH1',
815             meas_units_4 => undef,
816              
817             meas_type_5 => 'NONE',
818             meas_source_5 => 'CH1',
819             meas_units_5 => undef,
820              
821             meas_type_imm => 'PERIOD',
822             meas_source_imm => 'CH1',
823             meas_units_imm => 'S',
824              
825             math_definition => 'CH1 - CH2',
826             math_position => 0.0E0,
827             math_scale => 2.0E0,
828             fft_xposition => 5.0E1,
829             fft_xscale => 1.0E0,
830             fft_position => 0.0E0,
831             fft_scale => 1.0E0,
832              
833             trig_mode => 'AUTO',
834             trig_type => 'EDGE',
835             trig_holdoff => 5.0E-7,
836             trig_level => 0.0E0,
837              
838             etrig_source => 'CH1',
839             trig_coupling => 'DC',
840             trig_slope => 'RISE',
841              
842             vtrig_source => 'CH1',
843             trig_vid_sync => 'LINE',
844             trig_vid_polarity => 'NORMAL',
845             trig_vid_line => 1,
846             trig_vid_standard => 'NTSC',
847              
848             ptrig_source => 'CH1',
849             trig_pulse_polarity => 'POSITIVE',
850             trig_pulse_width => 1.0E-3,
851             trig_pulse_when => 'EQUAL',
852              
853             };
854              
855             sub _reset_cache {
856 0     0     my $self = shift;
857              
858 0           for my $k ( keys( %{$_rst_state} ) ) {
  0            
859 0           $self->{device_cache}->{$k} = $_rst_state->{$k};
860 0           for ( my $ch = 1; $ch <= 4; $ch++ ) {
861 0 0         $self->{chan_cache}->{"CH$ch"}->{select} = ( $ch == 1 ? 1 : 0 );
862 0 0         next if "CH$ch" eq $self->{channel};
863 0           $self->{chan_cache}->{"CH$ch"}->{$k} = $_rst_state->{$k};
864             }
865             }
866 0 0         $self->{device_cache}->{select} = ( $self->{channel} eq 'CH1' ? 1 : 0 );
867 0           foreach my $wfm (qw(MATH REFA REFB REFC REFD)) {
868 0           $self->{chan_cache}->{$wfm}->{select} = 0;
869             }
870             }
871              
872             # print error queue; meant to be called at end of routine
873             # so uses 'caller' info to label the subroutine
874             sub _debug {
875 0 0   0     return unless $DEBUG;
876 0           my $self = shift;
877 0           my ( $p, $f, $l, $subr ) = caller(1);
878 0           while (1) {
879 0           my ( $code, $msg ) = $self->get_error();
880 0 0         last if $code == 0;
881 0           print "$subr\t$code: $msg\n";
882             }
883             }
884              
885              
886             sub get_error {
887 0     0 1   my $self = shift;
888              
889 0           my $err = $self->query("*ESR?");
890 0 0         if ( $err == 0 ) {
891 0           return ( 0, "No events to report - queue empty" );
892             }
893 0           my $msg = $self->query("EVM?");
894              
895 0 0         if ( $msg =~ /^([\w:]+\s+)?(\d+),(.*)$/i ) {
896 0           my $code = $2;
897 0           $msg = $3;
898 0           $msg =~ s/^\"//;
899 0           $msg =~ s/\"$//;
900 0           $msg =~ s/\"\"/"/g;
901 0           return ( $code, $msg );
902             }
903             else {
904 0           return ( -1, $msg );
905             }
906              
907             # (:EVMSG 110, "command head")
908             }
909              
910              
911             our $sbits = [qw(OPC RQC QYE DDE EXE CME URQ PON)];
912              
913             sub get_status {
914 0     0 1   my $self = shift;
915 0           my $bit = shift;
916 0           my $s = {};
917              
918 0           my $r = $self->query('*ESR?');
919 0           $self->_debug();
920              
921 0           for ( my $j = 0; $j < 7; $j++ ) {
922 0           $s->{ $sbits->[$j] } = ( $r >> $j ) & 0x01;
923             }
924 0           $s->{ERROR} = $s->{CME} | $s->{EXE} | $s->{DDE} | $s->{QYE};
925              
926 0 0         return $s->{ uc($bit) } if defined $bit;
927 0           return $s;
928             }
929              
930              
931             sub get_datetime {
932 0     0 1   my $self = shift;
933 0           my $d = $self->query("DATE?");
934 0           $d = $self->_parseReply($d);
935            
936 0           my $t = $self->query("TIM?");
937 0           $t = $self->_parseReply($t);
938 0           return "$d $t";
939             }
940              
941              
942             sub set_datetime {
943 0     0 1   my $self = shift;
944 0           my $unixtime = shift;
945 0 0         $unixtime = time() unless defined $unixtime;
946            
947 0           my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
948             localtime($unixtime);
949              
950 0           my $date = sprintf('%04d-%02d-%02d',$year+1900,$mon+1,$mday);
951 0           my $time = sprintf('%02d:%02d:%02d',$hour,$min,$sec);
952              
953 0           $self->write("DATE \"$date\"");
954 0           $self->write("TIME \"$time\"");
955              
956 0           return "$date $time";
957             }
958              
959            
960              
961             sub wait_done {
962 0     0 1   my $self = shift;
963 0           my ( $time, $dt, $tail )
964             = $self->_check_args( \@_, qw(timeout checkinterval) );
965              
966 0           my $tmax;
967              
968 0 0         $time = '10s' unless defined $time;
969              
970 0 0         if ( $time =~ /\s*(INF|MAX)/i ) {
971 0           $tmax = -1;
972             }
973             else {
974 0           $tmax = _parseNRf( $time, 's' );
975 0 0 0       if ( $time =~ /(ERR|MIN|MAX)/ || $tmax <= 0 ) {
976 0           Lab::Exception::CorruptParameter->throw(
977             "Invalid time input '$time'\n");
978 0           return;
979             }
980             }
981              
982 0           my $dtcheck;
983 0 0         $dt = '500ms' unless defined $dt;
984 0           $dtcheck = _parseNRf( $dt, 's' );
985 0 0 0       if ( $dtcheck =~ /(ERR|MIN|MAX)/ || $dtcheck <= 0 ) {
986 0           Lab::Exception::CorruptParameter->throw(
987             "Invalid time check interval input '$dt'\n");
988 0           return;
989             }
990              
991 0           my $n;
992 0 0         if ( $tmax == -1 ) {
993 0           $n = -1;
994             }
995             else {
996 0           $n = $tmax / $dtcheck;
997              
998 0           $n = int( $n + 0.5 );
999 0 0         $n = 1 if $n < 1;
1000 0           $n++;
1001             }
1002              
1003 0           while (1) {
1004 0 0         return 1 if $self->query('BUSY?') =~ /^(:BUSY )?\s*0/i;
1005 0 0         return 0 if $n-- == 0;
1006 0           sleep($dtcheck);
1007             }
1008             }
1009              
1010              
1011             sub test_busy {
1012 0     0 1   my $self = shift;
1013 0 0         return 1 if $self->query('BUSY?') =~ /^(:BUSY )?\s*1/i;
1014 0           return 0;
1015             }
1016              
1017              
1018             sub get_id {
1019 0     0 1   my $self = shift;
1020 0           my ($tail) = $self->_check_args( \@_ );
1021              
1022             $tail->{read_mode} = $self->{config}->{default_read_mode}
1023 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
1024              
1025 0 0 0       if ( $tail->{read_mode} ne 'cache'
1026             || !defined( $self->{device_cache}->{ID} ) ) {
1027 0           $self->{device_cache}->{ID} = $self->query('*IDN?');
1028 0           $self->_debug();
1029             }
1030 0           return $self->{device_cache}->{ID};
1031             }
1032              
1033              
1034             sub get_header {
1035 0     0 1   my $self = shift;
1036              
1037 0           my ($tail) = $self->_check_args( \@_ );
1038              
1039             $tail->{read_mode} = $self->{config}->{default_read_mode}
1040 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
1041              
1042 0 0 0       if ( $tail->{read_mode} ne 'cache'
1043             || !defined( $self->{device_cache}->{HEADER} ) ) {
1044 0           my $r = $self->query('HEAD?');
1045 0           $self->_debug();
1046              
1047             # can't use the _parseReply here...
1048 0 0         if ( $r =~ /HEAD(er)?\s+([\w]+)/i ) {
1049 0           $r = $2;
1050             }
1051 0 0         if ( $r =~ /(1|ON)/i ) {
1052 0           $self->{device_cache}->{HEADER} = 1;
1053             }
1054             else {
1055 0           $self->{device_cache}->{HEADER} = 0;
1056             }
1057             }
1058 0           return $self->{device_cache}->{HEADER};
1059             }
1060              
1061              
1062             sub save {
1063 0     0 1   my $self = shift;
1064 0           my ($in) = $self->_check_args_strict( \@_, 'setup' );
1065              
1066 0 0 0       if ( $in !~ /^s*\d+\s*$/ || $in < 1 || $in > 10 || int($in) != $in ) {
      0        
      0        
1067 0           Lab::Exception::CorruptParameter->throw(
1068             "Invalid save setup number '$in'\n");
1069 0           return;
1070             }
1071              
1072 0           $self->write("*SAV $in");
1073 0           $self->_debug();
1074             }
1075              
1076              
1077             sub recall {
1078 0     0 1   my $self = shift;
1079 0           my ($in) = $self->_check_args_strict( \@_, 'setup' );
1080              
1081 0 0 0       if ( $in !~ /^\s*\d+\s*$/ || $in < 1 || $in > 10 || $in != int($in) ) {
      0        
      0        
1082 0           Lab::Exception::CorruptParameter->throw(
1083             "Invalid setup save location '$in'\n");
1084 0           return;
1085             }
1086 0           $self->write("*RCL $in");
1087 0           $self->_debug();
1088             }
1089              
1090              
1091             sub set_header {
1092 0     0 1   my $self = shift;
1093 0           my ($in) = $self->_check_args_strict( \@_, 'header' );
1094 0           my $h;
1095              
1096 0 0         if ( $in =~ /^\s*([1-9]|on|y|t)/i ) {
    0          
1097 0           $h = 1;
1098             }
1099             elsif ( $in =~ /^\s*(0|off|n|f)/i ) {
1100 0           $h = 0;
1101             }
1102             else {
1103 0           Lab::Exception::CorruptParameter->throw(
1104             "Invalid boolean input '$in'\n");
1105 0           return;
1106             }
1107             return
1108             if defined( $self->{device_cache}->{HEADER} )
1109 0 0 0       && $self->{device_cache}->{HEADER} == $h;
1110              
1111 0           $self->write("HEAD $h");
1112 0           $self->{device_cache}->{HEADER} = $h;
1113 0           $self->_debug();
1114             }
1115              
1116              
1117             sub get_verbose {
1118 0     0 1   my $self = shift;
1119 0           my ($tail) = $self->_check_args( \@_ );
1120              
1121             $tail->{read_mode} = $self->{config}->{default_read_mode}
1122 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
1123              
1124 0 0 0       if ( $tail->{read_mode} ne 'cache'
1125             || !defined( $self->{device_cache}->{VERBOSE} ) ) {
1126 0           my $r = $self->query('VERB?');
1127 0           $self->_debug();
1128              
1129             # can't use the _parseReply here...
1130 0 0         if ( $r =~ /VERB(ose)?\s+([\w]+)/i ) {
1131 0           $r = $2;
1132             }
1133 0 0         if ( $r =~ /(1|ON)/i ) {
1134 0           $self->{device_cache}->{VERBOSE} = 1;
1135             }
1136             else {
1137 0           $self->{device_cache}->{VERBOSE} = 0;
1138             }
1139             }
1140 0           return $self->{device_cache}->{VERBOSE};
1141             }
1142              
1143              
1144             sub set_verbose {
1145 0     0 1   my $self = shift;
1146 0           my ($in) = $self->_check_args_strict( \@_, 'verbose' );
1147 0           my $v;
1148              
1149 0 0         if ( $in =~ /^\s*(1|on|y|t)/i ) {
    0          
1150 0           $v = 1;
1151             }
1152             elsif ( $in =~ /^\s*(0|off|n|f)/i ) {
1153 0           $v = 0;
1154             }
1155             else {
1156 0           Lab::Exception::CorruptParameter->throw(
1157             "Invalid boolean input '$in'\n");
1158 0           return;
1159             }
1160             return
1161             if defined( $self->{device_cache}->{VERBOSE} )
1162 0 0 0       && $self->{device_cache}->{VERBOSE} == $v;
1163 0           $self->write("VERB $v");
1164 0           $self->{device_cache}->{VERBOSE} = $v;
1165 0           $self->_debug();
1166             }
1167              
1168              
1169             sub get_locked {
1170 0     0 1   my $self = shift;
1171 0           my ($tail) = $self->_check_args( \@_ );
1172              
1173             $tail->{read_mode} = $self->{config}->{default_read_mode}
1174 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
1175              
1176 0 0 0       if ( $tail->{read_mode} ne 'cache'
1177             || !defined( $self->{device_cache}->{LOCKED} ) ) {
1178 0           my $r = $self->query('LOC?');
1179 0           $self->_debug();
1180              
1181             # can't use the _parseReply here...
1182 0 0         if ( $r =~ /LOC(k)?\s+([\w]+)/i ) {
1183 0           $r = $2;
1184             }
1185 0 0         if ( $r =~ /(1|ON|ALL)/i ) {
1186 0           $self->{device_cache}->{LOCKED} = 1;
1187 0           $self->{config}->{no_cache} = 0;
1188             }
1189             else {
1190 0           $self->{device_cache}->{LOCKED} = 0;
1191 0           $self->{config}->{no_cache} = 1;
1192             }
1193             }
1194 0           return $self->{device_cache}->{LOCKED};
1195             }
1196              
1197              
1198             sub set_locked {
1199 0     0 1   my $self = shift;
1200 0           my ($in) = $self->_check_args_strict( \@_, 'locked' );
1201              
1202 0           my $lock;
1203 0 0         if ( $in =~ /^\s*(1|y|t|on|all)/i ) {
    0          
1204 0           $lock = 'ALL';
1205             }
1206             elsif ( $in =~ /^\s*(0|n|f|off|non)/i ) {
1207 0           $lock = 'NON';
1208             }
1209             else {
1210 0           Lab::Exception::CorruptParameter->throw(
1211             "Invalid lock setting '$in'\n");
1212 0           return;
1213             }
1214             return
1215             if defined( $self->{device_cache}->{LOCKED} )
1216 0 0 0       && $self->{device_cache}->{LOCKED} eq $lock;
1217              
1218 0           $self->write("LOC $lock");
1219 0           $self->_debug();
1220              
1221 0 0         if ( $lock eq 'ALL' ) { # locking clears cache
1222 0 0         $self->_ClearCache() if $self->{config}->{no_cache};
1223 0           $self->{config}->{no_cache} = 0;
1224 0           $self->{device_cache}->{LOCKED} = 1;
1225             }
1226             else {
1227 0           $self->{config}->{no_cache} = 1;
1228 0           $self->{device_cache}->{LOCKED} = 0;
1229             }
1230             }
1231              
1232             # clear cache of all but the "not front panel" (NFP) entries
1233              
1234             sub _ClearCache {
1235 0     0     my $self = shift;
1236 0           my (%nfp);
1237 0           foreach my $k ( @{ $self->{NFP} } ) {
  0            
1238 0           $nfp{$k} = 1;
1239             }
1240              
1241 0           foreach my $ch (qw(CH1 CH2 CH3 CH4 MATH REFA REFB REFC REFD)) {
1242 0           foreach my $k ( keys( %{ $self->{chan_cache}->{$ch} } ) ) {
  0            
1243 0 0         next if exists( $nfp{$k} );
1244 0           $self->{chan_cache}->{$ch}->{$k} = undef;
1245             }
1246             }
1247             }
1248              
1249              
1250             # these give the mappings between SCPI codes and cache entries
1251              
1252             our $_ccache = { # per-channel caches
1253             'CH1:BANDWID' => 'chan_bwlimit',
1254             'CH1:COUP' => 'chan_coupling',
1255             'CH1:CURRENTPRO' => 'chan_current_probe',
1256             'CH1:INV' => 'chan_invert',
1257             'CH1:POS' => 'chan_position',
1258             'CH1:PRO' => 'chan_probe',
1259             'CH1:SCA' => 'chan_scale',
1260             'CH1:YUN' => 'chan_yunit',
1261             };
1262              
1263             our $_lcache = { # shared cache
1264             'ACQ:MODE' => 'acquire_mode',
1265             'ACQ:NUMAV' => 'acquire_numavg',
1266              
1267             #'ACQ:STAT' => ' ',
1268             'ACQ:STOPA' => 'acquire_stopafter',
1269              
1270             'AUT:SETT' => 'autorange_settings',
1271              
1272             'CURS:FUNC' => 'cursor_type',
1273             'CURS:HBA:POSITION1' => 'cursor_y1',
1274             'CURS:HBA:POSITION2' => 'cursor_y2',
1275             'CURS:SEL:SOU' => 'cursor_source',
1276             'CURS:VBA:POSITION1' => 'cursor_x1',
1277             'CURS:VBA:POSITION2' => 'cursor_x2',
1278             'CURS:VBA:UNI' => 'cursor_xunits',
1279              
1280             'DAT:DEST' => 'data_destination',
1281             'DAT:ENC' => 'data_encoding',
1282             'DAT:SOU' => 'data_source',
1283             'DAT:STAR' => 'data_start',
1284             'DAT:STOP' => 'data_stop',
1285             'DAT:WID' => 'data_width',
1286              
1287             'DIS:CONTR' => 'display_contrast',
1288             'DIS:FORM' => 'display_format',
1289              
1290             #'DIS:INV' => ' ',
1291             'DIS:PERS' => 'display_persist',
1292             'DIS:STY' => 'display_style',
1293              
1294             #'HARDC:BUTT' => ' ',
1295             'HARDC:FORM' => 'hardcopy_format',
1296              
1297             #'HARDC:INKS' => ' ',
1298             'HARDC:LAY' => 'hardcopy_layout',
1299             'HARDC:PORT' => 'hardcopy_port',
1300             'HOR:DEL:POS' => 'delay_position',
1301             'HOR:DEL:SCA' => 'delay_scale',
1302             'HOR:MAI:POS' => 'horiz_position',
1303             'HOR:MAI:SCA' => 'horiz_scale',
1304             'HOR:VIEW' => 'horiz_view',
1305             'MATH:DEFINE' => 'math_definition',
1306             'MATH:FFT:HOR:POS' => 'fft_xposition',
1307             'MATH:FFT:HOR:SCA' => 'fft_xscale',
1308             'MATH:FFT:VER:POS' => 'fft_position',
1309             'MATH:FFT:VER:SCA' => 'fft_scale',
1310             'MATH:VER:POS' => 'math_position',
1311             'MATH:VER:SCA' => 'math_scale',
1312              
1313             'MEASU:IMM:SOU1' => 'meas_source_imm',
1314             'MEASU:IMM:TYP' => 'meas_type_imm',
1315             'MEASU:MEAS1:SOU' => 'meas_source_1',
1316             'MEASU:MEAS1:TYP' => 'meas_type_1',
1317             'MEASU:MEAS2:SOU' => 'meas_source_2',
1318             'MEASU:MEAS2:TYP' => 'meas_type_2',
1319             'MEASU:MEAS3:SOU' => 'meas_source_3',
1320             'MEASU:MEAS3:TYP' => 'meas_type_3',
1321             'MEASU:MEAS4:SOU' => 'meas_source_4',
1322             'MEASU:MEAS4:TYP' => 'meas_type_4',
1323             'MEASU:MEAS5:SOU' => 'meas_source_5',
1324             'MEASU:MEAS5:TYP' => 'meas_type_5',
1325              
1326             # 'PICT:DAT' => ' ',
1327             # 'PICT:IDPR' => ' ',
1328             # 'PICT:IMAG' => ' ',
1329             # 'PICT:PAP' => ' ',
1330             # 'PICT:PRIN' => ' ',
1331              
1332             # 'SAV:IMA:FIL' => ' ',
1333              
1334             'TRIG:MAI:EDGE:COUP' => 'trig_coupling',
1335             'TRIG:MAI:EDGE:SLO' => 'trig_slope',
1336             'TRIG:MAI:EDGE:SOU' => 'etrig_source',
1337             'TRIG:MAI:HOLDO:VAL' => 'trig_holdoff',
1338             'TRIG:MAI:LEV' => 'trig_level',
1339             'TRIG:MAI:MOD' => 'trig_mode',
1340             'TRIG:MAI:PUL:SOU' => 'ptrig_source',
1341             'TRIG:MAI:PUL:WID:POL' => 'trig_pulse_polarity',
1342             'TRIG:MAI:PUL:WID:WHEN' => 'trig_pulse_when',
1343             'TRIG:MAI:PUL:WID:WID' => 'trig_pulse_width',
1344             'TRIG:MAI:TYP' => 'trig_type',
1345             'TRIG:MAI:VID:LINE' => 'trig_vid_line',
1346             'TRIG:MAI:VID:POL' => 'trig_vid_polarity',
1347             'TRIG:MAI:VID:SOU' => 'vtrig_source',
1348             'TRIG:MAI:VID:STAN' => 'trig_vid_standard',
1349             'TRIG:MAI:VID:SYNC' => 'trig_vid_sync',
1350             };
1351              
1352             sub get_setup {
1353 0     0 1   my $self = shift;
1354              
1355 0 0         if ( $self->query("*STB?") & 0x20 ) {
1356 0           $self->_debug();
1357 0           $self->write('*CLS');
1358             }
1359              
1360 0           my $v = $self->get_verbose();
1361 0 0         $self->set_verbose(1) if !$v;
1362 0           my $r = $self->query( "SET?", read_length => -1, timeout => 60 );
1363 0           my $post_status = $self->query("*STB?");
1364              
1365             # print Dumper($r),"\n";
1366              
1367 0           my $h = scpi_flat( scpi_parse($r), $self->{scpi_override} );
1368              
1369             #print Dumper($h),"\n";
1370              
1371             # special cases
1372              
1373 0 0 0       if ( exists( $h->{'TRIG:MAI:EDGE:SOU'} )
1374             && $h->{'TRIG:MAI:EDGE:SOU'} eq 'LINE' ) {
1375              
1376 0 0         if ( $post_status & 0x20 ) {
1377 0           my ( $ec, $em ) = $self->get_error();
1378 0 0 0       if ( ( $ec != 0 && $ec != 300 )
      0        
      0        
1379             || ( $ec == 300 && $em !~ /no\s*alternate/i ) ) {
1380 0 0         if ($DEBUG) {
1381 0           my ( $p, $f, $l, $subr ) = caller(0);
1382 0           print "$subr\t$ec: $em\n";
1383             }
1384             }
1385             }
1386             }
1387              
1388 0           $self->_debug();
1389              
1390 0 0         $self->set_verbose(0) if !$v;
1391 0           $h->{VERB} = $v;
1392              
1393 0 0         $self->{device_cache}->{HEADER} = $h->{HEAD} if exists $h->{HEAD};
1394 0 0         $self->{device_cache}->{VERBOSE} = $h->{VERB} if exists $h->{VERB};
1395 0 0         if ( exists( $h->{LOC} ) ) {
1396 0 0         $self->{device_cache}->{LOCKED} = ( $h->{LOC} eq 'ALL' ? 1 : 0 );
1397             }
1398              
1399 0 0         if ( $self->{device_cache}->{LOCKED} ) {
1400              
1401             #per-channel values
1402              
1403 0           foreach my $wfm (qw(CH1 CH2 CH3 CH4 MATH REFA REFB REFC REFD)) {
1404             $self->{chan_cache}->{$wfm}->{select} = $h->{"SEL:$wfm"}
1405 0 0         if exists $h->{"SEL:$wfm"};
1406              
1407 0 0         next unless $wfm =~ /^CH/i;
1408              
1409 0           foreach my $k ( keys( %{$_ccache} ) ) {
  0            
1410 0           my $ck = $k;
1411 0           $ck =~ s/^CH1/$wfm/;
1412 0 0         next unless exists $h->{$ck};
1413 0           $self->{chan_cache}->{$wfm}->{ $_ccache->{$k} } = $h->{$ck};
1414             }
1415             }
1416              
1417             # shared cache values
1418              
1419 0           foreach my $k ( keys( %{$_lcache} ) ) {
  0            
1420 0 0         next unless exists $h->{$k};
1421 0 0         next if $_lcache->{$k} =~ /^\s*$/;
1422 0           $self->{device_cache}->{ $_lcache->{$k} } = $h->{$k};
1423             }
1424             }
1425 0           return $r;
1426             }
1427              
1428              
1429             sub set_setup {
1430 0     0 1   my $self = shift;
1431 0           my ( $setup, $args ) = $self->_check_args_strict( \@_, 'setup' );
1432              
1433             my $cmdlist
1434 0           = scpi_flat( scpi_parse_sequence($setup), $self->{scpi_override} );
1435 0           foreach my $hcmd ( @{$cmdlist} ) {
  0            
1436 0           foreach my $cmd ( keys( %{$hcmd} ) ) {
  0            
1437 0           my $v = $hcmd->{$cmd};
1438 0 0 0       $cmd .= ' ' . $v if defined($v) && $v ne '';
1439 0           $self->write( $cmd, $args );
1440 0           $self->_debug();
1441             }
1442             }
1443             }
1444              
1445              
1446             sub get_acquire_mode {
1447 0     0 1   my $self = shift;
1448 0           my $amode = $self->query("ACQ:MODE?");
1449 0           $amode = $self->_parseReply( $amode, qw(SAM PEAK AVE) );
1450 0           $amode = _bloat(
1451             $amode,
1452             { SAM => 'SAMPLE', PEAK => 'PEAKDETECT', AVE => 'AVERAGE' }
1453             );
1454 0           $self->_debug();
1455 0           return $amode;
1456             }
1457              
1458              
1459             sub set_acquire_mode {
1460 0     0 1   my $self = shift;
1461 0           my ($in) = $self->_check_args_strict( \@_, 'mode' );
1462              
1463 0           my $m;
1464 0 0         if ( $in =~ /^\s*(SAM|NOR)/i ) {
    0          
    0          
1465 0           $m = 'SAM';
1466             }
1467             elsif ( $in =~ /^\s*(PE|PK)/i ) {
1468 0           $m = 'PEAK';
1469             }
1470             elsif ( $in =~ /^\s*AV/i ) {
1471 0           $m = 'AVE';
1472             }
1473             else {
1474 0           Lab::Exception::CorruptParameter->throw(
1475             "Invalid aquire mode '$in'\n");
1476             }
1477 0           $self->write("ACQ:MODE $m");
1478 0           $self->_debug();
1479             }
1480              
1481              
1482             sub get_acquire_numacq {
1483 0     0 1   my $self = shift;
1484 0           my $ans = $self->query("ACQ:NUMAC?");
1485 0           $self->_debug();
1486 0           return $self->_parseReply($ans);
1487             }
1488              
1489              
1490             sub get_acquire_numavg {
1491 0     0 1   my $self = shift;
1492 0           my $ans = $self->query("ACQ:NUMAV?");
1493 0           $self->_debug();
1494 0           return $self->_parseReply($ans);
1495             }
1496              
1497              
1498             sub set_acquire_numavg {
1499 0     0 1   my $self = shift;
1500 0           my ($in) = $self->_check_args_strict( \@_, 'average' );
1501              
1502             # $in =~ s/\D//g;
1503             # $in += 0;
1504              
1505 0 0 0       if ( $in == 4 || $in == 16 || $in == 64 || $in == 128 ) {
      0        
      0        
1506 0           $self->write("ACQ:NUMAV $in");
1507 0           $self->_debug();
1508             }
1509             else {
1510 0           Lab::Exception::CorruptParameter->throw(
1511             "Invalid number to average '$in' [4,16,64,128]\n");
1512             }
1513             }
1514              
1515              
1516             sub get_acquire_state {
1517 0     0 1   my $self = shift;
1518 0           my $st = $self->query("ACQ:STATE?");
1519 0           $self->_debug();
1520              
1521 0           $st = $self->_parseReply($st);
1522 0 0         return 'RUN' if $st =~ /(1|RUN)/i;
1523 0           return 'STOP';
1524             }
1525              
1526              
1527             # note: do not cache, since "single-shot ACQ" can change value asynchronously
1528              
1529             sub set_acquire_state {
1530 0     0 1   my $self = shift;
1531 0           my ($in) = $self->_check_args_strict( \@_, 'state' );
1532 0           my $st;
1533 0 0         if ( $in =~ /^\s*(on|run|Y|t|[1-9])/i ) {
    0          
1534 0           $st = 1;
1535             }
1536             elsif ( $in =~ /^\s*(off|stop|n|f|0)/i ) {
1537 0           $st = 0;
1538             }
1539             else {
1540 0           Lab::Exception::CorruptParameter->throw("Invalid ACQ state '$in' \n");
1541 0           return;
1542             }
1543 0           $self->write("ACQ:STATE $st");
1544 0           $self->_debug();
1545             }
1546              
1547              
1548             sub get_acquire_stopafter {
1549 0     0 1   my $self = shift;
1550 0           my $ans = $self->query("ACQ:STOPA?");
1551 0           $ans = $self->_parseReply( $ans, qw(RUNST SEQ) );
1552 0           $ans = _bloat( $ans, { RUNST => 'RUNSTOP', SEQ => 'SEQUENCE' } );
1553 0           $self->_debug();
1554 0           return $ans;
1555             }
1556              
1557              
1558             sub set_acquire_stopafter {
1559 0     0 1   my $self = shift;
1560 0           my ($in) = $self->_check_args_strict( \@_, 'mode' );
1561              
1562 0           my $m;
1563 0 0         if ( $in =~ /^\s*RU/i ) {
    0          
1564 0           $m = 'RUNST';
1565             }
1566             elsif ( $in =~ /^\s*(SE|SQ)/i ) {
1567 0           $m = 'SEQ';
1568             }
1569             else {
1570 0           Lab::Exception::CorruptParameter->throw(
1571             "Invalid stopafter setting '$in' [4,16,64,128]\n");
1572             }
1573 0           $self->write("ACQ:STOPA $m");
1574 0           $self->_debug();
1575             }
1576              
1577              
1578             sub get_acquire {
1579 0     0 1   my $self = shift;
1580 0           my ($tail) = $self->_check_args( \@_ );
1581 0           my $h = {};
1582              
1583 0           $h->{mode} = $self->get_acquire_mode($tail);
1584 0           $h->{numacq} = $self->get_acquire_numacq($tail);
1585 0           $h->{numavg} = $self->get_acquire_numavg($tail);
1586 0           $h->{state} = $self->get_acquire_state($tail);
1587 0           $h->{stopafter} = $self->get_acquire_stopafter($tail);
1588 0           return $h;
1589             }
1590              
1591              
1592             sub set_acquire {
1593 0     0 1   my $self = shift;
1594 0           my ($tail) = $self->_check_args( \@_ );
1595 0 0         $self->set_acquire_mode($tail) if exists $tail->{mode};
1596 0 0         $self->set_acquire_stopafter($tail) if exists $tail->{stopafter};
1597 0 0         $self->set_acquire_numavg($tail) if exists $tail->{average};
1598 0 0         $self->set_acquire_state($tail) if exists $tail->{state};
1599             }
1600              
1601              
1602             sub get_autorange_state {
1603 0     0 1   my $self = shift;
1604 0           my $ars = $self->query("AUTOR:STATE?");
1605 0           $self->_debug();
1606 0           return $self->_parseReply($ars);
1607             }
1608              
1609              
1610             sub set_autorange_state {
1611 0     0 1   my $self = shift;
1612 0           my ($in) = $self->_check_args_strict( \@_, 'state' );
1613 0           my $b;
1614 0 0         if ( $in =~ /^s*([1-9]|t|y|on)/i ) {
    0          
1615 0           $b = 1;
1616             }
1617             elsif ( $in =~ /^s*(0|f|n|off)/i ) {
1618 0           $b = 0;
1619             }
1620             else {
1621 0           Lab::Exception::CorruptParameter->throw("Invalid boolean '$in' \n");
1622 0           return;
1623             }
1624              
1625 0           $self->write("AUTOR:STATE $b");
1626 0           $self->_debug();
1627             }
1628              
1629              
1630             sub get_autorange_settings {
1631 0     0 1   my $self = shift;
1632 0           my $ars = $self->query("AUTOR:SETT?");
1633 0           $ars = $self->_parseReply( $ars, qw(HOR VERT BOTH) );
1634 0           $ars = _bloat(
1635             $ars,
1636             { HOR => 'HORIZONTAL', VERT => 'VERTICAL', BOTH => 'BOTH' }
1637             );
1638              
1639 0           $self->_debug();
1640 0           return $ars;
1641             }
1642              
1643              
1644             sub set_autorange_settings {
1645 0     0 1   my $self = shift;
1646 0           my ($in) = $self->_check_args_strict( \@_, 'set' );
1647 0           my $ars;
1648 0 0         if ( $in =~ /^\s*(H|X)/i ) {
    0          
    0          
1649 0           $ars = 'HOR';
1650             }
1651             elsif ( $in =~ /^\s*(V|Y)/i ) {
1652 0           $ars = 'VERT';
1653             }
1654             elsif ( $in =~ /^\s*B/i ) {
1655 0           $ars = 'BOTH';
1656             }
1657             else {
1658 0           Lab::Exception::CorruptParameter->throw(
1659             "Invalid autorange setting '$in' \n");
1660             }
1661 0           $self->write("AUTOR:SETT $ars");
1662 0           $self->_debug();
1663             }
1664              
1665              
1666             sub do_autorange {
1667 0     0 1   my $self = shift;
1668 0           $self->write("AUTOS EXEC");
1669 0           $self->_debug();
1670             }
1671              
1672              
1673             sub get_autorange_signal {
1674 0     0 1   my $self = shift;
1675 0           my $sig = $self->query("AUTOS:SIGNAL?");
1676 0           $sig = $self->_parseReply(
1677             $sig,
1678             qw(LEVEL SINE SQUARE VIDPAL VIDNTSC OTHER NON)
1679             );
1680 0 0         $sig = 'NONE' if $sig eq 'NON';
1681 0           $self->_debug();
1682 0           return $sig;
1683             }
1684              
1685              
1686             sub get_autorange_view {
1687 0     0 1   my $self = shift;
1688 0           my $r = $self->query("AUTOS:VIEW?");
1689              
1690 0           $r = $self->_parseReply(
1691             $r,
1692             qw(MULTICY SINGLECY FFT RISING FALLING FIELD ODD EVEN LINE LINEN DCLI DEF NONE)
1693             );
1694 0           $r = _bloat(
1695             $r, {
1696             MULTICY => 'MULTICYCLE', SINGLECY => 'SINGLECYCLE',
1697             FFT => 'FFT', RISING => 'RISINGEDGE',
1698             FALLING => 'FALLINGEDGE', FIELD => 'FIELD', ODD => 'ODD',
1699             EVEN => 'EVEN', LINE => 'LINE', LINEN => 'LINENUM',
1700             DCLI => 'DCLINE', DEF => 'DEFAULT', NON => 'NONE'
1701             }
1702             );
1703 0           $self->_debug();
1704 0           return $r;
1705             }
1706              
1707              
1708             sub set_autorange_view {
1709 0     0 1   my $self = shift;
1710 0           my ($in) = $self->_check_args_strict( \@_, 'view' );
1711 0           my $kw;
1712 0           $in =~ s/^\s*//;
1713              
1714 0 0         if ( $in =~ /^MUL/i ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1715 0           $kw = 'MULTICY';
1716             }
1717             elsif ( $in =~ /^(SING|1)/i ) {
1718 0           $kw = 'SINGLECY';
1719             }
1720             elsif ( $in =~ /^FF/i ) {
1721 0           $kw = 'FFT';
1722             }
1723             elsif ( $in =~ /^(R|\+)/i ) {
1724 0           $kw = 'RISING';
1725             }
1726             elsif ( $in =~ /^(FA|\-)/i ) {
1727 0           $kw = 'FALLING';
1728             }
1729             elsif ( $in =~ /^FIE/i ) {
1730 0           $kw = 'FIELD';
1731             }
1732             elsif ( $in =~ /^OD/i ) {
1733 0           $kw = 'ODD';
1734             }
1735             elsif ( $in =~ /^EV/i ) {
1736 0           $kw = 'EVEN';
1737             }
1738             elsif ( $in =~ /^LINEN/i ) {
1739 0           $kw = 'LINEN';
1740             }
1741             elsif ( $in =~ /^LI/i ) {
1742 0           $kw = 'LINE';
1743             }
1744             elsif ( $in =~ /^DC/i ) {
1745 0           $kw = 'DCLI';
1746             }
1747             elsif ( $in =~ /^DE/i ) {
1748 0           $kw = 'DEF';
1749             }
1750             elsif ( $in =~ /^(NO|0|OF)/i ) {
1751 0           $kw = 'NONE';
1752             }
1753             else {
1754 0           Lab::Exception::CorruptParameter->throw(
1755             "Invalid autorange view '$in' \n");
1756             }
1757              
1758 0           $self->write("AUTOS:VIEW $kw");
1759              
1760 0           my ( $c, $m ) = $self->get_error();
1761 0 0         return if $c == 0;
1762 0           carp("error in set_autorange_view: $c,'$m'");
1763             }
1764              
1765              
1766             sub get_autorange {
1767 0     0 1   my $self = shift;
1768 0           my ($tail) = $self->_check_args( \@_ );
1769              
1770 0           my $h = {};
1771 0           $h->{state} = $self->get_autorange_state($tail);
1772 0           $h->{settings} = $self->get_autorange_settings($tail);
1773 0           $h->{signal} = $self->get_autorange_signal($tail);
1774 0           $h->{view} = $self->get_autorange_view($tail);
1775 0           return $h;
1776             }
1777              
1778              
1779             sub get_channel {
1780 0     0 1   my $self = shift;
1781 0           return $self->{channel};
1782             }
1783              
1784              
1785             sub set_channel {
1786 0     0 1   my $self = shift;
1787 0           my ($ch) = $self->_check_args_strict( \@_, 'channel' );
1788              
1789 0 0         if ( $ch =~ /^\s*MAT/i ) {
    0          
    0          
1790 0           $ch = 'MATH';
1791             }
1792             elsif ( $ch =~ /^\s*(CH[1-4])\s*$/i ) {
1793 0           $ch = uc($1);
1794             }
1795             elsif ( $ch =~ /^\s*([1-4])\s*$/ ) {
1796 0           $ch = "CH${1}";
1797             }
1798             else {
1799 0           Lab::Exception::CorruptParameter->throw(
1800             "Invalid channel '$ch' should be CH1..4 or MATH \n");
1801 0           return;
1802             }
1803 0 0         return if $ch eq $self->{channel}; # already set to that channel
1804              
1805             # store the shared cache entries
1806 0           foreach my $k ( keys( %{ $self->{shared_cache} } ) ) {
  0            
1807 0           $self->{shared_cache}->{$k} = $self->{device_cache}->{$k};
1808             }
1809              
1810             # switch to the per-channel cache of selected channel
1811 0           $self->{device_cache} = $self->{chan_cache}->{$ch};
1812              
1813             # update from shared cache
1814 0           foreach my $k ( keys( %{ $self->{shared_cache} } ) ) {
  0            
1815 0           $self->{device_cache}->{$k} = $self->{shared_cache}->{$k};
1816             }
1817              
1818 0           $self->{channel} = $ch;
1819             }
1820              
1821              
1822             sub get_vertical_settings {
1823 0     0 1   my $self = shift;
1824 0           my ($ch) = $self->_check_args_strict( \@_ ,'channel');
1825            
1826 0 0         if ( $ch =~ /^\s*(CH[1-4])\s*$/i ) {
    0          
    0          
1827 0           $ch = uc($1);
1828             }
1829             elsif ( $ch =~ /^\s*([1-4])\s*$/ ) {
1830 0           $ch = "CH${1}";
1831             }
1832             elsif ( $ch =~ /^\s*MA/i) {
1833 0           $ch = 'MATH';
1834             }
1835             else {
1836 0           Lab::Exception::CorruptParameter->throw(
1837             "Invalid channel '$ch' should be CH1..4 or MATH \n");
1838 0           return;
1839             }
1840              
1841              
1842 0           my $v = $self->get_verbose();
1843 0 0         $self->set_verbose(1) if !$v;
1844 0           my $hd = $self->get_header();
1845 0 0         $self->set_header(1) if !$hd;
1846              
1847 0           my $reply = $self->query("${ch}?");
1848 0 0         $self->set_verbose(0) if !$v;
1849 0 0         $self->set_header(0) if !$hd;
1850 0           return scpi_flat(scpi_parse($reply));
1851             }
1852            
1853              
1854              
1855              
1856             sub set_visible {
1857 0     0 1   my $self = shift;
1858 0           my ( $ch, $ivis ) = $self->_check_args( \@_, qw(channel visible) );
1859              
1860 0 0         $ch = $self->{channel} unless defined $ch;
1861 0 0         $ivis = 1 unless defined $ivis;
1862              
1863 0 0         if ( $ch =~ /^\s*(ch[1-4])\s*$/i ) {
    0          
    0          
    0          
    0          
1864 0           $ch = uc($1);
1865             }
1866             elsif ( $ch =~ /^\s*math\s*$/i ) {
1867 0           $ch = 'MATH';
1868             }
1869             elsif ( $ch =~ /^\s*(ref[a-d])\s*$/i ) {
1870 0           $ch = uc($1);
1871             }
1872             elsif ( $ch =~ /^\s*([1-4])\s*$/ ) {
1873 0           $ch = "CH$1";
1874             }
1875             elsif ( $ch =~ /^\s*([a-d])\s*$/i ) {
1876 0           $ch = "REF$1";
1877             }
1878             else {
1879 0           Lab::Exception::CorruptParameter->throw(
1880             "Invalid channel input '$ch'\n");
1881 0           return;
1882             }
1883              
1884 0           my $vis;
1885 0 0         if ( $ivis =~ /\s*(T|Y|ON|[1-9])/i ) {
    0          
1886 0           $vis = 1;
1887             }
1888             elsif ( $ivis =~ /\s*(F|N|OF|0)/i ) {
1889 0           $vis = 0;
1890             }
1891             else {
1892 0           Lab::Exception::CorruptParameter->throw(
1893             "Invalid boolean input '$ivis'\n");
1894 0           return;
1895             }
1896              
1897 0           my $cache;
1898 0 0         if ( $self->{device_cache}->{LOCKED} ) {
1899 0 0         if ( $ch eq $self->{channel} ) {
1900 0           $cache = $self->{device_channel};
1901             }
1902             else {
1903 0           $cache = $self->{chan_cache}->{$ch};
1904             }
1905 0 0 0       return if defined( $cache->{select} ) && $vis == $cache->{select};
1906             }
1907              
1908 0           $self->write("SEL:$ch $vis");
1909 0           $self->_debug();
1910 0 0         $cache->{select} = $vis if defined $cache;
1911             }
1912              
1913              
1914             sub get_visible {
1915 0     0 1   my $self = shift;
1916 0           my ( $ch, $tail ) = $self->_check_args( \@_, qw(channel) );
1917              
1918             $tail->{read_mode} = $self->{config}->{default_read_mode}
1919 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
1920              
1921 0 0         $ch = $self->{channel} unless defined $ch;
1922              
1923 0 0         if ( $ch =~ /^\s*(ch[1-4])\s*$/i ) {
    0          
    0          
    0          
    0          
1924 0           $ch = uc($1);
1925             }
1926             elsif ( $ch =~ /^\s*math\s*$/i ) {
1927 0           $ch = 'MATH';
1928             }
1929             elsif ( $ch =~ /^\s*(ref[a-d])\s*$/i ) {
1930 0           $ch = uc($1);
1931             }
1932             elsif ( $ch =~ /^\s*([1-4])\s*$/ ) {
1933 0           $ch = "CH$1";
1934             }
1935             elsif ( $ch =~ /^\s*([a-d])\s*$/i ) {
1936 0           $ch = "REF$1";
1937             }
1938             else {
1939 0           Lab::Exception::CorruptParameter->throw(
1940             "Invalid channel input '$ch'\n");
1941 0           return;
1942             }
1943              
1944 0           my $cache;
1945 0 0         if ( $self->{device_cache}->{LOCKED} ) {
1946 0           my $v;
1947 0 0         if ( $ch eq $self->{channel} ) {
1948 0           $cache = $self->{device_cache};
1949             }
1950             else {
1951 0           $cache = $self->{chan_cache}->{$ch};
1952             }
1953             $v = $cache->{select}
1954 0 0         if defined( $cache->{select} );
1955 0 0 0       return $v if defined($v) && $tail->{read_mode} eq 'cache';
1956             }
1957 0           my $r = $self->query("SEL:$ch?");
1958 0           $self->_debug();
1959 0           $r = $self->_parseReply($r);
1960              
1961 0 0         $cache->{select} = $r if defined $cache;
1962 0           return $r;
1963             }
1964              
1965              
1966             sub get_chan_bwlimit {
1967 0     0 1   my $self = shift;
1968 0           my $ch = $self->{channel};
1969              
1970 0 0         return 0 if $ch eq 'MATH';
1971              
1972 0           my $r = $self->query("${ch}:BANDWID?");
1973 0           $self->_debug();
1974 0           return $self->_parseReply($r);
1975             }
1976              
1977              
1978             sub set_chan_bwlimit {
1979 0     0 1   my $self = shift;
1980 0           my ($in) = $self->_check_args_strict( \@_, 'limit' );
1981 0           my $ch = $self->{channel};
1982 0 0         return if $ch eq 'MATH';
1983              
1984 0           my $b;
1985 0 0         if ( $in =~ /^\s*([1-9]|y|t|on)/i ) {
    0          
1986 0           $b = 'ON';
1987             }
1988             elsif ( $in =~ /^\s*(0|n|f|off)/i ) {
1989 0           $b = 'OFF';
1990             }
1991             else {
1992 0           Lab::Exception::CorruptParameter->throw(
1993             "Invalid limit boolean, should be ON|OFF \n");
1994 0           return;
1995             }
1996 0           $self->write("${ch}:BANDWID $b");
1997 0           $self->_debug();
1998             }
1999              
2000              
2001             sub get_chan_coupling {
2002 0     0 1   my $self = shift;
2003 0           my $ch = $self->{channel};
2004              
2005 0 0         return 'GND' if $ch eq 'MATH';
2006 0           my $r = $self->query("${ch}:COUP?");
2007 0           $self->_debug();
2008 0           return $self->_parseReply($r);
2009             }
2010              
2011              
2012             sub set_chan_coupling {
2013 0     0 1   my $self = shift;
2014 0           my ($in) = $self->_check_args_strict( \@_, 'coupling' );
2015 0           my $ch = $self->{channel};
2016              
2017 0 0         return if $ch eq 'MATH';
2018 0           $in = _keyword( $in, qw(AC DC GND) );
2019 0           $self->write("${ch}:COUP $in");
2020 0           $self->_debug();
2021             }
2022              
2023              
2024             sub get_chan_current_probe {
2025 0     0 1   my $self = shift;
2026 0           my $ch = $self->{channel};
2027              
2028 0 0         return 1 if $ch eq 'MATH';
2029 0           my $r = $self->query("${ch}:CURRENTPRO?");
2030 0           $self->_debug();
2031 0           return $self->_parseReply($r);
2032             }
2033              
2034              
2035             sub set_chan_current_probe {
2036 0     0 1   my $self = shift;
2037 0           my ($in) = $self->_check_args_strict( \@_, 'factor' );
2038 0           my $ch = $self->{channel};
2039              
2040 0 0         return if $ch eq 'MATH';
2041 0           my $fact = _parseNRf( $in, 'X' ); # '10x', for example
2042              
2043 0 0 0       if ( $fact =~ /^ERR/i || $fact eq 'MIN' || $fact eq 'MAX' ) {
      0        
2044 0           Lab::Exception::CorruptParameter->throw(
2045             "Error parsing probe factor '$in' \n");
2046 0           return;
2047             }
2048 0           $fact = int( $fact * 10 + 0.5 ) * 0.1;
2049 0 0 0       if ( $fact != 0.2
      0        
      0        
      0        
      0        
      0        
      0        
2050             && $fact != 1
2051             && $fact != 2
2052             && $fact != 5
2053             && $fact != 10
2054             && $fact != 50
2055             && $fact != 100
2056             && $fact != 1000 ) {
2057 0           Lab::Exception::CorruptParameter->throw("Invalid factor '$fact' \n");
2058 0           return;
2059             }
2060 0           $self->write("${ch}:CURRENTPRO $fact");
2061 0           $self->_debug();
2062             }
2063              
2064              
2065             sub get_chan_invert {
2066 0     0 1   my $self = shift;
2067 0           my $ch = $self->{channel};
2068              
2069 0 0         return 0 if $ch eq 'MATH';
2070              
2071 0           my $r = $self->query("${ch}:INV?");
2072 0           $r = $self->_parseReply($r);
2073 0 0         $r = 1 if $r eq 'ON';
2074 0 0         $r = 0 if $r eq 'OFF';
2075 0           $self->_debug();
2076 0           return $r;
2077             }
2078              
2079              
2080             sub set_chan_invert {
2081 0     0 1   my $self = shift;
2082 0           my ($in) = $self->_check_args_strict( \@_, 'invert' );
2083 0           my $ch = $self->{channel};
2084 0 0         return if $ch eq 'MATH';
2085              
2086 0 0         if ( $in =~ /^\s*(on|[1-9]|t|y)/i ) {
    0          
2087 0           $in = 'ON';
2088             }
2089             elsif ( $in =~ /^\s*(off|0|f|n)/i ) {
2090 0           $in = 'OFF';
2091             }
2092             else {
2093 0           Lab::Exception::CorruptParameter->throw(
2094             "Error parsing boolean '$in' \n");
2095 0           return;
2096             }
2097              
2098 0           $self->write("${ch}:INV $in");
2099 0           $self->_debug();
2100             }
2101              
2102              
2103             sub get_chan_position {
2104 0     0 1   my $self = shift;
2105 0           my $ch = $self->{channel};
2106              
2107 0 0         $ch = 'MATH:VER' if $ch eq 'MATH';
2108 0           my $r = $self->query("${ch}:POS?");
2109 0           $self->_debug();
2110 0           return $self->_parseReply($r);
2111             }
2112              
2113              
2114             sub set_chan_position {
2115 0     0 1   my $self = shift;
2116 0           my ($in) = $self->_check_args_strict( \@_, 'position' );
2117 0           my $ch = $self->{channel};
2118              
2119 0           my $p = _parseNRf( $in, 'div' );
2120              
2121 0 0 0       if ( $p =~ /ERR/ || $p eq 'MIN' || $p eq 'MAX' ) {
      0        
2122 0           Lab::Exception::CorruptParameter->throw(
2123             "Error parsing number '$in' \n");
2124 0           return;
2125             }
2126              
2127 0           $p = sprintf( '%.2e', $p );
2128 0           my $scale = $self->get_chan_scale();
2129 0           my $maxv = 2;
2130 0 0         $maxv = 50 if $scale >= 0.5;
2131              
2132 0 0         if ( abs( $p * $scale ) > $maxv ) {
2133 0           Lab::Exception::CorruptParameter->throw(
2134             "Channel position '$p' out of range\n");
2135 0           return;
2136             }
2137              
2138 0 0         $ch = 'MATH:VER' if $ch eq 'MATH';
2139 0           $self->write("${ch}:POS $p");
2140 0           $self->_debug();
2141             }
2142              
2143              
2144             sub get_chan_probe {
2145 0     0 1   my $self = shift;
2146 0           my $ch = $self->{channel};
2147              
2148 0 0         return 1 if $ch eq 'MATH';
2149 0           my $r = $self->query("${ch}:PRO?");
2150 0           $self->_debug();
2151 0           return $self->_parseReply($r);
2152             }
2153              
2154              
2155             sub set_chan_probe {
2156 0     0 1   my $self = shift;
2157 0           my ($in) = $self->_check_args_strict( \@_, 'factor' );
2158 0           my $ch = $self->{channel};
2159              
2160 0 0         return if $ch eq 'MATH';
2161 0           my $fact = _parseNRf( $in, 'x' );
2162              
2163 0 0 0       if ( $fact =~ /ERR/ || $fact eq 'MIN' || $fact eq 'MAX' ) {
      0        
2164 0           Lab::Exception::CorruptParameter->throw(
2165             "Error parsing probe attenuation '$in' \n");
2166 0           return;
2167             }
2168              
2169 0           $fact = int( $fact + 0.2 );
2170 0 0 0       if ( $fact != 1
      0        
      0        
      0        
      0        
      0        
2171             && $fact != 10
2172             && $fact != 20
2173             && $fact != 50
2174             && $fact != 100
2175             && $fact != 500
2176             && $fact != 1000 ) {
2177 0           Lab::Exception::CorruptParameter->throw("Invalid factor '$fact' \n");
2178 0           return;
2179             }
2180 0           $self->write("${ch}:PRO $fact");
2181 0           $self->_debug();
2182             }
2183              
2184              
2185             sub get_chan_scale {
2186 0     0 1   my $self = shift;
2187 0           my $ch = $self->{channel};
2188              
2189 0 0         $ch = 'MATH:VER' if $ch eq 'MATH';
2190 0           my $r = $self->query("${ch}:SCA?");
2191 0           $self->_debug();
2192 0           return $self->_parseReply($r);
2193             }
2194              
2195              
2196             sub set_chan_scale {
2197 0     0 1   my $self = shift;
2198 0           my ($in) = $self->_check_args_strict( \@_, 'scale' );
2199 0           my $ch = $self->{channel};
2200              
2201 0           my $gain = _parseNRf( $in, 'v/div', 'a/div', 'v', 'a' );
2202              
2203 0 0 0       if ( $gain =~ /ERR/ || $gain eq 'MIN' || $gain eq 'MAX' ) {
      0        
2204 0           Lab::Exception::CorruptParameter->throw(
2205             "Error parsing probe attenuation '$in' \n");
2206 0           return;
2207             }
2208              
2209 0 0         if ( $ch ne 'MATH' ) {
2210 0           my $vmin = 2e-3;
2211 0           my $vmax = 5;
2212 0           my $probe;
2213 0           my $y = $self->get_chan_yunit();
2214 0 0         if ( $y eq 'V' ) {
2215 0           $probe = $self->get_chan_probe();
2216             }
2217             else {
2218 0           $probe = $self->get_chan_currentprobe();
2219             }
2220 0           $vmin *= $probe;
2221 0           $vmax *= $probe;
2222 0           $gain = sprintf( '%.3e', $gain );
2223              
2224 0 0 0       if ( $gain > $vmax || $gain < $vmin ) {
2225 0           Lab::Exception::CorruptParameter->throw(
2226             "Vertical scale '$in' out of range\n");
2227 0           return;
2228             }
2229             }
2230             else {
2231 0 0         if ( $gain <= 0 ) {
2232 0           Lab::Exception::CorruptParameter->throw(
2233             "Vertical scale '$in' out of range\n");
2234 0           return;
2235             }
2236             }
2237              
2238 0 0         $ch = 'MATH:VER' if $ch eq 'MATH';
2239 0           $self->write("${ch}:SCA $gain");
2240 0           $self->_debug();
2241             }
2242              
2243              
2244             sub get_chan_yunit {
2245 0     0 1   my $self = shift;
2246 0           my $ch = $self->{channel};
2247 0 0         return 'V' if $ch eq 'MATH';
2248              
2249 0           my $r = $self->query("${ch}:YUN?");
2250 0           $self->_debug();
2251 0           return $self->_parseReply($r);
2252             }
2253              
2254              
2255             sub set_chan_yunit {
2256 0     0 1   my $self = shift;
2257 0           my ($in) = $self->_check_args_strict( \@_, 'unit' );
2258 0           my $ch = $self->{channel};
2259              
2260 0 0         return if $ch eq 'MATH';
2261 0           my $y;
2262 0 0         if ( $in =~ /^\s*V/i ) {
    0          
2263 0           $y = 'V';
2264             }
2265             elsif ( $in =~ /^\s*A/i ) {
2266 0           $y = 'A';
2267             }
2268             else {
2269 0           Lab::Exception::CorruptParameter->throw("Invalid yunit '$in' \n");
2270 0           return;
2271             }
2272              
2273 0           $self->write("${ch}:YUN $y");
2274 0           $self->_debug();
2275             }
2276              
2277              
2278             sub get_chan_setup {
2279 0     0 1   my $self = shift;
2280              
2281 0           my ($tail) = $self->_check_args( \@_ );
2282              
2283 0 0         $self->set_channel($tail) if exists( $tail->{channel} );
2284              
2285 0           my $ch = $self->{channel};
2286 0           my $h = {};
2287 0           $h->{channel} = $ch;
2288 0           $h->{scale} = $self->get_scale($tail);
2289 0           $h->{position} = $self->get_position($tail);
2290 0           $h->{invert} = $self->get_invert($tail);
2291 0           $h->{coupling} = $self->get_coupling($tail);
2292 0           $h->{bandwidth} = $self->get_bandwidth($tail);
2293 0           $h->{yunit} = $self->get_yunit($tail);
2294 0           $h->{probe} = $self->get_probe($tail);
2295 0           $h->{currentprobe} = $self->get_current_probe($tail);
2296 0 0         $h->{definition} = $self->get_math_definition($tail) if $ch eq 'MATH';
2297              
2298 0           return $h;
2299             }
2300              
2301              
2302             sub set_chan_setup {
2303 0     0 1   my $self = shift;
2304              
2305 0           my ($tail) = $self->_check_args( \@_ );
2306              
2307 0 0         $self->set_channel($tail) if exits( $tail->{channel} );
2308              
2309             $self->set_chan_coupling($tail)
2310 0 0         if exists( $tail->{coupling} );
2311             $self->set_chan_invert($tail)
2312 0 0         if exists( $tail->{invert} );
2313             $self->set_chan_yunit($tail)
2314 0 0         if exists( $tail->{yunit} );
2315             $self->set_chan_probe($tail)
2316 0 0         if exists( $tail->{probe} );
2317             $self->set_chan_currentprobe($tail)
2318 0 0         if exists( $tail->{currentprobe} );
2319             $self->set_chan_scale($tail)
2320 0 0         if exists( $tail->{scale} );
2321             $self->set_chan_position($tail)
2322 0 0         if exists( $tail->{position} );
2323             $self->set_math_definition($tail)
2324 0 0         if exists( $tail->{math_definition} );
2325              
2326             }
2327              
2328              
2329             sub get_cursor_type {
2330 0     0 1   my $self = shift;
2331 0           my ($opt) = $self->_check_args( \@_, ['option'] );
2332 0 0         $opt = '' unless defined($opt);
2333 0 0         $opt = 'XY' if $opt =~ /\s*x/i;
2334              
2335 0           my $r = $self->query("CURS:FUNC?");
2336 0           $r = $self->_parseReply( $r, qw(OFF HBA VBA) );
2337              
2338 0 0         if ( $opt eq 'XY' ) {
2339 0           $r = _bloat( $r, { OFF => 'OFF', HBA => 'Y', VBA => 'X' } );
2340             }
2341             else {
2342 0           $r = _bloat( $r, { OFF => 'OFF', HBA => 'HBARS', VBA => 'VBARS' } );
2343             }
2344 0           $self->_debug();
2345 0           return $r;
2346             }
2347              
2348              
2349             sub set_cursor_type {
2350 0     0 1   my $self = shift;
2351 0           my ($in) = $self->_check_args_strict( \@_, 'type' );
2352              
2353 0           my $dform = $self->get_display_format();
2354              
2355 0           my $c;
2356 0 0         if ( $in =~ /^\s*(OFF|N|F|0)/i ) {
    0          
    0          
2357 0           $c = 'OFF';
2358             }
2359             elsif ( $in =~ /^\s*(H|y)/i ) {
2360 0           $c = 'HBA';
2361             }
2362             elsif ( $in =~ /^\s*(V|x)/i ) {
2363 0           $c = 'VBA';
2364             }
2365             else {
2366 0           Lab::Exception::CorruptParameter->throw(
2367             "Invalid cursor selection '$in' \n");
2368 0           return;
2369             }
2370 0 0 0       if ( $dform eq 'XY' && $c ne 'OFF' ) {
2371 0           Lab::Exception::CorruptParameter->throw(
2372             "Invalid cursor selection '$in' for XY display\n");
2373 0           return;
2374             }
2375              
2376 0           $self->write("CURS:FUNC $c");
2377 0           $self->_debug();
2378             }
2379              
2380              
2381             sub get_cursor_xunits {
2382 0     0 1   my $self = shift;
2383              
2384             # trigger view error
2385              
2386 0           my $r = '';
2387 0           $r = $self->query("CURS:VBA:UNI?");
2388 0           $r = $self->_parseReply( $r, qw(SECO HER) );
2389 0           $r = _bloat( $r, { SECO => 'SECONDS', HER => 'HERTZ' } );
2390              
2391 0           $self->_debug();
2392 0           return $r;
2393             }
2394              
2395              
2396             sub get_cursor_yunits {
2397 0     0 1   my $self = shift;
2398              
2399             # trigger view error
2400              
2401 0           my $r = '';
2402 0           $r = $self->query("CURS:HBA:UNI?");
2403 0           $r = $self->_parseReply(
2404             $r, qw(VOL DIV DECIBELS UNKNOWN AMPS
2405             VOLTSSQUARED AMPSSQUARED VOLTSAMPS)
2406             );
2407 0           $r = _bloat( $r, { VOL => 'VOLTS', DIV => 'DIVISIONS' } );
2408 0           $self->_debug();
2409 0           return $r;
2410             }
2411              
2412              
2413             sub get_cursor_source {
2414 0     0 1   my $self = shift;
2415 0           my $r = $self->query("CURS:SEL:SOU?");
2416 0           $self->_debug();
2417 0           return $self->_parseReply($r);
2418             }
2419              
2420              
2421             sub set_cursor_source {
2422 0     0 1   my $self = shift;
2423 0           my ($ich) = $self->_check_args_strict( \@_, ['channel'] );
2424              
2425 0           my $ch = $ich;
2426 0           $ch =~ s/^\s+//;
2427 0 0         if ( $ich =~ /^([\d\.]+)/i ) {
2428 0           $ch = "CH$1";
2429             }
2430              
2431 0 0 0       if ( $ch !~ /^CH[1-4]$/i
      0        
2432             && $ch !~ /^MATH$/i
2433             && $ch !~ /^REF[a-d]$/i ) {
2434 0           Lab::Exception::CorruptParameter->throw("Invalid channel '$ch'\n");
2435 0           return;
2436             }
2437 0           $ch = uc($ch);
2438              
2439 0           $self->write("CURS:SEL:SOU $ch");
2440 0           $self->_debug();
2441             }
2442              
2443              
2444             sub set_cursor_xunits {
2445 0     0 1   my $self = shift;
2446 0           my ($in) = $self->_check_args_strict( \@_, 'unit' );
2447              
2448 0           my $u;
2449 0 0 0       if ( $in =~ /^\s*s/i ) {
    0          
2450 0           $u = 'SECO';
2451             }
2452             elsif ( $in =~ /^\s*her/i || $in =~ /^\s*Hz/i ) {
2453 0           $u = 'HER';
2454             }
2455             else {
2456 0           Lab::Exception::CorruptParameter->throw(
2457             "Invalid cursor unit selection '$in' \n");
2458 0           return;
2459             }
2460 0           $self->write("CURS:VBA:UNI $u");
2461 0           $self->_debug();
2462             }
2463              
2464              
2465             sub get_cursor_dx {
2466 0     0 1   my $self = shift;
2467              
2468             # trigger view error
2469              
2470 0           my $r = $self->query("CURS:VBA:DELT?");
2471 0           $self->_debug();
2472 0           return $self->_parseReply($r);
2473             }
2474              
2475              
2476             sub get_cursor_dy {
2477 0     0 1   my $self = shift;
2478              
2479             # trigger view error
2480              
2481 0           my $r = $self->query("CURS:HBA:DELT?");
2482 0           $self->_debug();
2483 0           return $self->_parseReply($r);
2484             }
2485              
2486              
2487             sub get_cursor_x1 {
2488 0     0 1   my $self = shift;
2489              
2490 0           my $r = $self->query("CURS:VBA:POSITION1?");
2491 0           $self->_debug();
2492 0           return $self->_parseReply($r);
2493             }
2494              
2495              
2496             sub get_cursor_x2 {
2497 0     0 1   my $self = shift;
2498              
2499 0           my $r = $self->query("CURS:VBA:POSITION2?");
2500 0           $self->_debug();
2501 0           return $self->_parseReply($r);
2502             }
2503              
2504              
2505             sub get_cursor_y1 {
2506 0     0 1   my $self = shift;
2507              
2508             # error if trigger view active
2509 0           my $r = $self->query("CURS:HBA:POSITION1?");
2510 0           $self->_debug();
2511 0           return $self->_parseReply($r);
2512             }
2513              
2514              
2515             sub get_cursor_y2 {
2516 0     0 1   my $self = shift;
2517              
2518             # error trigger view
2519 0           my $r = $self->query("CURS:HBA:POSITION2?");
2520 0           $self->_debug();
2521 0           return $self->_parseReply($r);
2522             }
2523              
2524              
2525             sub set_cursor_x1 {
2526 0     0 1   my $self = shift;
2527 0           my ($ipos) = $self->_check_args_strict( \@_, ['position'] );
2528 0           $self->_set_cursor( 'VBA', 1, $ipos );
2529             }
2530              
2531              
2532             sub set_cursor_x2 {
2533 0     0 1   my $self = shift;
2534 0           my ($ipos) = $self->_check_args_strict( \@_, ['position'] );
2535 0           $self->_set_cursor( 'VBA', 2, $ipos );
2536             }
2537              
2538              
2539             sub set_cursor_y1 {
2540 0     0 1   my $self = shift;
2541 0           my ($ipos) = $self->_check_args_strict( \@_, ['position'] );
2542 0           $self->_set_cursor( 'HBA', 1, $ipos );
2543             }
2544              
2545              
2546             sub set_cursor_y2 {
2547 0     0 1   my $self = shift;
2548 0           my ($ipos) = $self->_check_args_strict( \@_, ['position'] );
2549 0           $self->_set_cursor( 'HBA', 2, $ipos );
2550             }
2551              
2552             # setting cursors has a lot of 'common' code, so
2553             # do it here
2554             # $self->_set_cursor(VBA|HBA,1|2,position);
2555             #
2556              
2557             sub _set_cursor {
2558 0     0     my $self = shift;
2559 0           my $t = shift;
2560 0           my $c = shift;
2561 0           my $ipos = shift;
2562              
2563 0           my $pos;
2564              
2565 0 0         if ( $t eq 'HBA' ) {
2566 0           my $u = $self->get_cursor_units();
2567              
2568             # VOL, AMPS , DECIBELS, DIV, UNKNOWN, VOLTSSQUARE, ampssquared, voltsamps
2569 0           my $u2 = '';
2570 0           my $u3 = '';
2571 0 0         $u2 = 'V' if $u eq 'VOL';
2572 0 0         $u2 = 'A' if $u eq 'AMPS';
2573 0 0         $u2 = 'dB' if $u eq 'DECIBELS';
2574 0 0         $u3 = 'dBV' if $u eq 'DECIBELS';
2575 0 0         $u2 = 'V.V' if $u eq 'VOLTSSQUARED';
2576 0 0         $u2 = 'A.A' if $u eq 'AMPSSQUARED';
2577 0 0         $u2 = 'W' if $u eq 'VOLTSAMPS';
2578 0 0         $u3 = 'V.A' if $u eq 'VOLTSAMPS';
2579              
2580 0           $pos = _parseNRf( $ipos, $u, $u2, $u3 );
2581             }
2582             else {
2583 0           my $u = $self->get_cursor_units();
2584              
2585             # SECO HER
2586 0           my $u2 = '';
2587 0           my $u3 = '';
2588 0 0         $u2 = 'seconds' if $u eq 'SECO';
2589 0 0         $u3 = 's' if $u eq 'SECO';
2590 0 0         $u2 = 'hertz' if $u eq 'HER';
2591 0 0         $u3 = 'hz' if $u eq 'HER';
2592 0           $pos = _parseNRf( $ipos, $u, $u2, $u3 );
2593             }
2594 0 0 0       if ( $pos =~ /ERR/ || $pos eq 'MIN' || $pos eq 'MAX' ) {
      0        
2595 0           Lab::Exception::CorruptParameter->throw(
2596             "Error parsing position '$ipos' \n");
2597 0           return;
2598             }
2599 0           $self->write("CURS:${t}:POSITION${c} $pos");
2600 0           $self->_debug();
2601             }
2602              
2603              
2604             sub get_cursor_v1 {
2605 0     0 1   my $self = shift;
2606              
2607 0           my $r = $self->query("CURS:VBA:HPOS1?");
2608 0           $self->_debug();
2609 0           return $self->_parseReply($r);
2610             }
2611              
2612              
2613             sub get_cursor_v2 {
2614 0     0 1   my $self = shift;
2615              
2616 0           my $r = $self->query("CURS:VBA:HPOS2?");
2617 0           $self->_debug();
2618 0           return $self->_parseReply($r);
2619             }
2620              
2621              
2622             sub get_cursor_dv {
2623 0     0 1   my $self = shift;
2624 0           my $r = $self->query("CURS:VBA:VDELT?");
2625 0           $self->_debug();
2626 0           return $self->_parseReply($r);
2627             }
2628              
2629              
2630             sub get_cursor {
2631 0     0 1   my $self = shift;
2632 0           my ($tail) = $self->_check_args( \@_ );
2633 0           my $h = {};
2634              
2635             # errors if trigger view active...
2636 0           $h->{type} = $self->get_cursor_type($tail);
2637 0           $h->{xunits} = $self->get_cursor_xunits($tail);
2638 0           $h->{yunits} = $self->get_cursor_yunits($tail);
2639 0           $h->{source} = $self->get_cursor_source($tail);
2640 0           $h->{dx} = $self->get_cursor_dx($tail);
2641 0           $h->{dy} = $self->get_cursor_dy($tail);
2642 0           $h->{dv} = $self->get_cursor_dv($tail);
2643 0           $h->{x1} = $self->get_cursor_x1($tail);
2644 0           $h->{y1} = $self->get_cursor_y1($tail);
2645 0           $h->{x2} = $self->get_cursor_x2($tail);
2646 0           $h->{y2} = $self->get_cursor_y2($tail);
2647 0           $h->{v1} = $self->get_cursor_v1($tail);
2648 0           $h->{v2} = $self->get_cursor_v2($tail);
2649 0           return $h;
2650             }
2651              
2652              
2653             sub set_cursor {
2654 0     0 1   my $self = shift;
2655 0           my ($tail) = $self->_check_args( \@_ );
2656              
2657 0 0         $self->set_cursor_type($tail) if exists( $tail->{type} );
2658 0 0         $self->set_cursor_yunits($tail) if exists( $tail->{yunits} );
2659 0 0         $self->set_cursor_source($tail) if exists( $tail->{source} );
2660 0 0         $self->set_cursor_x1($tail) if exists( $tail->{x1} );
2661 0 0         $self->set_cursor_x2($tail) if exists( $tail->{x2} );
2662 0 0         $self->set_cursor_y1($tail) if exists( $tail->{y1} );
2663 0 0         $self->set_cursor_y2($tail) if exists( $tail->{y2} );
2664             }
2665              
2666              
2667             sub get_display_contrast {
2668 0     0 1   my $self = shift;
2669 0           my $r = $self->query("DIS:CONTR?");
2670 0           $self->_debug();
2671 0           return $self->_parseReply($r);
2672             }
2673              
2674              
2675             sub set_display_contrast {
2676 0     0 1   my $self = shift;
2677 0           my ($cont) = $self->_check_args_strict( \@_, 'contrast' );
2678 0           $cont = int( $cont + 0.5 );
2679 0 0 0       if ( $cont < 1 || $cont > 100 ) {
2680 0           Lab::Exception::CorruptParameter->throw(
2681             "Contrast out of range 1..100 \n");
2682 0           return;
2683             }
2684 0           $self->write("DIS:CONTR $cont");
2685 0           $self->_debug();
2686             }
2687              
2688              
2689             sub get_display_format {
2690 0     0 1   my $self = shift;
2691 0           my $f = $self->query("DIS:FORM?");
2692 0           $self->_debug();
2693 0           return $f;
2694             }
2695              
2696              
2697             sub set_display_format {
2698 0     0 1   my $self = shift;
2699 0           my ($f) = $self->_check_args_strict( \@_, 'format' );
2700 0           $f = _keyword( $f, qw(XY YT) );
2701 0           $self->write("DIS:FORM $f");
2702 0           $self->_debug();
2703              
2704 0 0         if ( $f eq 'XY' ) {
2705 0           $self->{device_cache}->{cursor_type} = 'OFF';
2706             }
2707             }
2708              
2709              
2710             sub get_display_persist {
2711 0     0 1   my $self = shift;
2712 0           my $r = $self->query("DIS:PERS?");
2713 0           $r = $self->_parseReply($r);
2714 0 0         $r = 'OFF' if $r eq '0';
2715 0 0         $r = 'INF' if $r eq '99';
2716 0           $self->_debug();
2717 0           return $r;
2718             }
2719              
2720              
2721             sub set_display_persist {
2722 0     0 1   my $self = shift;
2723 0           my ($pers) = $self->_check_args_strict( \@_, 'persist' );
2724 0           my $p;
2725              
2726 0 0         if ( $pers =~ /^\s*(INF|MAX)/i ) {
    0          
2727 0           $p = 'INF';
2728             }
2729             elsif ( $pers =~ /^\s*(OFF|MIN|F|N|0)/i ) {
2730 0           $p = 'OFF';
2731             }
2732             else {
2733 0           $p = _parseNRf( $pers, 's' );
2734 0 0 0       if ( $p =~ /ERR/i || ( $p != 1 && $p != 2 && $p != 5 ) ) {
      0        
      0        
2735 0           Lab::Exception::CorruptParameter->throw(
2736             "Invalid persistance '$pers'\n");
2737 0           return;
2738             }
2739             }
2740 0           $self->write("DIS:PERS $p");
2741 0           $self->_debug();
2742             }
2743              
2744              
2745             sub get_display_style {
2746 0     0 1   my $self = shift;
2747 0           my $r = $self->query("DIS:STY?");
2748 0           $r = $self->_parseReply( $r, qw(DOT VEC) );
2749 0           $r = _bloat( $r, { DOT => 'DOTS', VEC => 'VECTORS' } );
2750 0           $self->_debug();
2751 0           return $r;
2752             }
2753              
2754              
2755             sub set_display_style {
2756 0     0 1   my $self = shift;
2757 0           my ($st) = $self->_check_args_strict( \@_, 'style' );
2758 0           $st = _keyword( $st, qw(DOT VEC) );
2759 0           $self->write("DIS:STY $st");
2760 0           $self->_debug();
2761             }
2762              
2763              
2764             sub get_display {
2765 0     0 1   my $self = shift;
2766 0           my ($tail) = $self->_check_args( \@_ );
2767 0           my $h = {};
2768 0           $h->{contrast} = $self->get_display_contrast($tail);
2769 0           $h->{format} = $self->get_display_format($tail);
2770 0           $h->{persist} = $self->get_display_persist($tail);
2771 0           $h->{style} = $self->get_display_style($tail);
2772 0           return $h;
2773             }
2774              
2775              
2776             sub set_display {
2777 0     0 1   my $self = shift;
2778 0           my ($tail) = $self->_check_args( \@_ );
2779 0 0         $self->set_display_contrast($tail) if exists $tail->{contrast};
2780 0 0         $self->set_display_format($tail) if exists $tail->{format};
2781 0 0         $self->set_display_persist($tail) if exists $tail->{persist};
2782 0 0         $self->set_display_style($tail) if exists $tail->{style};
2783             }
2784              
2785              
2786             sub get_cwd {
2787 0     0 1   my $self = shift;
2788 0           my $r = $self->query("FILES:CWD?");
2789 0           $self->_debug();
2790 0           return $self->_parseReply($r);
2791             }
2792              
2793              
2794             sub set_cwd {
2795 0     0 1   my $self = shift;
2796 0           my ($icwd) = $self->_check_args_strict( \@_, ['cwd'] );
2797              
2798 0           my $cwd = $icwd;
2799 0           $cwd =~ s/\//\\/g;
2800 0           $self->write("FILES:CWD $cwd");
2801 0           $self->_debug();
2802             }
2803              
2804              
2805             sub delete {
2806 0     0 1   my $self = shift;
2807 0           my ($file) = $self->_check_args_strict( \@_, ['file'] );
2808              
2809 0           $file =~ tr{/}{\\};
2810              
2811 0           $self->write("FILES:DELE \"$file\"");
2812 0           $self->_debug();
2813             }
2814              
2815              
2816             sub get_dir {
2817 0     0 1   my $self = shift;
2818 0           my $r = $self->query("FILES:DIR?");
2819 0           $r = $self->_parseReply($r);
2820 0           $self->_debug();
2821 0           return _parseStrings($r);
2822             }
2823              
2824             sub _parseStrings {
2825 0     0     my $str = shift;
2826 0           my (@results) = ();
2827 0 0         return (@results) unless defined $str;
2828 0           $str =~ s/^\s+//;
2829 0 0         $str .= ' ,' if $str !~ /,\s*$/;
2830 0           my $x;
2831              
2832 0           while ( $str ne '' ) {
2833 0 0         last if $str =~ /^\s*,?\s*$/;
2834 0 0         if ( $str =~ /^\"(([^\"]|\"\")+)\"\s*,/i ) {
    0          
    0          
2835 0           $x = $1;
2836 0           $x =~ s/\"\"/"/g;
2837 0           $str = $POSTMATCH;
2838 0           push( @results, $x );
2839             }
2840             elsif ( $str =~ /^\'(([^\']|\'\')+)\'\s*,/i ) {
2841 0           $x = $1;
2842 0           $x =~ s/\'\'/'/g;
2843 0           $str = $POSTMATCH;
2844 0           push( @results, $x );
2845             }
2846             elsif ( $str =~ /^([^,]*[^,\s])\s*,/i ) {
2847 0           $x = $1;
2848 0           $str = $POSTMATCH;
2849 0           push( @results, $x );
2850             }
2851             else {
2852 0           carp("problems parsing strings '$str'");
2853 0           last;
2854             }
2855 0           $str =~ s/^\s+//;
2856             }
2857 0           return (@results);
2858             }
2859              
2860              
2861             sub get_freespace {
2862 0     0 1   my $self = shift;
2863 0           my $r = $self->query("FILES:FREES?");
2864 0           $self->_debug();
2865 0           return $self->parseReply($r);
2866             }
2867              
2868              
2869             sub mkdir {
2870 0     0 1   my $self = shift;
2871 0           my ($d) = $self->_check_args_strict( \@_, ['directory'] );
2872              
2873 0           $d =~ tr{/}{\\};
2874              
2875 0           $self->write("FILES:MKD \"$d\"");
2876 0           $self->_debug();
2877             }
2878              
2879              
2880             sub rename {
2881 0     0 1   my $self = shift;
2882 0           my ( $old, $new ) = $self->_check_args_strict( \@_, qw(old new) );
2883              
2884 0           $old =~ tr{/}{\\};
2885 0           $new =~ tr{/}{\\};
2886              
2887 0           $self->write("FILES:REN \"$old\",\"$new\"");
2888 0           $self->_debug();
2889             }
2890              
2891              
2892             sub rmdir {
2893 0     0 1   my $self = shift;
2894 0           my ($d) = $self->_check_args_strict( \@_, ['directory'] );
2895              
2896 0           $d =~ tr{/}{\\};
2897 0           $self->write("FILES:RMD \"$d\"");
2898 0           $self->_debug();
2899             }
2900              
2901              
2902             sub get_hardcopy_format {
2903 0     0 1   my $self = shift;
2904              
2905 0           my $r = $self->query("HARDC:FORM?");
2906 0           $r = $self->_parseReply(
2907             $r, qw( BMP BUBBLEJ DESKJ DPU3445
2908             DPU411 DPU412 EPSC60 EPSC80 EPSIMAGE EPSO INTERLEAF
2909             JPEG LASERJ PCX RLE THINK TIFF)
2910             );
2911 0           $self->_debug();
2912 0           return _bloat(
2913             $r, {
2914             BUBBLEJ => 'BUBBLEJET', DESKJ => 'DESKJET',
2915             EPSO => 'EPSON', THINK => 'THINKJET'
2916             }
2917             );
2918             }
2919              
2920              
2921             sub set_hardcopy_format {
2922 0     0 1   my $self = shift;
2923 0           my ($in) = $self->_check_args_strict( \@_, ['format'] );
2924 0           my $f;
2925              
2926 0           $in =~ s/^\s*//;
2927 0 0         if ( $in =~ /^BMP/i ) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
2928 0           $f = 'BMP';
2929             }
2930             elsif ( $in =~ /^(BUB|BJ)/i ) {
2931 0           $f = 'BUBBLEJ';
2932             }
2933             elsif ( $in =~ /^(DESKJ|DJ)/i ) {
2934 0           $f = 'DESKJ';
2935             }
2936             elsif ( $in =~ /^DPU3/i ) {
2937 0           $f = 'DPU3445';
2938             }
2939             elsif ( $in =~ /^DPU411/i ) {
2940 0           $f = 'DPU411';
2941             }
2942             elsif ( $in =~ /^DPU412/i ) {
2943 0           $f = 'DPU412';
2944             }
2945             elsif ( $in =~ /^(EPSC6|EPSON\s*(S(TYLUS)?)?\s*C6)/i ) {
2946 0           $f = 'EPSC60';
2947             }
2948             elsif ( $in =~ /^(EPSC8|EPSON\s*(S(TYLUS)?)?\s*C8)/i ) {
2949 0           $f = 'EPSC80';
2950             }
2951             elsif ( $in =~ /^epso/i ) {
2952 0           $f = 'EPSO';
2953             }
2954             elsif ( $in =~ /^(eps|post)/i ) {
2955 0           $f = 'EPSIMAGE';
2956             }
2957             elsif ( $in =~ /^INTER/i ) {
2958 0           $f = 'INTERLEAF';
2959             }
2960             elsif ( $in =~ /^JP/i ) {
2961 0           $f = 'JPEG';
2962             }
2963             elsif ( $in =~ /^(LASER|LJ)/i ) {
2964 0           $f = 'LASERJ';
2965             }
2966             elsif ( $in =~ /^PCX/i ) {
2967 0           $f = 'PCX';
2968             }
2969             elsif ( $in =~ /^RLE/i ) {
2970 0           $f = 'RLE';
2971             }
2972             elsif ( $in =~ /^THIN/i ) {
2973 0           $f = 'THINK';
2974             }
2975             elsif ( $in =~ /^TIF/i ) {
2976 0           $f = 'TIFF';
2977             }
2978             else {
2979 0           Lab::Exception::CorruptParameter->throw(
2980             "Invalid hardcopy format '$in'\n");
2981 0           return;
2982             }
2983              
2984 0           $self->write("HARDC:FORM $f");
2985 0           $self->_debug();
2986             }
2987              
2988              
2989             sub get_hardcopy_layout {
2990 0     0 1   my $self = shift;
2991 0           my $r = $self->query("HARDC:LAY?");
2992 0           $r = $self->_parseResponse( $r, qw(PORTR LAN) );
2993 0           $self->_debug();
2994 0           return _bloat( $r, { PORTR => 'PORTRAIT', LAN => 'LANDSCAPE' } );
2995             }
2996              
2997              
2998             sub set_hardcopy_layout {
2999 0     0 1   my $self = shift;
3000 0           my ($in) = $self->_check_args_strict( \@_, ['layout'] );
3001 0           my $lay;
3002              
3003 0 0         if ( $in =~ /^\s*(P|N)/i ) {
    0          
3004 0           $lay = 'PORTR';
3005             }
3006             elsif ( $in =~ /^\s*(L|R)/i ) {
3007 0           $lay = 'LAN';
3008             }
3009             else {
3010 0           Lab::Exception::CorruptParameter->throw(
3011             "Invalid hardcopy layout '$in'\n");
3012 0           return;
3013             }
3014 0           $self->write("HARDC:LAY $lay");
3015 0           $self->_debug();
3016             }
3017              
3018              
3019             sub get_hardcopy_port {
3020 0     0 1   my $self = shift;
3021 0           my $r = $self->query("HARDC:PORT?");
3022 0           $self->_debug();
3023 0           return $self->_parseReply($r);
3024             }
3025              
3026              
3027             sub set_hardcopy_port {
3028 0     0 1   my $self = shift;
3029 0           my ($in) = $self->_check_args_strict( \@_, ['port'] );
3030 0           my $p = _keyword( $in, qw(USB CEN RS232 GPI) );
3031 0 0         if ( $p ne 'USB' ) {
3032 0           Lab::Exception::CorruptParameter->throw(
3033             "Invalid hardcopy port '$in'\n");
3034 0           return;
3035             }
3036 0           $self->write("HARDC:PORT $p");
3037 0           $self->_debug();
3038             }
3039              
3040              
3041             sub get_hardcopy {
3042 0     0 1   my $self = shift;
3043              
3044 0           my $h = {};
3045 0           $h->{format} = $self->get_hardcopy_format();
3046 0           $h->{layout} = $self->get_hardcopy_layout();
3047 0           $h->{port} = $self->get_hardcopy_port();
3048 0           return $h;
3049             }
3050              
3051              
3052             sub set_hardcopy {
3053 0     0 1   my $self = shift;
3054 0           my ($tail) = $self->_check_args( \@_ );
3055 0 0         $self->set_hardcopy_format($tail) if exists $tail->{format};
3056 0 0         $self->set_hardcopy_layout($tail) if exists $tail->{layout};
3057 0 0         $self->set_hardcopy_port($tail) if exists $tail->{port};
3058             }
3059              
3060              
3061             sub get_image {
3062 0     0 1   my $self = shift;
3063 0           my ( $file, $force, $tail ) = $self->_check_args( \@_, qw(file force) );
3064              
3065 0           my $ovr = 0;
3066 0 0         if ( defined($force) ) {
3067 0 0         if ( $force =~ /^\s*(T|[1-9]|Y)/i ) {
    0          
3068 0           $ovr = 1;
3069             }
3070             elsif ( $force =~ /^s*(F|0|N)/i ) {
3071 0           $ovr = 0;
3072             }
3073             else {
3074 0           Lab::Exception::CorruptParameter->throw(
3075             "Invalid 'force overwrite' flag '$force'\n");
3076 0           return;
3077             }
3078             }
3079              
3080             # do file check before image transfer
3081 0 0         if ( defined($file) ) {
3082              
3083 0 0 0       if ( -e $file && ( !$ovr || !-w $file ) ) {
      0        
3084 0           Lab::Exception::CorruptParameter->throw(
3085             "Output file $file exists, not writable, force overwrite not set\n"
3086             );
3087 0           return;
3088             }
3089             }
3090              
3091 0           $self->set_hardcopy($tail);
3092 0           my $head = $self->get_header();
3093 0           $self->set_header(0);
3094              
3095             # default 30s timeout, unlimited length, maybe no \n at end
3096             # note that we really need READ_BUFFER to be set correctly
3097             # for efficient image reading.
3098 0           my $args = {};
3099 0           $args->{timeout} = 30;
3100 0           $args->{read_length} = -1;
3101 0 0         $args->{timeout} = $tail->{timeout} if exists( $tail->{timeout} );
3102            
3103 0           $args->{brutal} = 1; # read to the very end
3104 0           $args->{no_LF} = 1;
3105              
3106 0           my $r;
3107 0           $self->write("HARDC STAR");
3108 0           $r = $self->read($args);
3109 0           $self->set_header($head);
3110              
3111 0 0         carp("No image data read") unless defined($r);
3112 0 0 0       if ( defined($file) && defined($r) ) {
3113 0 0         open( IMG, ">$file" ) || croak("unable to open $file for writing");
3114 0           print IMG $r;
3115 0           close(IMG);
3116             }
3117              
3118 0           return $r;
3119             }
3120              
3121              
3122             sub get_horiz_view {
3123 0     0 1   my $self = shift;
3124 0           my $r = $self->query("HOR:VIEW?");
3125 0           $self->_debug();
3126 0           $r = $self->_parseReply( $r, qw(MAI WINDOW ZONE) );
3127 0           return _bloat( $r, { MAI => 'MAIN' } );
3128             }
3129              
3130              
3131             sub set_horiz_view {
3132 0     0 1   my $self = shift;
3133 0           my ($v) = $self->_check_args_strict( \@_, ['view'] );
3134 0           $v = _keyword( $v, qw(MAI WIN ZON) );
3135 0           $v = _bloat( $v, { WIN => 'WINDOW', ZON => 'ZONE' } );
3136 0           $self->write("HOR:VIEW $v");
3137 0           $self->_debug();
3138             }
3139              
3140              
3141             sub get_horiz_position {
3142 0     0 1   my $self = shift;
3143 0           my $r = $self->query("HOR:POS?");
3144 0           $self->_debug();
3145              
3146 0           return $self->_parseReply($r);
3147             }
3148              
3149              
3150             sub set_horiz_position {
3151 0     0 1   my $self = shift;
3152 0           my ($in) = $self->_check_args_strict( \@_, ['time'] );
3153              
3154 0           my $t = _parseNRf( $in, 's' );
3155 0 0 0       if ( $t eq 'MIN' || $t eq 'MAX' || $t =~ /ERR/ ) {
      0        
3156 0           Lab::Exception::CorruptParameter->throw("Invalid time input '$in'\n");
3157 0           return;
3158             }
3159 0           $t = sprintf( '%.3e', $t );
3160              
3161 0           $self->write("HOR:POS $t");
3162 0           $self->_debug();
3163             }
3164              
3165              
3166             sub get_delay_position {
3167 0     0 1   my $self = shift;
3168 0           my $r = $self->query("HOR:DEL:POS?");
3169 0           $self->_debug();
3170 0           $r = $self->_parseReply($r);
3171 0           return $r;
3172             }
3173              
3174              
3175             sub set_delay_position {
3176 0     0 1   my $self = shift;
3177 0           my ($in) = $self->_check_args_strict( \@_, ['delaytime'] );
3178 0           my $t = _parseNRf( $in, 's' );
3179 0 0 0       if ( $t eq 'MIN' || $t eq 'MAX' || $t =~ /ERR/ ) {
      0        
3180 0           Lab::Exception::CorruptParameter->throw("Invalid time input '$in'\n");
3181 0           return;
3182             }
3183 0           $t = sprintf( '%.3e', $t );
3184 0           $self->write("HOR:DEL:POS $t");
3185 0           $self->_debug();
3186             }
3187              
3188              
3189             sub get_horiz_scale {
3190 0     0 1   my $self = shift;
3191 0           my $r = $self->query("HOR:SCA?");
3192 0           $self->_debug();
3193 0           $r = $self->_parseReply($r);
3194 0           return $r;
3195             }
3196              
3197              
3198             sub set_horiz_scale {
3199 0     0 1   my $self = shift;
3200 0           my ($in) = $self->_check_args_strict( \@_, ['scale'] );
3201              
3202 0           my $s = _parseNRf( $in, 's', 's/div', 'Hz', 'Hz/div' );
3203              
3204 0 0 0       if ( $s eq 'MIN' || $s eq 'MAX' || $s =~ /ERR/ || $s <= 0 ) {
      0        
      0        
3205 0           Lab::Exception::CorruptParameter->throw(
3206             "Invalid time scale input '$in'\n");
3207 0           return;
3208             }
3209              
3210 0           $s = sprintf( '%.2e', $s );
3211 0           my $ss = substr( $s, 0, 4 );
3212 0 0 0       if ( $ss ne '1.00' && $ss ne '2.50' && $ss ne '5.00' ) {
      0        
3213 0           carp("warning: $s will be rounded to nearest acceptable value");
3214             }
3215              
3216 0           $self->write("HOR:SCA $s");
3217 0           $self->_debug();
3218             }
3219              
3220              
3221             sub get_delay_scale {
3222 0     0 1   my $self = shift;
3223 0           my $r = $self->query("HOR:DEL:SCA?");
3224 0           $self->_debug();
3225 0           $r = $self->_parseReply($r);
3226 0           return $r;
3227             }
3228              
3229              
3230             sub set_del_scale {
3231 0     0 1   my $self = shift;
3232 0           my ($in) = $self->_check_args_strict( \@_, ['delayscale'] );
3233              
3234 0           my $s = _parseNRf( $in, 's', 's/div', 'Hz', 'Hz/div' );
3235              
3236 0 0 0       if ( $s eq 'MIN' || $s eq 'MAX' || $s =~ /ERR/ || $s <= 0 ) {
      0        
      0        
3237 0           Lab::Exception::CorruptParameter->throw(
3238             "Invalid time scale input '$in'\n");
3239 0           return;
3240             }
3241              
3242 0           $s = sprintf( '%.2e', $s );
3243 0           my $ss = substr( $s, 0, 4 );
3244 0 0 0       if ( $ss ne '1.00' && $ss ne '2.50' && $ss ne '5.00' ) {
      0        
3245 0           carp("warning: $s will be rounded to nearest acceptable value");
3246             }
3247              
3248 0           $self->write("HOR:DEL:SCA $s");
3249 0           $self->_debug();
3250             }
3251              
3252              
3253             sub get_recordlength {
3254 0     0 1   return 2500;
3255             }
3256              
3257              
3258             sub get_horizontal {
3259 0     0 1   my $self = shift;
3260 0           my ($tail) = $self->_check_args( \@_ );
3261              
3262 0           my $h = {};
3263              
3264 0           $h->{view} = $self->get_horiz_view($tail);
3265 0           $h->{time} = $self->get_horiz_position($tail);
3266 0           $h->{delaytime} = $self->get_delay_position($tail);
3267 0           $h->{scale} = $self->get_horiz_scale($tail);
3268 0           $h->{delayscale} = $self->get_delay_scale($tail);
3269 0           $h->{recordlength} = $self->get_recordlength($tail);
3270              
3271 0           return $h;
3272             }
3273              
3274              
3275             sub set_horizontal {
3276 0     0 1   my $self = shift;
3277 0           my ($tail) = $self->_check_args( \@_ );
3278              
3279 0 0         $self->set_horiz_view($tail) if exists $tail->{view};
3280 0 0         $self->set_horiz_position($tail) if exists $tail->{time};
3281 0 0         $self->set_horiz_scale($tail) if exists $tail->{scale};
3282 0 0         $self->set_delay_position($tail) if exists $tail->{delaytime};
3283 0 0         $self->set_delay_scale($tail) if exists $tail->{delayscale};
3284             }
3285              
3286              
3287             sub get_math_definition {
3288 0     0 1   my $self = shift;
3289 0           my $r = $self->query("MATH:DEFINE?");
3290 0           $self->_debug();
3291              
3292 0 0         if ( $r =~ /^\"/ ) {
    0          
3293 0           $r =~ s/^\"//;
3294 0           $r =~ s/\"$//;
3295 0           $r =~ s/\"\"/"/g;
3296             }
3297             elsif ( $r =~ /^\'/ ) {
3298 0           $r =~ s/^\'//;
3299 0           $r =~ s/\'$//;
3300 0           $r =~ s/\'\'/'/g;
3301             }
3302             else {
3303 0           croak("quoted string error");
3304             }
3305 0           return $r;
3306             }
3307              
3308              
3309             sub set_math_definition {
3310 0     0 1   my $self = shift;
3311 0           my ($in) = $self->_check_args_strict( \@_, ['math'] );
3312              
3313 0           $in =~ s/\s+//g;
3314 0           $in = uc($in);
3315              
3316 0 0         if ( $in =~ /^FFT\(CH(\d)(,\w+)?\)/i ) {
3317 0           my $ch = $1;
3318 0           my $w = '';
3319 0 0 0       $w = substr( $2, 1 ) if defined($2) && $2 ne '';
3320 0 0         $w = ',' . _keyword( $w, qw(HAN FLAT RECT) ) if $w ne '';
3321 0           $self->write("MATH:DEFINE \"FFT(CH${ch}${w})\"");
3322 0           $self->set_channel('MATH');
3323             $self->{device_channel}->{select}
3324             = $self->{chan_cache}->{MATH}->{select}
3325 0           = $self->{chan_cache}->{"CH${ch}"}->{select};
3326 0           $self->{chan_cache}->{"CH${ch}"}->{select} = 0;
3327             }
3328             else {
3329 0           my $c = _keyword(
3330             $in, qw(CH1+CH2 CH3+CH4 CH1–CH2 CH2–CH1
3331             CH3–CH4 CH4–CH3 CH1*CH2 CH3*CH4)
3332             );
3333 0           $self->write("MATH:DEFINE \"${c}\"");
3334             }
3335 0           $self->_debug();
3336             }
3337              
3338              
3339             sub get_math_position {
3340 0     0 1   my $self = shift;
3341 0           my $r = $self->query("MATH:VER:POS?");
3342 0           $self->_debug();
3343 0           $r = $self->_parseReply($r);
3344 0           return _parseNRf($r);
3345             }
3346              
3347              
3348             sub set_math_position {
3349 0     0 1   my $self = shift;
3350 0           my ($in) = $self->_check_args_strict( \@_, ['position'] );
3351              
3352 0           my $y;
3353 0           $y = _parseNRf( $in, 'div', 'divs' );
3354 0 0 0       if ( $y =~ /ERR/ || $y eq 'MIN' || $y eq 'MAX' ) {
      0        
3355 0           Lab::Exception::CorruptParameter->throw(
3356             "Invalid MATH position input '$in'\n");
3357 0           return;
3358             }
3359 0           $self->write("MATH:VER:POS $y");
3360 0           $self->_debug();
3361             }
3362              
3363              
3364             sub get_fft_xposition {
3365 0     0 1   my $self = shift;
3366 0           my $r = $self->query("MATH:FFT:HOR:POS?");
3367 0           $self->_debug();
3368 0           return $self->_parseReply($r);
3369             }
3370              
3371              
3372             sub set_fft_xposition {
3373 0     0 1   my $self = shift;
3374 0           my ($in) = $self->_check_args_strict( \@_, ['fft_xposition'] );
3375              
3376 0           my $p = _parseNRf( $in, '%', 'pct', 'percent' );
3377 0 0         $p = 0 if $p eq 'MIN';
3378 0 0         $p = 100 if $p eq 'MAX';
3379 0 0         $p = sprintf( '%d', $p ) if $p !~ /ERR/;
3380 0 0 0       if ( $p =~ /ERR/ || $p < 0 || $p > 100 ) {
      0        
3381 0           Lab::Exception::CorruptParameter->throw(
3382             "Invalid FFT position input '$in'\n");
3383 0           return;
3384             }
3385 0           $self->write("MATH:FFT:HOR:POS $p");
3386 0           $self->_debug();
3387             }
3388              
3389              
3390             sub get_fft_xscale {
3391 0     0 1   my $self = shift;
3392 0           my $r = $self->query("MATH:FFT:HOR:SCA?");
3393 0           $self->_debug();
3394 0           return $self->_parseReply($r);
3395             }
3396              
3397              
3398             sub set_fft_xscale {
3399 0     0 1   my $self = shift;
3400 0           my ($in) = $self->_check_args_strict( \@_, ['fft_xscale'] );
3401 0           my $z = _parseNRf( $in, 'x' );
3402 0 0         $z = 1 if $z eq 'MIN';
3403 0 0         $z = 10 if $z eq 'MAX';
3404              
3405 0 0 0       if ( $z =~ /ERR/ || $z <= 0 ) {
3406 0           Lab::Exception::CorruptParameter->throw(
3407             "Invalid FFT xscale input '$in'\n");
3408 0           return;
3409             }
3410              
3411 0           my $zoom;
3412 0 0         if ( $z < 1.5 ) {
    0          
    0          
3413 0           $zoom = 1;
3414             }
3415             elsif ( $z < 3.5 ) {
3416 0           $zoom = 2;
3417             }
3418             elsif ( $z < 7.5 ) {
3419 0           $zoom = 5;
3420             }
3421             else {
3422 0           $zoom = 10;
3423             }
3424              
3425 0 0         carp("FFT scale rounded to valid value") if abs( $z - $zoom ) > 0.01;
3426 0           $self->write("MATH:FFT:HOR:SCA $zoom");
3427 0           $self->_debug();
3428             }
3429              
3430              
3431             sub get_fft_position {
3432 0     0 1   my $self = shift;
3433 0           my $r = $self->query("MATH:FFT:VER:POS?");
3434 0           $self->_debug();
3435 0           return _parseReply($r);
3436             }
3437              
3438              
3439             sub set_fft_position {
3440 0     0 1   my $self = shift;
3441 0           my ($in) = $self->_check_args_strict( \@_, ['fft_position'] );
3442 0           my $p = _parseNRf( $in, 'div', 'divs' );
3443              
3444 0 0 0       if ( $p eq 'MIN' || $p eq 'MAX' || $p =~ /ERR/ ) {
      0        
3445 0           Lab::Exception::CorruptParameter->throw(
3446             "Invalid FFT yposition '$in'\n");
3447 0           return;
3448             }
3449 0           $self->write("MATH:FFT:VER:POS $p");
3450 0           $self->_debug();
3451             }
3452              
3453              
3454             sub get_fft_scale {
3455 0     0 1   my $self = shift;
3456 0           my $r = $self->query("MATH:FFT:VER:SCA?");
3457 0           $self->_debug();
3458 0           return _parseReply($r);
3459             }
3460              
3461              
3462             sub set_fft_scale {
3463 0     0 1   my $self = shift;
3464 0           my ($in) = $self->_check_args_strict( \@_, ['fft_scale'] );
3465 0           my $z = _parseNRf( $in, 'x' );
3466              
3467 0 0         $z = 0.5 if $z eq 'MIN';
3468 0 0         $z = 10 if $z eq 'MAX';
3469              
3470 0 0 0       if ( $z =~ /ERR/ || $z <= 0 ) {
3471 0           Lab::Exception::CorruptParameter->throw(
3472             "Invalid fft y scale input '$in'\n");
3473 0           return;
3474             }
3475              
3476 0           my $zoom;
3477 0 0         if ( $z < 0.75 ) {
    0          
    0          
    0          
3478 0           $zoom = 0.5;
3479             }
3480             elsif ( $z < 1.5 ) {
3481 0           $zoom = 1;
3482             }
3483             elsif ( $z < 3.5 ) {
3484 0           $zoom = 2;
3485             }
3486             elsif ( $z < 7.5 ) {
3487 0           $zoom = 5;
3488             }
3489             else {
3490 0           $zoom = 10;
3491             }
3492              
3493 0 0         carp("fft_scale adjusted to valid value") if abs( $z - $zoom ) > 0.01;
3494 0           $self->write("MATH:FFT:VER:POS $zoom");
3495 0           $self->_debug();
3496             }
3497              
3498              
3499             # do our own cache handling, doesn't fit the normal scheme
3500              
3501             sub get_measurement_type {
3502 0     0 1   my $self = shift;
3503 0           my ( $in, $tail ) = $self->_check_args( \@_, ['measurement'] );
3504 0 0         $in = 'IMM' unless defined($in);
3505              
3506 0           my $n;
3507 0 0 0       if ( $in =~ /^\s*imm/i || $in =~ /^\s*$/ ) {
    0          
3508 0           $n = 'imm';
3509             }
3510             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3511 0           $n = $1;
3512 0 0 0       $n = undef if $n < 1 || $n > 5;
3513             }
3514              
3515 0 0         if ( !defined($n) ) {
3516 0           Lab::Exception::CorruptParameter->throw(
3517             "invalid measurement# '$in' \n");
3518 0           return;
3519             }
3520              
3521             $tail->{read_mode} = $self->{config}->{default_read_mode}
3522 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
3523 0 0         $tail->{read_mode} = 'device' if $self->{config}->{no_cache};
3524              
3525 0 0 0       if ( $tail->{read_mode} eq 'cache'
3526             && defined( $self->{device_cache}->{"meas_type_$n"} ) ) {
3527 0           return $self->{device_cache}->{"meas_type_$n"};
3528             }
3529              
3530 0           my $nm;
3531 0 0         if ( $n eq 'imm' ) {
3532 0           $nm = 'IMM';
3533             }
3534             else {
3535 0           $nm = "MEAS$n";
3536             }
3537              
3538 0           my $r = $self->query("MEASU:${nm}:TYP?");
3539 0           $self->_debug();
3540 0           $r = _parseReply(
3541             $r,
3542             qw(FREQ MEAN PERI PHA PK2 CRM MINI MAXI RIS FALL PW NWI NONE)
3543             );
3544              
3545 0           $r = _bloat(
3546             $r, {
3547             FREQ => 'FREQUENCY', PERI => 'PERIOD', PHA => 'PHASE',
3548             PK2 => 'PK2PK', CRM => 'CRMS', MINI => 'MINIMUM',
3549             MAXI => 'MAXIMUM', RIS => 'RISE', PWD => 'PWIDTH',
3550             NWI => 'NWIDTH'
3551             }
3552             );
3553 0           $self->{device_cache}->{"meas_type_$n"} = $r;
3554 0           return $r;
3555             }
3556              
3557              
3558             sub set_measurement_type {
3559 0     0 1   my $self = shift;
3560 0           my ( $in, $type, $tail )
3561             = $self->_check_args( \@_, qw(measurement measurement_type) );
3562              
3563 0 0 0       if ( !defined($in) || $in =~ /^\s*$/ ) {
    0          
3564 0           $in = 'IMM';
3565             }
3566             elsif ( !defined($type) ) {
3567 0           $type = $in;
3568 0           $in = 'IMM';
3569             }
3570              
3571 0           my $n;
3572             my $nm;
3573 0 0         if ( $in =~ /^\s*imm/i ) {
    0          
3574 0           $n = 'imm';
3575 0           $nm = 'IMM';
3576             }
3577             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3578 0           $n = $1;
3579 0           $nm = "MEAS${n}";
3580             }
3581             else {
3582 0           Lab::Exception::CorruptParameter->throw(
3583             "invalid measurement# '$in' \n");
3584 0           return;
3585             }
3586              
3587 0           my $ty;
3588 0 0 0       if ( $n ne 'imm' && $type =~ /^\s*NONE/i ) {
3589 0           $ty = 'NONE';
3590             }
3591             else {
3592 0           $ty = _keyword(
3593             $type,
3594             qw(FREQ MEAN PERI PHA PK2 CRM MINI MAXI RIS FALL PW NWI)
3595             );
3596             }
3597 0           $self->write("MEASU:${nm}:TYP $ty");
3598 0           $self->_debug();
3599 0           $self->get_measurement_type( measurement => $n );
3600             }
3601              
3602              
3603             sub get_measurement_units {
3604 0     0 1   my $self = shift;
3605 0           my ( $in, $tail ) = $self->_check_args( \@_, ['measurement'] );
3606              
3607 0           my $n;
3608             my $nm;
3609 0 0 0       if ( !defined($in) || $in =~ /^\s*imm/i || $in =~ /^\s*$/ ) {
    0 0        
3610 0           $n = 'imm';
3611 0           $nm = 'IMM';
3612             }
3613             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3614 0           $n = $1;
3615 0           $nm = "MEAS${n}";
3616             }
3617             else {
3618 0           Lab::Exception::CorruptParameter->throw(
3619             "invalid measurement# '$in' \n");
3620 0           return;
3621             }
3622              
3623             $tail->{read_mode} = $self->{config}->{default_read_mode}
3624 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
3625 0 0         $tail->{read_mode} = 'device' if $self->{config}->{no_cache};
3626              
3627 0 0 0       if ( $tail->{read_mode} eq 'cache'
3628             && defined( $self->{device_cache}->{"meas_units_${n}"} ) ) {
3629 0           return $self->{device_cache}->{"meas_units_${n}"};
3630             }
3631              
3632 0           my $r = $self->query("MEASU:${nm}:UNI?");
3633 0           $self->_debug();
3634 0           $r = $self->_parseReply($r);
3635 0           $self->{device_cache}->{"meas_units_${n}"} = $r;
3636 0           return $r;
3637             }
3638              
3639              
3640             sub get_measurement_source {
3641 0     0 1   my $self = shift;
3642 0           my ( $in, $tail ) = $self->_check_args( \@_, ['measurement'] );
3643              
3644 0           my $n;
3645             my $nm;
3646 0 0 0       if ( !defined($in) || $in =~ /^\s*imm/i || $in =~ /^\s*$/ ) {
    0 0        
3647 0           $n = 'imm';
3648 0           $nm = 'IMM';
3649             }
3650             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3651 0           $n = $1;
3652 0           $nm = "MEAS${n}";
3653             }
3654             else {
3655 0           Lab::Exception::CorruptParameter->throw(
3656             "invalid measurement# '$in' \n");
3657 0           return;
3658             }
3659              
3660             $tail->{read_mode} = $self->{config}->{default_read_mode}
3661 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
3662 0 0         $tail->{read_mode} = 'device' if $self->{config}->{no_cache};
3663              
3664 0 0 0       if ( $tail->{read_mode} eq 'cache'
3665             && defined( $self->{device_cache}->{"meas_source_${n}"} ) ) {
3666 0           return $self->{device_cache}->{"meas_source_${n}"};
3667             }
3668              
3669 0           my $j = '';
3670 0 0         $j = 1 if $n eq 'imm';
3671              
3672 0           my $r = $self->query("MEASU:${nm}:SOU${j}?");
3673 0           $self->_debug();
3674 0           $r = $self->_parseReply($r);
3675 0           $self->{device_cache}->{"meas_source_${n}"} = $r;
3676 0           return $r;
3677             }
3678              
3679              
3680             sub set_measurement_source {
3681 0     0 1   my $self = shift;
3682 0           my ( $in, $inw )
3683             = $self->_check_args( \@_, qw(measurement measurement_source) );
3684              
3685 0 0         if ( !defined($inw) ) {
3686 0           $inw = $in;
3687 0           $in = 'IMM';
3688             }
3689              
3690 0           my $n;
3691             my $nm;
3692 0 0 0       if ( !defined($in) || $in =~ /^\s*imm/i || $in =~ /^\s*$/ ) {
    0 0        
3693 0           $n = 'imm';
3694 0           $nm = 'IMM';
3695             }
3696             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3697 0           $n = $1;
3698 0           $nm = "MEAS${n}";
3699             }
3700             else {
3701 0           Lab::Exception::CorruptParameter->throw(
3702             "invalid measurement# '$in' \n");
3703 0           return;
3704             }
3705              
3706 0           my $j = '';
3707 0 0         $j = 1 if $n eq 'imm';
3708              
3709 0           my $wfm = _keyword( $inw, qw(CH1 CH2 CH3 CH4 MATH) );
3710 0           $self->write("MEASU:${nm}:SOU${j} $wfm");
3711 0           $self->_debug();
3712 0           $self->{device_cache}->{"meas_source_$n"} = $wfm;
3713             }
3714              
3715              
3716             sub get_measurement_value {
3717 0     0 1   my $self = shift;
3718 0           my ($in) = $self->_check_args( \@_, 'measurement' );
3719              
3720 0           my $n;
3721             my $nm;
3722 0 0 0       if ( !defined($in) || $in =~ /^\s*imm/i || $in =~ /^\s*$/ ) {
    0 0        
3723 0           $n = 'imm';
3724 0           $nm = 'IMM';
3725             }
3726             elsif ( $in =~ /^\s*(\d)\s*$/ ) {
3727 0           $n = $1;
3728 0           $nm = "MEAS${n}";
3729             }
3730             else {
3731 0           Lab::Exception::CorruptParameter->throw(
3732             "invalid measurement# '$in' \n");
3733 0           return;
3734             }
3735              
3736 0 0         if ( $n ne 'imm' ) {
3737 0 0         if ( $self->get_measurement_type( measurement => $n ) eq 'NONE' ) {
3738 0           Lab::Exception::CorruptParameter->throw(
3739             "Measurement $n type set to 'NONE'\n");
3740 0           return;
3741             }
3742             }
3743              
3744 0           my $wfm = $self->get_measurement_source( measurement => $n );
3745 0 0         if ( !$self->get_visible( source => $wfm ) ) {
3746 0           Lab::Exception::CorruptParameter->throw(
3747             "Meaurement only avail on visible traces\n");
3748 0           return;
3749             }
3750              
3751 0           my $r = $self->query("MEASU:${nm}:VAL?");
3752 0           $self->_debug();
3753 0           return _parseNRf($r);
3754             }
3755              
3756              
3757             sub trigger {
3758 0     0 1   my $self = shift;
3759 0           $self->write("TRIG FORC");
3760 0           $self->_debug();
3761             }
3762              
3763              
3764             sub get_trig_coupling {
3765 0     0 1   my $self = shift;
3766 0           my $r = $self->query("TRIG:MAI:EDGE:COUP?");
3767 0           $self->_debug();
3768 0           $r = $self->_parseReply( $r, qw(AC DC HFR LFR NOISE) );
3769 0           return _bloat(
3770             $r,
3771             { HFR => 'HFREJ', LFR => 'LFREJ', NOISE => 'NOISEREJ' }
3772             );
3773             }
3774              
3775              
3776             sub set_trig_coupling {
3777 0     0 1   my $self = shift;
3778 0           my ($in) = $self->_check_args_strict( \@_, 'coupling' );
3779              
3780 0           my $c = _keyword( $in, qw(AC DC HFR LFR NOISE) );
3781              
3782 0           $self->write("TRIG:MAI:EDGE:COUP $c");
3783 0           $self->_debug();
3784             }
3785              
3786              
3787             sub get_trig_slope {
3788 0     0 1   my $self = shift;
3789 0           my $r = $self->query("TRIG:MAI:EDGE:SLO?");
3790 0           $self->_debug();
3791 0           $r = $self->_parseReply( $r, qw(FALL RIS) );
3792 0 0         $r = 'RISE' if $r eq 'RIS';
3793 0           return $r;
3794             }
3795              
3796              
3797             sub set_trig_slope {
3798 0     0 1   my $self = shift;
3799 0           my ($in) = $self->_check_args_strict( \@_, 'slope' );
3800              
3801 0           my $sl;
3802 0 0         if ( $in =~ /^\s*(ri|up|pos|\+)/i ) {
    0          
3803 0           $sl = 'RIS';
3804             }
3805             elsif ( $in =~ /^\s*(fa|d|neg|\-)/i ) {
3806 0           $sl = 'FALL';
3807             }
3808             else {
3809 0           Lab::Exception::CorruptParameter->throw(
3810             "invalid trigger slope '$in'\n");
3811 0           return;
3812             }
3813              
3814 0           $self->write("TRIG:MAI:EDGE:SLO $sl");
3815 0           $self->_debug();
3816             }
3817              
3818              
3819             sub get_trig_source {
3820 0     0 1   my $self = shift;
3821 0           my ( $in, $tail ) = $self->_check_args( \@_, 'type' );
3822 0           my $type;
3823              
3824 0 0         if ( defined($in) ) {
3825 0           $type = _keyword( $in, qw(EDGE PUL VID) );
3826             }
3827             else {
3828 0           $type = $self->get_trig_type();
3829             }
3830              
3831 0           my $t = lc( substr( $type, 0, 1 ) );
3832              
3833             $tail->{read_mode} = $self->{config}->{default_read_mode}
3834 0 0 0       unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );
3835 0 0         $tail->{read_mode} = 'device' if $self->{config}->{no_cache};
3836              
3837 0 0         if ( $tail->{read_mode} eq 'cache' ) {
3838             return $self->{device_cache}->{"${t}trig_source"}
3839 0 0         if defined( $self->{device_cache}->{"${t}trig_source"} );
3840             }
3841              
3842 0           my $r = $self->query("TRIG:MAI:${type}:SOU?");
3843 0           $self->_debug();
3844 0           $r = $self->_parseReply($r);
3845 0           $self->{device_cache}->{"${t}trig_source"} = $r;
3846 0           return $r;
3847             }
3848              
3849              
3850             sub set_trig_source {
3851 0     0 1   my $self = shift;
3852 0           my ( $in, $tail ) = $self->_check_args_strict( \@_, 'source' );
3853              
3854 0           my $s;
3855 0 0         if ( $in =~ /^\s*(CH[1-4]|EXT5?)/i ) {
    0          
    0          
3856 0           $s = uc($1);
3857             }
3858             elsif ( $in =~ /^\s*(AC|LINE)/i ) {
3859 0           $s = 'LINE';
3860             }
3861             elsif ( $in =~ /^\s*([1-4])\s*$/ ) {
3862 0           $s = "CH$1";
3863             }
3864             else {
3865 0           Lab::Exception::CorruptParameter->throw(
3866             "Invalid trigger source '$in'\n");
3867 0           return;
3868             }
3869              
3870 0           my $type;
3871 0 0         $type = $tail->{type} if exists( $tail->{type} );
3872 0 0         $type = $self->get_trig_type()
3873             unless defined $type;
3874 0           $type = _keyword( $type, qw(EDGE PUL VID) );
3875 0           my $t = lc( substr( $type, 0, 1 ) );
3876              
3877 0           $self->write("TRIG:MAI:${type}:SOU $s");
3878 0           $self->_debug();
3879 0           $self->{device_cache}->{"${t}trig_source"}
3880             = _bloat( $type, { PUL => 'PULSE', VID => 'VIDEO' } );
3881             }
3882              
3883              
3884             sub get_trig_frequency {
3885 0     0 1   my $self = shift;
3886              
3887 0           my $type = $self->get_trig_type();
3888 0 0         if ( $type eq 'VIDEO' ) {
3889 0           Lab::Exception::CorruptParameter->throw(
3890             "Trigger frequency not availible for 'VIDEO' type trigger\n");
3891 0           return;
3892             }
3893              
3894 0           my $r = $self->query("TRIG:MAI:FREQ?");
3895 0           $r = $self->_parseReply($r);
3896 0 0         if ( $r > 1e37 ) {
3897 0           $r = 1;
3898              
3899             #clear out error
3900 0           $self->get_error();
3901             }
3902 0           $self->_debug();
3903 0           return $r;
3904             }
3905              
3906              
3907             sub get_trig_holdoff {
3908 0     0 1   my $self = shift;
3909 0           my $r = $self->query("TRIG:MAI:HOLDO:VAL?");
3910 0           $self->_debug();
3911 0           return $self->_parseReply($r);
3912             }
3913              
3914              
3915             sub set_trig_holdoff {
3916 0     0 1   my $self = shift;
3917 0           my ($in) = $self->_check_args_strict( \@_, 'holdoff' );
3918 0           my $t = _parseNRf( $in, 's', 'sec' );
3919              
3920 0 0         $t = '5E-07' if $t eq 'MIN';
3921 0 0         $t = 10 if $t eq 'MAX';
3922              
3923 0 0         if ( $t =~ /ERR/ ) {
3924 0           Lab::Exception::CorruptParameter->throw(
3925             "Error parsing holdoff '$in'\n");
3926 0           return;
3927             }
3928              
3929 0 0 0       if ( $t < 5e-7 || $t > 10 ) {
3930 0           Lab::Exception::CorruptParameter->throw(
3931             "Holdoff '$in' out of range (500ns..10s)\n");
3932 0           return;
3933             }
3934 0           $self->write("TRIG:MAI:HOLDO:VAL $t");
3935 0           $self->_debug();
3936             }
3937              
3938              
3939             sub get_trig_level {
3940 0     0 1   my $self = shift;
3941 0           my $r = $self->query("TRIG:MAI:LEV?");
3942 0           $self->_debug();
3943 0           return _parseReply($r);
3944             }
3945              
3946              
3947             sub set_trig_level {
3948 0     0 1   my $self = shift;
3949 0           my ($in) = $self->_check_args_strict( \@_, 'level' );
3950 0 0         return if $self->get_trig_source() eq 'AC LINE';
3951              
3952 0           my $v = _parseNRf( $in, 'v' );
3953              
3954 0 0 0       if ( $v eq 'MIN' || $v eq 'MAX' || $v =~ /ERR/ ) {
      0        
3955 0           Lab::Exception::CorruptParameter->throw(
3956             "Invalid trigger level '$in'\n");
3957 0           return;
3958             }
3959 0           $v = sprintf( '%.3e', $v );
3960 0           $self->write("TRIG:MAI:LEV $v");
3961 0           $self->_debug();
3962             }
3963              
3964              
3965             sub get_trig_mode {
3966 0     0 1   my $self = shift;
3967 0           my $r = $self->query("TRIG:MAI:MOD?");
3968 0           $self->_debug();
3969 0           $r = $self->_parseReply( $r, qw(AUTO NORM) );
3970 0 0         $r = 'NORMAL' if $r eq 'NORM';
3971 0           return $r;
3972             }
3973              
3974              
3975             sub set_trig_mode {
3976 0     0 1   my $self = shift;
3977 0           my ($in) = $self->_check_args_strict( \@_, 'mode' );
3978              
3979 0           my $m = _keyword( $in, qw(AUTO NORM) );
3980 0           $self->write("TRIG:MAI:MOD $m");
3981 0           $self->_debug();
3982             }
3983              
3984              
3985             sub get_trig_type {
3986 0     0 1   my $self = shift;
3987 0           my $r = $self->query("TRIG:MAI:TYP?");
3988 0           $self->_debug();
3989 0           $r = $self->_parseReply( $r, qw(EDGE PUL VID) );
3990 0           return _bloat( $r, { PUL => 'PULSE', VID => 'VIDEO' } );
3991             }
3992              
3993              
3994             sub set_trig_type {
3995 0     0 1   my $self = shift;
3996 0           my ($in) = $self->_check_args_strict( \@_, 'type' );
3997              
3998 0           my $t = _keyword( $in, qw(EDG PUL VID) );
3999 0 0         $t = 'EDGE' if $t eq 'EDG';
4000 0           $self->write("TRIG:MAI:TYP $t");
4001 0           $self->_debug();
4002             }
4003              
4004              
4005             sub get_trig_pulse_width {
4006 0     0 1   my $self = shift;
4007              
4008 0           my $r = $self->query("TRIG:MAI:PUL:WID:WID?");
4009 0           $self->_debug();
4010 0           return $self->_parseReply($r);
4011             }
4012              
4013              
4014             sub set_trig_pulse_width {
4015 0     0 1   my $self = shift;
4016 0           my ($in) = $self->_check_args_strict( \@_, 'width' );
4017              
4018 0           my $w = _parseNRf( $in, 's', 'sec' );
4019 0 0         $w = 33e-9 if $w eq 'MIN';
4020 0 0         $w = 10 if $w eq 'MAX';
4021 0 0         if ( $w =~ /ERR/ ) {
4022 0           Lab::Exception::CorruptParameter->throw(
4023             "Invalid trigger width '$in'\n");
4024 0           return;
4025             }
4026 0           $w = sprintf( '%.3e', $w );
4027 0           $self->write("TRIG:MAI:PUL:WID:WID $w");
4028 0           $self->_debug();
4029             }
4030              
4031              
4032             sub get_trig_pulse_polarity {
4033 0     0 1   my $self = shift;
4034 0           my $r = $self->query("TRIG:MAI:PUL:WID:POL?");
4035 0           $self->_debug();
4036 0           $r = $self->_parseReply( $r, qw(POS NEG) );
4037 0           return _bloat( $r, { POS => 'POSITIVE', NEG => 'NEGATIVE' } );
4038             }
4039              
4040              
4041             sub set_trig_pulse_polarity {
4042 0     0 1   my $self = shift;
4043 0           my ($in) = $self->_check_args_strict( \@_, 'pulse_polarity' );
4044 0           my $pol;
4045              
4046 0 0         if ( $in =~ /^\s*(P|\+)/i ) {
    0          
4047 0           $pol = 'POSITIV';
4048             }
4049             elsif ( $in =~ /^\s*(N|M|\-)/i ) {
4050 0           $pol = 'NEGA';
4051             }
4052             else {
4053 0           Lab::Exception::CorruptParameter->throw(
4054             "Invalid trigger polarity '$in'\n");
4055 0           return;
4056             }
4057 0           $self->write("TRIG:MAI:PUL:WID:POL $pol");
4058 0           $self->_debug();
4059             }
4060              
4061              
4062             sub get_trig_pulse_when {
4063 0     0 1   my $self = shift;
4064 0           my $r = $self->query("TRIG:MAI:PUL:WID:WHEN?");
4065 0           $self->_debug();
4066 0           $r = $self->_parseReply( $r, qw(EQ NOTE IN OUT) );
4067 0           return _bloat(
4068             $r, {
4069             EQ => 'EQUAL', NOTE => 'NOTEQUAL',
4070             IN => 'INSIDE', OUT => 'OUTSIDE'
4071             }
4072             );
4073             }
4074              
4075              
4076             sub set_trig_pulse_when {
4077 0     0 1   my $self = shift;
4078 0           my ($in) = $self->_check_args_strict( \@_, 'pulse_when' );
4079              
4080 0           my $w;
4081 0 0         if ( $in =~ /^\s*(EQ|=)/i ) {
    0          
    0          
    0          
4082 0           $w = 'EQ';
4083             }
4084             elsif ( $in =~ /^\s*(NO|NE|!=|<>)/i ) {
4085 0           $w = 'NOTE';
4086             }
4087             elsif ( $in =~ /^\s*(IN|LT|<)/i ) {
4088 0           $w = 'IN';
4089             }
4090             elsif ( $in =~ /^\s*(OU|GT|>)/i ) {
4091 0           $w = 'OUT';
4092             }
4093             else {
4094 0           Lab::Exception::CorruptParameter->throw(
4095             "Invalid trigger 'when' parameter '$in'\n");
4096 0           return;
4097             }
4098 0           $self->write("TRIG:MAI:PUL:WID:WHEN $w");
4099 0           $self->_debug();
4100             }
4101              
4102              
4103             sub get_trig_vid_line {
4104 0     0 1   my $self = shift;
4105 0           my $r = $self->query("TRIG:MAI:VID:LINE?");
4106 0           $self->_debug();
4107 0           return $self->_parseReply($r);
4108             }
4109              
4110              
4111             sub set_trig_vid_line {
4112 0     0 1   my $self = shift;
4113 0           my ($in) = $self->_check_args_strict( \@_, 'vid_line' );
4114              
4115 0 0         $in = 1 if $in eq 'MIN';
4116 0 0         if ( $in eq 'MAX' ) {
4117 0           my $std = $self->get_trig_vid_standard();
4118 0           $in = 525;
4119 0 0         $in = 625 if $std eq 'PAL';
4120             }
4121 0 0         $in = int($in) if $in =~ /^\s*\d+/;
4122              
4123 0 0 0       if ( $in =~ /ERR/ || $in < 1 || $in > 625 ) {
      0        
4124 0           Lab::Exception::CorruptParameter->throw(
4125             "Invalid video trigger line '$in'\n");
4126 0           return;
4127             }
4128              
4129 0           $self->write("TRIG:MAI:VID:LINE $in");
4130 0           $self->_debug();
4131             }
4132              
4133              
4134             sub get_trig_vid_polarity {
4135 0     0 1   my $self = shift;
4136 0           my $r = $self->query("TRIG:MAI:VID:POL?");
4137 0           $self->_debug();
4138 0           $r = $self->_parseReply( $r, qw(NORM INV) );
4139 0           return _bloat( $r, { NORM => 'NORMAL', INV => 'INVERTED' } );
4140             }
4141              
4142              
4143             sub set_trig_vid_polarity {
4144 0     0 1   my $self = shift;
4145 0           my ($in) = $self->_check_args_strict( \@_, 'vid_polarity' );
4146              
4147 0           my $p;
4148 0 0         if ( $in =~ /^\s*(N|\-)/i ) {
    0          
4149 0           $p = 'NORM';
4150             }
4151             elsif ( $in =~ /^\s*(I|\+)/i ) {
4152 0           $p = 'INV';
4153             }
4154             else {
4155 0           Lab::Exception::CorruptParameter->throw(
4156             "Invalid video trigger polarity '$in'\n");
4157 0           return;
4158             }
4159 0           $self->write("TRIG:MAI:VID:POL $p");
4160 0           $self->_debug();
4161             }
4162              
4163              
4164             sub get_trig_vid_standard {
4165 0     0 1   my $self = shift;
4166 0           my $r = $self->query("TRIG:MAI:VID:STAND?");
4167 0           $self->_debug();
4168 0           $r = $self->_parseReply( $r, qw(NTS PAL) );
4169 0 0         $r = 'NTSC' if $r eq 'NTS';
4170 0           return $r;
4171             }
4172              
4173              
4174             sub set_trig_vid_standard {
4175 0     0 1   my $self = shift;
4176 0           my ($in) = $self->_check_args_strict( \@_, 'vid_standard' );
4177              
4178 0           my $s;
4179 0 0         if ( $in =~ /^\s*(NTS|US|JP)/i ) {
    0          
4180 0           $s = 'NTS';
4181             }
4182             elsif ( $in =~ /^\s*(PAL|EU|UK|AU|SEC)/i ) {
4183 0           $s = 'PAL';
4184             }
4185             else {
4186 0           Lab::Exception::CorruptParameter->throw(
4187             "Invalid video trigger standard '$in'\n");
4188 0           return;
4189             }
4190 0           $self->write("TRIG:MAI:VID:STAND $s");
4191 0           $self->_debug();
4192             }
4193              
4194              
4195             sub get_trig_vid_sync {
4196 0     0 1   my $self = shift;
4197 0           my $r = $self->query("TRIG:MAI:VID:SYNC?");
4198 0           $self->_debug();
4199 0           $r = $self->_parseReply( $r, qw(FIELD LINE ODD EVEN LINEN) );
4200 0 0         $r = 'LINENUM' if $r eq 'LINEN';
4201 0           return $r;
4202             }
4203              
4204              
4205             sub set_trig_vid_sync {
4206 0     0 1   my $self = shift;
4207 0           my ($in) = $self->_check_args_strict( \@_, 'vid_sync' );
4208              
4209 0           my $s = _keyword( $in, qw(FIELD LINE ODD EVEN LINEN) );
4210 0           $self->write("TRIG:MAI:VID:SYNC $s");
4211 0           $self->_debug();
4212             }
4213              
4214              
4215             sub get_trig_state {
4216 0     0 1   my $self = shift;
4217 0           my $r = $self->query("TRIG:STATE?");
4218 0           $self->_debug();
4219 0           $r = $self->_parseReply($r);
4220             }
4221              
4222              
4223             sub get_data_width {
4224 0     0 1   my $self = shift;
4225 0           my $r = $self->query("DAT:WID?");
4226 0           $self->_debug();
4227 0           return $self->_parseReply($r);
4228             }
4229              
4230              
4231             sub set_data_width {
4232 0     0 1   my $self = shift;
4233 0           my ($in) = $self->_check_args_strict( \@_, 'nbytes' );
4234 0           my $n;
4235              
4236 0 0         if ( $in =~ /^\s*1\s*$/ ) {
    0          
4237 0           $n = 1;
4238             }
4239             elsif ( $in =~ /^\s*2\s*$/ ) {
4240 0           $n = 2;
4241             }
4242             else {
4243 0           Lab::Exception::CorruptParameter->throw(
4244             "Invalid bytes/sample '$in' should be 1, 2\n");
4245 0           return;
4246             }
4247 0           $self->write("DAT:WID $n");
4248 0           $self->_debug();
4249             }
4250              
4251              
4252             sub get_data_encoding {
4253 0     0 1   my $self = shift;
4254 0           my $r = $self->query("DAT:ENC?");
4255 0           $self->_debug();
4256 0           $r = $self->_parseReply( $r, qw(ASCI RIB RPB SRI SRP) );
4257 0           return _bloat(
4258             $r, {
4259             ASCI => 'ASCII', RIB => 'RIBINARY', RPB => 'RPBINARY',
4260             SRI => 'SRIBINARY', SRP => 'SRPBINARY'
4261             }
4262             );
4263             }
4264              
4265              
4266             sub set_data_encoding {
4267 0     0 1   my $self = shift;
4268 0           my ($in) = $self->_check_args_strict( \@_, 'encoding' );
4269 0           my $e = _keyword( $in, qw(ASC RI RP SRI SRP) );
4270 0           $e = _bloat( $e, { ASC => 'ASCI', RI => 'RIB', RP => 'RPB' } );
4271 0           $self->write("DAT:ENC $e");
4272 0           $self->_debug();
4273             }
4274              
4275              
4276             sub get_data_start {
4277 0     0 1   my $self = shift;
4278 0           my $r = $self->query("DAT:STAR?");
4279 0           $self->_debug();
4280 0           return $self->_parseReply($r);
4281             }
4282              
4283              
4284             sub set_data_start {
4285 0     0 1   my $self = shift;
4286 0           my ($in) = $self->_check_args_strict( \@_, 'start' );
4287              
4288 0 0         $in = 1 if $in =~ /^\s*MIN/i;
4289 0 0         $in = 2500 - 1 if $in =~ /^\s*MAX/i;
4290              
4291 0 0         if ( $in !~ /^\s*(\d+)\s*$/ ) {
4292 0           Lab::Exception::CorruptParameter->throw(
4293             "Invalid waveform start sample# '$in'; should be 1..2500\n");
4294 0           return;
4295             }
4296 0           my $i = $in;
4297 0 0 0       if ( $i < 1 || $i >= 2500 ) {
4298 0           Lab::Exception::CorruptParameter->throw(
4299             "Invalid waveform start sample# '$in'; should be 1..2500\n");
4300 0           return;
4301             }
4302              
4303 0           $self->write("DAT:STAR $i");
4304 0           $self->_debug();
4305             }
4306              
4307              
4308             sub get_data_stop {
4309 0     0 1   my $self = shift;
4310 0           my $r = $self->query("DAT:STOP?");
4311 0           $self->_debug();
4312 0           return $self->_parseReply($r);
4313             }
4314              
4315              
4316             sub set_data_stop {
4317 0     0 1   my $self = shift;
4318 0           my ($in) = $self->_check_args_strict( \@_, 'stop' );
4319              
4320 0 0         $in = 2 if $in =~ /^\s*MIN/i;
4321 0 0         $in = 2500 if $in =~ /^\s*MAX/i;
4322              
4323 0 0         if ( $in !~ /^\s*(\d+)\s*$/ ) {
4324 0           Lab::Exception::CorruptParameter->throw(
4325             "Invalid waveform stop sample# '$in'; should be 1..2500\n");
4326 0           return;
4327             }
4328 0           my $i = $in;
4329 0 0 0       if ( $i < 2 || $i > 2500 ) {
4330 0           Lab::Exception::CorruptParameter->throw(
4331             "Invalid waveform stop sample# '$in'; should be 1..2500\n");
4332 0           return;
4333             }
4334              
4335 0           $self->write("DAT:STOP $i");
4336 0           $self->_debug();
4337             }
4338              
4339              
4340             sub get_data_destination {
4341 0     0 1   my $self = shift;
4342 0           my $r = $self->query("DAT:DEST?");
4343 0           $self->_debug();
4344 0           return $self->_parseReply($r);
4345             }
4346              
4347              
4348             sub set_data_destination {
4349 0     0 1   my $self = shift;
4350 0           my ($in) = $self->_check_args_strict( \@_, 'destination' );
4351              
4352 0           my $d;
4353 0 0         if ( $in =~ /^\s*(REF)?([A-D])\s*$/i ) {
4354 0           $d = "REF" . uc($2);
4355             }
4356             else {
4357 0           Lab::Exception::CorruptParameter->throw(
4358             "Invalid waveform destination '$in'; should be REFA..REFD\n");
4359 0           return;
4360             }
4361 0           $self->write("DAT:DEST $d");
4362 0           $self->_debug();
4363             }
4364              
4365              
4366             sub set_data_init {
4367 0     0 1   my $self = shift;
4368 0           $self->write("DAT INIT");
4369 0           $self->_debug();
4370             }
4371              
4372              
4373             sub get_data_source {
4374 0     0 1   my $self = shift;
4375 0           my $r = $self->query("DAT:SOU?");
4376 0           $self->_debug();
4377 0           return $self->_parseReply($r);
4378             }
4379              
4380              
4381             sub set_data_source {
4382 0     0 1   my $self = shift;
4383 0           my ($in) = $self->_check_args_strict( \@_, 'source' );
4384              
4385 0           my $s;
4386              
4387 0 0         if ( $in =~ /^\s*(CH)?([1-4])\s*$/i ) {
    0          
    0          
4388 0           $s = "CH$2";
4389             }
4390             elsif ( $in =~ /^\s*MATH\s*$/i ) {
4391 0           $s = 'MATH';
4392             }
4393             elsif ( $in =~ /^\s*(REF)?([A-D])\s*$/i ) {
4394 0           $s = "REF" . uc($2);
4395             }
4396             else {
4397 0           Lab::Exception::CorruptParameter->throw("Invalid waveform '$in'");
4398 0           return;
4399             }
4400 0           $self->write("DAT:SOU $s");
4401 0           $self->_debug();
4402             }
4403              
4404              
4405             sub get_data {
4406 0     0 1   my $self = shift;
4407 0           my ($tail) = $self->_check_args( \@_ );
4408 0           my $h = {};
4409              
4410 0           $h->{width} = $self->get_data_width($tail);
4411 0           $h->{stop} = $self->get_data_stop($tail);
4412 0           $h->{start} = $self->get_data_start($tail);
4413 0           $h->{encoding} = $self->get_data_encoding($tail);
4414 0           $h->{source} = $self->get_data_source($tail);
4415 0           $h->{destination} = $self->get_data_destination($tail);
4416 0           return $h;
4417             }
4418              
4419              
4420             sub set_data {
4421 0     0 1   my $self = shift;
4422 0           my ($tail) = $self->_check_args( \@_ );
4423              
4424 0 0         $self->set_data_width($tail) if exists $tail->{width};
4425 0 0         $self->set_data_start($tail) if exists $tail->{start};
4426 0 0         $self->set_data_stop($tail) if exists $tail->{stop};
4427 0 0         $self->set_data_encoding($tail) if exists $tail->{encoding};
4428 0 0         $self->set_data_source($tail) if exists $tail->{source};
4429 0 0         $self->set_data_destinatin($tail) if exists $tail->{destination};
4430             }
4431              
4432              
4433             sub get_waveform {
4434 0     0 1   my $self = shift;
4435 0           my ( $in, $tail ) = $self->_check_args( \@_, 'waveform' );
4436 0           my $args = clone($tail);
4437 0 0         delete( $args->{destination} ) if exists $args->{destination};
4438 0 0         delete( $args->{source} ) if exists $args->{source};
4439              
4440 0 0         if ( !$self->get_visible($in) ) {
4441 0           Lab::Exception::CorruptParameter->throw("Waveform '$in' not visible");
4442 0           return;
4443             }
4444              
4445 0 0         $args->{source} = $in if defined $in;
4446 0           my $dstop;
4447 0 0         if ( $in =~ /^\s*MATH/i ) {
4448 0           $dstop = $self->get_data_stop();
4449 0 0         if ( $dstop > 1024 ) {
4450 0           $self->set_data_stop(1024);
4451             }
4452             else {
4453 0           $dstop = undef;
4454             }
4455             }
4456              
4457 0           $self->set_data($args);
4458              
4459 0           my $header = $self->get_header();
4460 0           $self->set_header(1);
4461 0           my $dath = $self->query("DAT?");
4462 0           $self->_debug();
4463            
4464            
4465 0           my $wfpre = $self->query( "WFMP?", read_length => 2000, timeout => 10 );
4466 0           $self->_debug();
4467              
4468 0           my $wf = $self->query("CURV?", read_length => -1, timeout => 60);
4469 0           $self->_debug();
4470            
4471 0           $self->set_header($header);
4472              
4473             # $self->set_data_stop($dstop) if defined $dstop;
4474              
4475 0           my $hd = scpi_parse($dath);
4476 0           my $hp = scpi_parse($wfpre,$hd);
4477 0           my $h = scpi_flat( scpi_parse( $wf, $hp ), $self->{scpi_override} );
4478              
4479 0           my (@dat);
4480 0 0         if ( $h->{'DAT:ENC'} =~ /^ASC/i ) {
4481 0           @dat = split( /,/, $h->{CURV} );
4482             }
4483             else {
4484 0 0         if ( substr( $h->{CURV}, 0, 2 ) !~ /^#\d/ ) {
4485 0           croak("bad binary curve data");
4486             }
4487 0           my $nx = substr( $h->{CURV}, 1, 1 );
4488 0           my $n = substr( $h->{CURV}, 2, $nx );
4489 0           my $w = $h->{'WFMP:BYT_N'};
4490 0           my $f = $h->{'WFMP:BN_F'};
4491 0           my $xsb = $h->{'WFMP:BYT_O'};
4492              
4493 0           my $form;
4494 0 0         if ( $w == 1 ) {
4495 0 0         if ( $f eq 'RP' ) {
4496 0           $form = 'C';
4497             }
4498             else {
4499 0           $form = 'c';
4500             }
4501             }
4502             else {
4503 0 0         if ( $f eq 'RP' ) {
4504 0           $form = 'S';
4505             }
4506             else {
4507 0           $form = 's';
4508             }
4509 0 0         if ( $xsb eq 'MSB' ) {
4510 0           $form .= '>';
4511             }
4512             else {
4513 0           $form .= '<';
4514             }
4515             }
4516 0           $form .= '*';
4517 0           @dat = unpack( $form, substr( $h->{CURV}, $nx + 2 ) );
4518             }
4519              
4520 0           $h->{t} = [];
4521 0           my $j = 0;
4522 0           my $j0 = $h->{'DAT:STAR'};
4523 0           my $x0 = $h->{'WFMP:XZE'};
4524 0           my $dx = $h->{'WFMP:XIN'};
4525 0           my $xoff = $h->{'WFMP:PT_O'};
4526 0           my $y0 = $h->{'WFMP:YZE'};
4527 0           my $yoff = $h->{'WFMP:YOF'};
4528 0           my $dy = $h->{'WFMP:YMU'};
4529              
4530 0           $h->{'WFMP:XUN'} = _unquote( $h->{'WFMP:XUN'} );
4531 0           $h->{'WFMP:YUN'} = _unquote( $h->{'WFMP:YUN'} );
4532 0           $h->{'WFMP:WFI'} = _unquote( $h->{'WFMP:WFI'} );
4533              
4534 0 0         if ( $h->{'WFMP:PT_F'} eq 'Y' ) {
4535 0           $h->{v} = [];
4536 0           for ( $j = 0; $j <= $#dat; $j++ ) {
4537 0           $h->{t}->[ $j0 + $j ] = $x0 + $dx * ( $j - $xoff );
4538 0           $h->{v}->[ $j0 + $j ] = $y0 + $dy * ( $dat[$j] - $yoff );
4539             }
4540 0           $h->{'DAT:STOP'} = $j0 + $#dat;
4541             }
4542             else { # envelope
4543 0           $h->{vmin} = [];
4544 0           $h->{vmax} = [];
4545 0           for ( $j = 0; $j <= $#dat; $j += 2 ) {
4546 0           $h->{t}->[ $j0 + $j / 2 ] = $x0 + $dx * ( $j + 1 - $xoff );
4547 0           $h->{vmin}->[ $j0 + $j / 2 ]
4548             = $y0 + $dy * ( $dat[$j] - $yoff );
4549 0           $h->{vmax}->[ $j0 + $j / 2 ]
4550             = $y0 + $dy * ( $dat[ $j + 1 ] - $yoff );
4551             }
4552 0           $h->{'DAT:STOP'} = $j0 + $#dat / 2;
4553             }
4554              
4555 0           return $h;
4556             }
4557              
4558             # remove scpi style quoting
4559             sub _unquote {
4560 0     0     my $str = shift;
4561 0 0         return '' unless defined($str);
4562 0 0         return $str unless $str =~ /^(\'|\")/;
4563 0 0         if ( $str =~ /^\'(.*)\'$/ ) {
    0          
4564 0           $str = $1;
4565 0           $str =~ s/\'\'/'/g;
4566             }
4567             elsif ( $str =~ /^\"(.*)\"$/ ) {
4568 0           $str = $1;
4569 0           $str =~ s/\"\"/"/g;
4570             }
4571 0           return $str;
4572             }
4573              
4574              
4575             sub create_waveform {
4576 0     0 1   my $self = shift;
4577 0           my ( $it0, $it1, $n, $vfunc, $tail )
4578             = $self->_check_args( \@_, qw(tstart tstop nbins vfunc) );
4579              
4580 0 0         $n = 2500 if !defined($n);
4581 0           $n = int($n);
4582 0 0         $n = 2500 if $n <= 0;
4583              
4584 0           my ( $t0, $t1 );
4585              
4586 0 0 0       if ( defined($it0) xor defined($it1) ) {
4587 0           Lab::Exception::CorruptParameter->throw(
4588             "Should define BOTH t0 and t1, or neither");
4589 0           return;
4590             }
4591              
4592 0 0         if ( defined($it0) ) {
4593 0           $t0 = _parseNRf( $it0, 's', 'sec' );
4594 0 0         if ( $t0 =~ /(MIN|MAX|ERR)/i ) {
4595 0           Lab::Exception::CorruptParameter->throw("Invalid time '$it0'");
4596 0           return;
4597             }
4598             }
4599              
4600 0 0         if ( defined($it1) ) {
4601 0           $t1 = _parseNRf( $it1, 's', 'sec' );
4602 0 0         if ( $t1 =~ /(MIN|MAX|ERR)/i ) {
4603 0           Lab::Exception::CorruptParameter->throw("Invalid time '$it1'");
4604 0           return;
4605             }
4606             }
4607              
4608 0           my $hwfd = {};
4609 0           $hwfd->{t} = [];
4610 0           my $t = $hwfd->{t};
4611              
4612 0           $hwfd->{'DAT:STAR'} = 1;
4613 0           $hwfd->{'DAT:STOP'} = $n;
4614 0 0         if ( defined($t0) ) {
4615 0           $hwfd->{'WFMP:XZE'} = sprintf( '%.4e', $t0 );
4616 0           my $dt = ( $t1 - $t0 );
4617 0 0         $dt = $dt / ( $n - 1 ) if $n > 1;
4618 0           $hwfd->{'WFMP:XIN'} = sprintf( '%.4e', $dt );
4619              
4620 0           for ( my $j = 1; $j <= $n; $j++ ) {
4621 0           $t->[$j] = $t0 + ( $j - 1 ) * $dt;
4622             }
4623              
4624             }
4625 0 0         if ( !defined($t0) ) {
4626 0           for ( my $j = 1; $j <= $n; $j++ ) {
4627 0           $t->[$j] = undef;
4628             }
4629             }
4630              
4631 0           $hwfd->{'WFMP:PT_F'} = 'Y';
4632              
4633 0 0         if ( defined($vfunc) ) {
4634 0 0         if ( ref($vfunc) ne 'CODE' ) {
4635 0           Lab::Exception::CorruptParameter->throw(
4636             "not a pointer to routine for filling voltages");
4637 0           return;
4638             }
4639 0 0         if ( !defined($t0) ) {
4640 0           Lab::Exception::CorruptParameter->throw(
4641             "cannot fill voltages without t0, t1 defined");
4642 0           return;
4643             }
4644              
4645 0           my ( $v0, $v1, $vmin, $vmax );
4646              
4647 0           for ( my $j = 1; $j <= $n; $j++ ) {
4648 0           ( $v0, $v1 ) = &{$vfunc}( $t->[$j] ); # call user function
  0            
4649 0 0         if ( defined($v1) ) { # two values: doing envelope waveform
4650 0 0         if ( $v1 < $v0 ) { # v1 > v0, swap if needed
4651 0           my $vt = $v1;
4652 0           $v1 = $v0;
4653 0           $v0 = $vt;
4654             }
4655 0           $hwfd->{'WFMP:PT_F'} = 'ENV';
4656 0 0         $hwfd->{vmin} = [] unless exists $hwfd->{vmin};
4657 0 0         $hwfd->{vmax} = [] unless exists $hwfd->{vmax};
4658 0           $hwfd->{vmin}->[$j] = $v0;
4659 0           $hwfd->{vmax}->[$j] = $v1;
4660 0 0         if ( exists( $hwfd->{v} ) ) {
4661 0           Lab::Exception::CorruptParameter->throw(
4662             "Invalid mix of v; vmin,vmax");
4663 0           return;
4664             }
4665 0 0         $n = 1250 if $n > 1250; # envelope has fewer max bins
4666             }
4667             else {
4668 0 0         $hwfd->{v} = [] unless exists $hwfd->{v};
4669 0           $hwfd->{v}->[$j] = $v0;
4670 0 0         if ( exists( $hwfd->{vmin} ) ) {
4671 0           Lab::Exception::CorruptParameter->throw(
4672             "Invalid mix of v; vmin,vmax");
4673 0           return;
4674             }
4675 0           $v1 = $v0; # need this for the max/min
4676             }
4677              
4678 0 0 0       $vmin = $v0 unless defined $vmin && $vmin < $v0;
4679 0 0 0       $vmax = $v1 unless defined $vmax && $vmax > $v1;
4680             }
4681             }
4682 0           return $hwfd;
4683             }
4684              
4685              
4686             sub put_waveform {
4687 0     0 1   my $self = shift;
4688 0           my ( $hwfm, $tail ) = $self->_check_args_strict( \@_, ['waveform'] );
4689              
4690             # extra 'data' call parameters should override info in waveform, but
4691             # tricky to get it right...ignore call parameters for now
4692             # my $args = clone($tail);
4693             # delete($args->{source}) if exists $args->{source};
4694             # $self->set_data($args);
4695              
4696 0           my $ypos;
4697             my $ysca;
4698              
4699 0 0         if ( exists( $tail->{position} ) ) {
4700 0           $ypos = _parseNRf( $tail->{position}, 'div', 'division' );
4701 0 0         $ypos = 5 if $ypos eq 'MAX';
4702 0 0         $ypos = -5 if $ypos eq 'MIN';
4703 0 0 0       if ( $ypos eq 'ERR' || $ypos > 5 || $ypos < -5 ) {
      0        
4704 0           Lab::Exception::CorruptParameter->throw(
4705             "Invalid position '$tail->{position}'");
4706 0           return;
4707             }
4708             }
4709 0 0         if ( exists( $tail->{scale} ) ) {
4710 0           $ysca = _parseNRf( $tail->{scale}, 'V/div' );
4711 0 0         $ysca = 1e-3 if $ysca eq 'MIN';
4712 0 0         $ysca = 10 if $ysca eq 'MAX';
4713 0 0 0       if ( $ysca eq 'ERR' || $ysca < 1e-3 || $ysca > 10 ) {
      0        
4714 0           Lab::Exception::CorruptParameter->throw(
4715             "Invalid scale '$tail->{scale}'");
4716 0           return;
4717             }
4718             }
4719              
4720 0           my $fmt;
4721 0 0         $fmt = $tail->{encoding} if exists $tail->{encoding};
4722             $fmt = $hwfm->{'DAT:ENC'}
4723 0 0 0       if !defined($fmt) && exists( $hwfm->{'DAT:ENC'} );
4724 0 0         $fmt = $self->get_data_encoding() if !defined($fmt);
4725 0           $fmt = _keyword( $fmt, qw(ASC RI RP SRI SRP) );
4726 0           $fmt = _bloat( $fmt, { ASC => 'ASCI', RI => 'RIB', RP => 'RPB' } );
4727 0           $hwfm->{'DAT:ENC'} = $fmt;
4728              
4729 0           my $wd;
4730 0 0         $wd = $tail->{data_width} if exists $tail->{data_width};
4731 0 0 0       $wd = $hwfm->{'DAT:WID'} if !defined($wd) && exists $hwfm->{'DAT:WID'};
4732 0 0         $wd = $self->get_data_width() if !defined($wd);
4733 0           $wd = int( 0.5 + $wd );
4734 0 0 0       if ( $wd < 1 || $wd > 2 ) {
4735 0           Lab::Exception::CorruptParameter->throw("Invalid data width '$wd'");
4736 0           return;
4737             }
4738 0           $hwfm->{'DAT:WID'} = $wd;
4739              
4740 0           my ( $datamin, $datamax );
4741 0 0         if ( $wd == 1 ) {
4742 0 0         if ( $fmt =~ /RP/ ) {
4743 0           $datamin = 0x00;
4744 0           $datamax = 0xff;
4745             }
4746             else {
4747 0           $datamin = -128;
4748 0           $datamax = 127;
4749             }
4750             }
4751             else {
4752 0 0         if ( $fmt =~ /RP/ ) {
4753 0           $datamin = 0x0000;
4754 0           $datamax = 0xffff;
4755             }
4756             else {
4757 0           $datamin = -32768;
4758 0           $datamax = 32767;
4759             }
4760             }
4761              
4762 0 0 0       if ( defined($ypos) || defined($ysca) ) {
4763 0           my $ycenter = 0; # okay for signed integer binary and ascii
4764 0           my $ymul;
4765 0 0         if ( $wd == 1 ) {
4766 0 0         $ycenter = 127 if $fmt =~ /^\s*S?RP/i;
4767 0           $ymul = 25;
4768             }
4769             else {
4770 0 0         $ycenter = 32767 if $fmt =~ /^\s*S?RP/i;
4771 0           $ymul = 6554;
4772             }
4773              
4774 0 0         if ( defined($ypos) ) {
4775 0           $hwfm->{'WFMP:YZE'} = 0;
4776 0           $hwfm->{'WFMP:YOF'} = int( $ycenter + $ypos * $ymul );
4777             }
4778              
4779 0 0         if ( defined($ysca) ) {
4780 0           $hwfm->{'WFMP:YMU'} = sprintf( '%.3e', $ysca / $ymul );
4781             }
4782             }
4783              
4784 0           my $rawdata;
4785              
4786 0           my ( $xmin, $xmax, $ymin, $ymax, $jmin, $jmax );
4787 0           my $ptf = 'Y';
4788 0 0         $ptf = $hwfm->{'WFMP:PT_F'} if exists $hwfm->{'WFMP:PT_F'};
4789              
4790 0           my $jlim = 2500;
4791 0 0         $jlim = 1250 if $ptf ne 'Y'; # envelope, fewer bins
4792              
4793 0           my ( $jstart, $jstop );
4794              
4795 0 0         if ( exists( $tail->{start} ) ) {
4796 0           $jstart = _parseNRf( $tail->{start} );
4797 0 0         $jstart = 1 if $jstart eq 'MIN';
4798 0 0         $jstart = $jlim - 1 if $jstart eq 'MAX';
4799 0 0 0       if ( $jstart eq 'ERR' || $jstart < 1 || $jstart >= $jlim ) {
      0        
4800 0           Lab::Exception::CorruptParameter->throw(
4801             "Invalid start point '$tail->{start}'");
4802 0           return;
4803             }
4804             }
4805             else {
4806 0 0         $jstart = $hwfm->{'DAT:STAR'} if exists $hwfm->{'DAT:STAR'};
4807 0 0         $jstart = 1 unless defined $jstart;
4808             }
4809              
4810 0 0         if ( exists( $tail->{stop} ) ) {
4811 0           $jstop = _parseNRf( $tail->{stop} );
4812 0 0         $jstop = 2 if $jstop eq 'MIN';
4813 0 0         $jstop = $jlim if $jstop eq 'MAX';
4814 0 0 0       if ( $jstop eq 'ERR' || $jstop < 2 || $jstop > $jlim ) {
      0        
4815 0           Lab::Exception::CorruptParameter->throw(
4816             "Invalid stop point '$tail->{stop}'");
4817 0           return;
4818             }
4819             }
4820             else {
4821 0 0         $jstop = $hwfm->{'DAT:STOP'} if exists $hwfm->{'DAT:STOP'};
4822 0 0         $jstop = $jlim unless defined $jstop;
4823             }
4824              
4825 0           for ( my $j = 1; $j <= $jlim; $j++ ) {
4826 0 0 0       last if defined($jmin) && !defined( $hwfm->{t}->[$j] );
4827 0 0         next unless defined( $hwfm->{t}->[$j] );
4828 0 0 0       $jmin = $j unless defined $jmin && $jmin < $j;
4829 0 0 0       $jmax = $j unless defined $jmax && $jmax > $j;
4830 0           my $x = $hwfm->{t}->[$j];
4831 0 0 0       $xmin = $x unless defined $xmin && $xmin < $x;
4832 0 0 0       $xmax = $x unless defined $xmax && $xmax > $x;
4833              
4834 0 0         if ( $ptf eq 'Y' ) {
4835 0   0       my $y = $hwfm->{v}->[$j] || 0;
4836 0 0 0       $ymin = $y unless defined $ymin && $ymin < $y;
4837 0 0 0       $ymax = $y unless defined $ymax && $ymax > $y;
4838             }
4839             else {
4840 0   0       my $y0 = $hwfm->{vmin}->[$j] || 0;
4841 0   0       my $y1 = $hwfm->{vmax}->[$j] || 0;
4842 0 0 0       $ymin = $y0 unless defined $ymin && $ymin < $y0;
4843 0 0 0       $ymax = $y1 unless defined $ymax && $ymax > $y1;
4844             }
4845             }
4846              
4847 0 0         $hwfm->{'WFMP:XZE'} = $xmin unless exists $hwfm->{'WFMP:XZE'};
4848             $hwfm->{'WFMP:XIN'} = ( $xmax - $xmin ) / ( $jmax - $jmin )
4849 0 0         unless exists $hwfm->{'WFMP:XIN'};
4850              
4851 0 0         $jstart = $jmin if $jmin > $jstart;
4852 0 0         $jstop = $jmax if $jmax < $jstop;
4853              
4854 0 0         if ( $jstart >= $jstop ) {
4855 0           Lab::Exception::CorruptParameter->throw(
4856             "Invalid start ($jstart) >= stop ($jstop)");
4857 0           return;
4858             }
4859              
4860 0           $hwfm->{'DAT:STAR'} = $jstart;
4861 0           $hwfm->{'DAT:STOP'} = $jstop;
4862              
4863             # voltage = (binary - yoffset)*ymul + yzero
4864             # binary = (voltage-yzero)/ymul + yoffset
4865              
4866 0 0         $hwfm->{'WFMP:YOF'} = 0 unless exists $hwfm->{'WFMP:YOF'};
4867 0           my $yoff = $hwfm->{'WFMP:YOF'};
4868             $hwfm->{'WFMP:YZE'} = sprintf( '%.3e', $ymin - ( $ymax - $ymin ) / 200 )
4869 0 0         unless exists $hwfm->{'WFMP:YZE'};
4870 0           my $yzero = $hwfm->{'WFMP:YZE'};
4871             $hwfm->{'WFMP:YMU'} = sprintf( '%.3e', ( $ymax - $ymin ) / 200 )
4872 0 0         unless exists $hwfm->{'WFMP:YMU'};
4873 0           my $ymult = $hwfm->{'WFMP:YMU'};
4874              
4875 0           my ( @dat, $datapt );
4876 0           my $ds = 0;
4877              
4878 0 0         if ( $ptf eq 'Y' ) {
4879 0           for ( my $j = $jmin; $j <= $jmax; $j++ ) {
4880             $datapt
4881 0           = int( 0.5 + $yoff + ( $hwfm->{v}->[$j] - $yzero ) / $ymult );
4882 0 0         $datapt = $datamin if $datapt < $datamin;
4883 0 0         $datapt = $datamax if $datapt > $datamax;
4884 0           push( @dat, $datapt );
4885 0           $ds++;
4886             }
4887             }
4888             else {
4889 0           for ( my $j = $jmin; $j <= $jmax; $j += 2 ) {
4890             $datapt = int(
4891 0           0.5 + $yoff + ( $hwfm->{vmin}->[$j] - $yzero ) / $ymult );
4892 0 0         $datapt = $datamin if $datapt < $datamin;
4893 0 0         $datapt = $datamax if $datapt > $datamax;
4894 0           push( @dat, $datapt );
4895              
4896             $datapt = int(
4897 0           0.5 + $yoff + ( $hwfm->{vmax}->[$j] - $yzero ) / $ymult );
4898 0 0         $datapt = $datamin if $datapt < $datamin;
4899 0 0         $datapt = $datamax if $datapt > $datamax;
4900 0           push( @dat, $datapt );
4901              
4902 0           $ds += 2;
4903             }
4904             }
4905              
4906 0 0         if ( $fmt =~ /ASC/i ) {
4907 0           $rawdata = join( ',', @dat );
4908             }
4909             else {
4910 0           my $form;
4911              
4912 0 0         if ( $wd == 1 ) {
4913 0 0         if ( $fmt =~ /^\s*S?RP/i ) {
4914 0           $form = 'C';
4915             }
4916             else {
4917 0           $form = 'c';
4918             }
4919             }
4920             else {
4921 0 0         if ( $fmt =~ /^\s*S?RP/i ) {
4922 0           $form = 'S';
4923             }
4924             else {
4925 0           $form = 's';
4926             }
4927 0 0         if ( $fmt =~ /^\s*R/i ) {
4928 0           $form .= '>';
4929             }
4930             else {
4931 0           $form .= '<';
4932             }
4933 0           $ds = 2 * $ds;
4934             }
4935 0           $form .= '*';
4936 0           $ds = sprintf( '%d', $ds * $hwfm->{'DAT:WID'} );
4937 0           $rawdata = '#' . length($ds) . $ds;
4938 0           $rawdata .= pack( $form, @dat );
4939             }
4940              
4941             # since we now have the raw data, write all to scope
4942              
4943             # first, set the destination, if specified
4944              
4945 0 0         if ( exists( $tail->{destination} ) ) {
4946 0           $self->set_data_destination( $tail->{destination} );
4947             }
4948              
4949             # next the waveform prefix
4950 0           my $cmd = '';
4951 0           foreach my $k (qw(BYT_N XIN XZE YMU YZE YOF)) {
4952 0 0         if ( exists( $hwfm->{"WFMP:$k"} ) ) {
4953 0           $cmd .= "$k " . $hwfm->{"WFMP:$k"} . ";";
4954             }
4955             }
4956 0 0         $self->write( "WFMP:" . $cmd ) if $cmd ne '';
4957 0           $self->_debug();
4958              
4959 0           $cmd = '';
4960 0           foreach my $k (qw(STAR STOP ENC WID)) {
4961 0 0         if ( exists( $hwfm->{"DAT:$k"} ) ) {
4962 0           $cmd .= "$k " . $hwfm->{"DAT:$k"} . ";";
4963             }
4964             }
4965 0 0         $self->write( "DAT:" . $cmd ) if $cmd ne '';
4966 0           $self->_debug();
4967              
4968             # next the waveform data
4969 0           $cmd = 'CURV ' . $rawdata;
4970 0           $self->write($cmd);
4971 0           $self->_debug();
4972             }
4973              
4974              
4975             sub print_waveform {
4976 0     0 1   my $self = shift;
4977 0           my ( $in, $tail ) = $self->_check_args_strict( \@_, qw(waveform) );
4978              
4979 0 0 0       croak("must pass waveform as hashref")
4980             unless defined($in) && ref($in) eq 'HASH';
4981 0           my $out = *STDOUT;
4982 0 0         if ( exists( $tail->{output} ) ) {
4983 0 0         if ( ref( $tail->{output} ) =~ /(IO|GLOB)/ ) {
    0          
4984 0           $out = $tail->{output};
4985             }
4986             elsif ( ref( $tail->{output} ) eq '' ) {
4987 0           my $t;
4988 0           open( $t, ">$tail->{output}" );
4989 0           $out = $t;
4990             }
4991             else {
4992 0           carp("problem with output parameter");
4993             }
4994             }
4995              
4996 0           my $j = 0;
4997 0           foreach my $k ( sort( keys( %{$in} ) ) ) {
  0            
4998 0 0         next unless $k =~ /^(WFMP|DAT):/;
4999 0           print $out "$k: \t'", $in->{$k}, "'\n";
5000             }
5001              
5002 0           my $j0 = 1;
5003 0           my $j1 = 2500;
5004 0 0         $j0 = $in->{'DAT:STAR'} if exists $in->{'DAT:STAR'};
5005              
5006 0 0         if ( exists( $in->{v} ) ) {
    0          
5007              
5008 0 0         $j1 = $in->{'DAT:STOP'} if exists $in->{'DAT:STOP'};
5009              
5010 0           my $v = $in->{v};
5011 0           print $out "Voltages: \n";
5012 0           for ( my $j = $j0; $j <= $j1 - 5; $j += 5 ) {
5013 0           my $str = sprintf( '%04d: t=%+.3e ' . "\t", $j, $in->{t}->[$j] );
5014 0   0       for ( my $k = 0; $k < 5 && $j + $k <= $j1; $k++ ) {
5015 0           $str .= sprintf( '%+.3e ', $v->[ $j + $k ] ) . "\t";
5016             }
5017 0           print $out $str, "\n";
5018             }
5019             }
5020             elsif ( exists( $in->{vmin} ) ) {
5021              
5022 0           $j1 = 1250;
5023 0 0         $j1 = $in->{'DAT:STOP'} if exists $in->{'DAT:STOP'};
5024              
5025 0           my $vmin = $in->{vmin};
5026 0           my $vmax = $in->{vmax};
5027 0           print $out "Envelope:\n";
5028 0           my $str;
5029 0           for ( my $j = $j0; $j <= $j1 - 5; $j += 5 ) {
5030 0           $str = sprintf( '%04d: t=%+.3e MAX ' . "\t", $j, $in->{t}->[$j] );
5031 0   0       for ( my $k = 0; $k < 5 && $j + $k <= $j1; $k++ ) {
5032 0           $str .= sprintf( '%+.3e ', $vmax->[ $j + $k ] ) . "\t";
5033             }
5034 0           print $out $str, "\n";
5035 0           $str = sprintf( '%04d: t=%+.3e MIN ' . "\t", $j, $in->{t}->[$j] );
5036 0   0       for ( my $k = 0; $k < 5 && $j + $k <= $j1; $k++ ) {
5037 0           $str .= sprintf( '%+.3e ', $vmin->[ $j + $k ] ) . "\t";
5038             }
5039 0           print $out $str, "\n\n";
5040             }
5041             }
5042              
5043             }
5044              
5045             1; # End of Lab::Instrument::TDS2024B
5046              
5047             __END__
5048              
5049             =pod
5050              
5051             =encoding UTF-8
5052              
5053             =head1 NAME
5054              
5055             Lab::Instrument::TDS2024B - Tektronix TDS2024B digital oscilloscope
5056              
5057             =head1 VERSION
5058              
5059             version 3.880
5060              
5061             =head1 SYNOPSIS
5062              
5063             =over 4
5064              
5065             use Lab::Instrument::TDS2024B;
5066              
5067             my $s = new Lab::Instrument::TDS2024B (
5068             usb_serial => 'C12345',
5069             # usb_vendor and usb_product set automatically
5070             );
5071            
5072             $s->set_channel(3);
5073             $s->set_scale(scale=>'20mV/div');
5074             $s->set_display_persist(persist=>'5s');
5075             $s->set_acquire_average(32);
5076             $s->set_acquire_state(state=>'RUN');
5077              
5078             =back
5079              
5080             Many of the 'quantities' passed to the code can use scientific
5081             notation, order of magnitude suffixes ('u', 'm', etc) and unit
5082             suffixes. The routines can be called using positional parameters
5083             (check the documentation for order), or with keyword parameters.
5084              
5085             There are a few 'big' routines that let you set many parameters
5086             in one call, use keyword parameters for those.
5087              
5088             In general, keywords passed TO these routines are case-independent,
5089             with only the first few characters being significant. So, in the
5090             example above: state=>'Run', state=>'running', both work. In cases
5091             where the keywords distinguish an "on/off" situation (RUN vs STOP
5092             for acquistion, for example) you can use a Boolean quantity, and
5093             again, the Boolean values are flexible:
5094              
5095             =over
5096              
5097             TRUE = 't' or 'y' or 'on' or number!=0
5098              
5099             FALSE = 'f' or 'n' or 'off' or number ==0
5100              
5101             (only the first part of these is checked, case independent)
5102              
5103             =back
5104              
5105             The oscilloscope input 'channels' are CH1..CH4, but
5106             there are also MATH, REFA..REFD that can be displayed
5107             or manipulated. To perform operations on a channel, one
5108             should first $s->set_channel($chan); Channel can be
5109             specified as 1..4 for the input channels, and it will
5110             be translated to 'CH1..CH4'.
5111              
5112             The state of the TDS2024B scope is cached only when the
5113             front-panel is in a 'locked' state, so that it cannot be
5114             changed by users fiddling with knobs.
5115              
5116             =head1 GENERAL/SYSTEM ROUTINES
5117              
5118             =head2 new
5119              
5120             my $s = new Lab::Instrument::TDS2024B(
5121             usb_serial => '...',
5122             );
5123              
5124             serial only needed if multiple TDS2024B scopes are attached, it
5125             defaults to '*', which selects the first TDS2024B found. See
5126             Lab::Bus::USBtmc.pm documentation for more information.
5127              
5128             =head2 reset
5129              
5130             $s->reset()
5131              
5132             Reset the oscilloscope (*RST)
5133              
5134             =head2 get_error
5135              
5136             ($code,$message) = $s->get_error();
5137              
5138             Fetch an error from the device error queue
5139              
5140             =head2 get_status
5141              
5142             $status = $s->get_status(['statusbit']);
5143              
5144             Fetches the scope status, and returns either the requested
5145             status bit (if a 'statusbit' is supplied) or a reference to
5146             a hash of status information. Reading the status register
5147             causes it to be cleared. A status bit 'ERROR' is combined
5148             from the other error bits.
5149              
5150             Example: $s->get_status('OPC');
5151              
5152             Example: $s->get_status()->{'DDE'};
5153              
5154             Status bit names:
5155              
5156             =over
5157              
5158             B<PON>: Power on
5159              
5160             B<URQ>: User Request (not used)
5161              
5162             B<CME>: Command Error
5163              
5164             B<EXE>: Execution Error
5165              
5166             B<DDE>: Device Error
5167              
5168             B<QYE>: Query Error
5169              
5170             B<RQC>: Request Control (not used)
5171              
5172             B<OPC>: Operation Complete
5173              
5174             B<ERROR>: CME or EXE or DDE or QYE
5175              
5176             =back
5177              
5178             =head2 get_datetime
5179              
5180             $datetime = $s->get_datetime();
5181              
5182             fetches the date and time from the scope, returned
5183             in form "YYYY-MM-DD HH:MM:SS" (numeric month, 24hr time)
5184              
5185             =head2 set_datetime
5186              
5187             $s->set_datetime(); set to current date and time
5188             $s->set_datetime($unixtime); set to unix time $unixtime
5189              
5190             Note that the TDS2024B has no notion of 'time zones', so
5191             default is 'local time'.
5192              
5193             Returns the date and time in the same format as get_datetime.
5194              
5195             =head2 wait_done
5196              
5197             $s->wait_done([$time[,$deltaT]);
5198              
5199             $s->wait_done(timeout => $time, checkinterval=>$deltaT);
5200              
5201             Wait for "operation complete". If the $time optional argument
5202             is given, it is the (max) number of seconds to wait for completion
5203             before returning, otherwise a timeout of 10 seconds is used.
5204             $time can be a simple number of seconds, or a text string with
5205             magnitude and unit suffix. (Ex: $time = "200ms"). If $time="INF"
5206             then this routine will run indefinitely until completion (or some
5207             I/O error).
5208              
5209             If $deltaT is given, checks are performed in intervals of $deltaT
5210             seconds (again, number or text), except when $deltaT is less than $time.
5211             $deltaT defaults to 500ms.
5212              
5213             Returns 1 if completed, 0 if timed out.
5214              
5215             =head2 test_busy
5216              
5217             $busy = $s->test_busy();
5218              
5219             Returns 1 if busy (waiting for trigger, etc), 0 if not busy.
5220              
5221             =head2 get_id
5222              
5223             $s->get_id()
5224              
5225             Fetch the *IDN? string from device
5226              
5227             =head2 get_header
5228              
5229             $header = $s->get_header();
5230              
5231             Fetch whether headers are included
5232             with query response; returns 0 or 1.
5233              
5234             =head2 save
5235              
5236             $s->save($n);
5237              
5238             $s->save(setup=>$n);
5239              
5240             Save the scope setup to a nonvolatile internal memory $n = 1..10
5241              
5242             =head2 recall
5243              
5244             $s->recall($n);
5245              
5246             $s->recall(setup=>$n);
5247              
5248             Recall scope setup from internal memory location $n = 1..10
5249              
5250             =head2 set_header
5251              
5252             $s->set_header($boolean);
5253             $s->set_header(header=>$boolean);
5254              
5255             Turns on or off headers in query replies; Boolean
5256             values described above.
5257              
5258             =head2 get_verbose
5259              
5260             $verb = $s->get_verbose();
5261              
5262             Fetch boolean indicating whether query responses
5263             (headers, if enabled, and response keywords)
5264             are returned in 'long form'
5265              
5266             =head2 set_verbose
5267              
5268             $s->set_verbose($bool);
5269             $s->set_verbose(verbose=>$bool);
5270              
5271             Sets the 'verbose' mode for replies, with
5272             the longer form of command headers (if enabled) and
5273             keyword values. Note that
5274             when using the get_* routines, the replies are
5275             processed before being returned as 'long' values,
5276             so this routine only affects the communication
5277             between the scope and this code.
5278              
5279             =head2 get_locked
5280              
5281             $locked = $s->get_locked()
5282              
5283             Get whether user front-panel controls
5284             are locked. Returns 1 (all controls locked)
5285             or 0 (no controls locked). Caching for most
5286             quantities is turned off when the controls
5287             are unlocked.
5288              
5289             =head2 set_locked
5290              
5291             $s->set_locked($bool);
5292             $s->set_locked(locked=>$bool);
5293              
5294             Lock or unlock front panel controls;
5295              
5296             NOTE: locking the front panel
5297             enables the device_cache, and reinitializes cached values (other
5298             than the special ones that are not alterable from the front
5299             panel)
5300              
5301             =head2 get_setup
5302              
5303             $setup = get_setup();
5304              
5305             Get a long GPIB string that has the scope setup information
5306              
5307             Note that the scope I am testing with generates a
5308             "300, Device-specific error; no alternate chosen"
5309             error when triggering on "AC LINE". Might be a firmware
5310             bug, so filtering it out.
5311              
5312             =head2 set_setup
5313              
5314             $s->set_setup($setup);
5315              
5316             $s->set_setup(setup=>$setup);
5317              
5318             Send configuration to scope. The '$setup' string is
5319             of the form returned from get_setup(), but can be
5320             any valid command string for the scope. The setup
5321             string is processed into separate commands, and
5322             transmitted sequentially, to avoid communications
5323             timeouts.
5324              
5325             =head1 ACQUIRE ROUTINES
5326              
5327             =head2 get_acquire_mode
5328              
5329             $acqmode = $s->get_acquire_mode();
5330              
5331             Fetches acquisition mode: SAMple,PEAKdetect,AVErage
5332              
5333             =head2 set_acquire_mode
5334              
5335             $s->set_acquire_mode($mode);
5336             $s->set_acquire_mode(mode=>$mode);
5337              
5338             Sets the acquire mode: SAMple, PEAKdetect or AVErage
5339              
5340             =head2 get_acquire_numacq
5341              
5342             $numacq = $s->get_acquire_numacq();
5343              
5344             Fetch the number of acquisitions that have happened
5345             since starting acquisition.
5346              
5347             =head2 get_acquire_numavg
5348              
5349             $numavg = $s->get_acquire_numavg();
5350              
5351             Fetch the number of waveforms specified for averaging
5352              
5353             =head2 set_acquire_numavg
5354              
5355             $s->set_acquire_numavg($n);
5356             $s->set_acquire_numavg(average=>$n);
5357              
5358             Set the number of waveforms to average
5359             valid values are 4, 16, 64 and 128
5360              
5361             =head2 get_acquire_state
5362              
5363             $state = $s->get_acquire_state()
5364              
5365             Fetch the acquisition state: STOP (stopped) or RUN (running)
5366             NOTE: to check if acq is complete: wait_done()
5367              
5368             =head2 set_acquire_state
5369              
5370             $s->set_acquire_state($state);
5371             $s->set_acquire_state(state=>$state);
5372              
5373             $state = 'RUN' (or boolean 'true') starts acquisition
5374             'STOP' (or boolean 'false') stops acquisition
5375              
5376             =head2 get_acquire_stopafter
5377              
5378             $mode = $s->get_acquire_stopafter();
5379              
5380             Fetch whether acquisition is in "RUNSop" mode (run until stopped)
5381             or "SEQuence" mode
5382              
5383             =head2 set_acquire_stopafter
5384              
5385             $s->set_acquire_stopafter($mode);
5386             $s->set_acquire_stopafter(mode=>$mode);
5387              
5388             Sets stopafter mode: RUNStop : run until stopped,
5389             or SEQuence: stop after some defined sequence (single trigger, pattern, etc)
5390              
5391             =head2 get_acquire
5392              
5393             %hashref = $s->get_acquire();
5394              
5395             Get the "acquire" information in a hash; this is a combined
5396             "get_acquire_*" with the keywords that can be use for set_acquire()
5397              
5398             =head2 set_acquire
5399              
5400             $s->set_acquire(state=>$state, # RUN|STOP (or boolean)
5401             mode=>$mode, # SAM|PEAK|AVE
5402             stopafter=>$stopa # STOPAfter|SEQ
5403             average=>$navg);
5404             $s->set_acquire($hashref); # from get_acquire
5405             $s->set_acquire($state,$mode,$stopa,$navg);
5406              
5407             Sets acquisition parameters
5408              
5409             =head2 get_autorange_state
5410              
5411             $arstate = $s->get_autorange_state()
5412              
5413             Fetch the autorange state, boolean, indicating
5414             whether the scope is autoranging
5415              
5416             =head2 set_autorange_state
5417              
5418             $s->set_autorange_state(state=>$bool);
5419             $s->set_autorange_state($bool);
5420              
5421             Set autoranging on or off.
5422              
5423             =head2 get_autorange_settings
5424              
5425             $arset = $s->get_autorange_settings()
5426              
5427             Fetch the autorange settings, returns
5428             value (HORizontal|VERTical|BOTH)
5429              
5430             =head2 set_autorange_settings
5431              
5432             $s->set_autorange_settings(set=>$arset);
5433              
5434             $s->set_autorange_settings($arset);
5435              
5436             Set what is subject to autoranging: $arset = HORizontal, VERTical, BOTH
5437              
5438             =head2 do_autorange
5439              
5440             $s->do_autorange();
5441              
5442             Causes scope to adjust horiz/vert, like pressing 'autoset' button
5443             This command may take some time to complete.
5444              
5445             =head2 get_autorange_signal
5446              
5447             $sig = $s->get_autorange_signal()
5448              
5449             returns the type of signal found by the most recent autoset, or NON
5450             if the autoset menu is not displayed.
5451              
5452             =head2 get_autorange_view
5453              
5454             $view = $s->get_autoset_view();
5455              
5456             Fetch the menu display; view can be one of (depending on scope options):
5457             MULTICY SINGLECY FFT RISING FALLING FIELD ODD EVEN LINE LINEN DCLI DEF NONE
5458              
5459             =head2 set_autorange_view
5460              
5461             $s->set_autoset_view($view)
5462              
5463             $s->set_autoset_view(view=>$view)
5464              
5465             Set the menu display; view can be one of (depending on scope options):
5466             MULTICY SINGLECY FFT RISING FALLING FIELD ODD EVEN LINE LINEN DCLI DEF NONE
5467              
5468             =head2 get_autorange
5469              
5470             %hashref = $s->get_autorange();
5471              
5472             get autorange settings as a hash
5473              
5474             =head1 CHANNEL ROUTINES
5475              
5476             =head2 get_channel
5477              
5478             $chan = $s->get_channel();
5479              
5480             Get the current channel selected for operations 1..4
5481              
5482             =head2 set_channel
5483              
5484             $s->set_channel(channel=>$chan);
5485             $s->set_channel($chan);
5486              
5487             sets the channel number (1..4) for operations
5488             with the set_chan_XXX and get_chan_YYY methods
5489             on oscilloscope channels
5490              
5491             Channel can be specified as an integer 1..4, or Ch1, Ch2, etc.,
5492             or 'MATH'.
5493              
5494             =head2 get_vertical_settings
5495              
5496             This is like get_chan_setup, but faster (one query
5497             to scope) and output is kept in original form.
5498              
5499             $settings = $s->get_vertical_settings($chan);
5500             $settings = $s->get_vertical_settings(channel => $chan);
5501              
5502             $chan = scope channel or MATH
5503              
5504             Fetch the vertical settings for a channel into a
5505             hash structure (example for CH1):
5506             $settings->{CH1:POS} # position on display
5507             $settings->{CH1:INV} # inverted?
5508             $settings->{CH1:SCAL} # vertical scale
5509             $settings->{CH1:YUN} # units for y-axis (volts, db, etc)
5510             $settings->{CH1:PRO} # voltage probe attenuation
5511             $settings->{CH1:CURRENTPRO} # current probe attenuation
5512             $settings->{CH1:COUP} # input coupling (AC, DC,..)
5513             $settings->{CH1:BANWID} # input bandwidth setting
5514             $settings->{MATH:DEFINE} # math definition, if $chan=MATH
5515              
5516             =head2 set_visible
5517              
5518             $s->set_visible([$chan,[$vis]]);
5519              
5520             $s->set_visible(channel=>$chan [, visible=>$vis]);
5521              
5522             Set/reset channel visiblity.
5523              
5524             If no channel is given, the current channel (set by set_channel ) is used.
5525             Otherwise $chan = CH1..4, REFA..D, MATH
5526              
5527             If $vis is not specified, it defaults to "make channel visible".
5528              
5529             To make turn off display of a channel, use $vis=(boolean false).
5530              
5531             =head2 get_visible
5532              
5533             $vis = $s->get_visible($chan);
5534              
5535             $vis = $s->get_visible(channel=>$chan);
5536              
5537             Fetch boolean value for whether the channel (CH1..4, REFA..D, MATH) is
5538             being displayed. If channel is not specified, the current channel
5539             (from 'set_channel()') is used.
5540              
5541             =head2 get_chan_bwlimit
5542              
5543             $bwlim = $s->get_chan_bwlimit()
5544              
5545             Fetch whether the channel has bandwidth limited to 20MHz
5546             (boolean)
5547              
5548             =head2 set_chan_bwlimit
5549              
5550             $s->set_chan_bwlimit(limit=>'on')
5551              
5552             Turns on or off bandwith limiting (limit = boolean, true = 'limit')
5553              
5554             =head2 get_chan_coupling
5555              
5556             $coupling = $s->get_chan_coupling()
5557              
5558             Fetch the channel coupling (AC/DC/GND).
5559              
5560             =head2 set_chan_coupling
5561              
5562             $s->set_coupling(coupling => $coupling);
5563              
5564             Set the coupling to AC|DC|GND for an input channel
5565              
5566             =head2 get_chan_current_probe
5567              
5568             $iprobe = $s->get_chan_current_probe();
5569              
5570             Get the probe scale factor. This does not mean that a
5571             current probe is in use, just what 'probe scale factor'
5572             would be applied if current probe use is selected.
5573              
5574             =head2 set_chan_current_probe
5575              
5576             $self->set_chan_current_probe(factor=>$x);
5577              
5578             Set the current probe scale factor. Valid values
5579             are 0.2, 1, 2, 5, 10, 50, 100, 1000
5580              
5581             =head2 get_chan_invert
5582              
5583             $inv = $s->get_chan_invert();
5584              
5585             fetch whether the channel is 'inverted' -> boolean
5586              
5587             =head2 set_chan_invert
5588              
5589             $s->set_chan_invert(invert=>$inv);
5590              
5591             sets a channel to 'invert' mode if $inv is true, $inv=boolean
5592              
5593             =head2 get_chan_position
5594              
5595             $p = $s->get_chan_position();
5596              
5597             get the vertical position of "zero volts" for a channel
5598             The value is the number of graticule divisions from the
5599             center.
5600              
5601             =head2 set_chan_position
5602              
5603             $s->set_chan_position(position=> -24)
5604              
5605             Sets the trace 'zero' position, in graticule divisions
5606             from the center of the display.
5607             Note that the limits depend on the vertical scale,
5608             +/- 50V for >= 500mV/div, +/- 2V for < 500mV/div
5609              
5610             =head2 get_chan_probe
5611              
5612             $probe = $s->get_chan_probe();
5613              
5614             Fetch the voltage probe attenuation.
5615              
5616             =head2 set_chan_probe
5617              
5618             $self->set_chan_probe(factor=>X);
5619              
5620             Set the voltage probe scale factor. Valid values
5621             are 1, 10, 20, 50, 100, 500, 1000
5622              
5623             =head2 get_chan_scale
5624              
5625             $scale = $s->get_chan_scale();
5626              
5627             Fetch the vertical scale for a channel, in V/div
5628             (or A/div when used with a current probe)
5629              
5630             =head2 set_chan_scale
5631              
5632             $self->set_chan_scale(scale=>$scale);
5633              
5634             Set the vertical scale for a channel, in V/div or
5635             A/div. X can be a number, or a string with suffixes and units
5636             Ex: '2.0V/div' '100m'.
5637              
5638             =head2 get_chan_yunit
5639              
5640             $scale = $s->get_chan_yunit();
5641              
5642             Fetch the units for the vertical scale of a channel,
5643             returns either "V" or "A"
5644              
5645             =head2 set_chan_yunit
5646              
5647             $self->set_chan_yunit(unit=>X);
5648              
5649             Set the vertical scale units to either 'V' or 'A'
5650              
5651             =head2 get_chan_setup
5652              
5653             $hashref = $s->get_chan_setup([channel=>$chan])
5654              
5655             Fetches channel settings and returns them as a
5656             hashref:
5657             =over 2
5658             =item channel => channel selected (otherwise default from set_channel)
5659             =item probe => probefactor,
5660             =item postion => screen vertical position, in divisions
5661             =item scale => screen vertical scale, V/div or A/div
5662             =item coupling => (AC|DC|GND)
5663             =item bandwidth => (ON|OFF)
5664             =item yunit => (V|A)
5665             =item invert => ON|OFF
5666             =item probe => probe attentuation (for yunit=V)
5667             =item currentprobe => current probe factor (for yunit=A)
5668             =back
5669              
5670             The hash is set up so that it can be passed to
5671             $s->set_channel($hashref)
5672              
5673             =head2 set_chan_setup
5674              
5675             $s->set_channel([channel=>1],scale=>...)
5676              
5677             Can pass the hash returned from "get_chan_setup" to
5678             set a an oscilloscope channel to the desired state.
5679              
5680             TODO: check current/voltage probe selection,
5681             adjust order of calls to avoid settings conflicts
5682              
5683             =head1 CURSOR CONTROLS
5684              
5685             The cursors can either be 'horizontal bars' (HBARS), attached to
5686             a particular trace, measuring amplitude; or 'vertical bars' (VBARS)
5687             that are measuring horizontally (time or frequency).
5688              
5689             Since these names can be confusing, you can also use 'X' to select VBARS and
5690             'Y' to select HBARS, since that gives a more natural indication of what
5691             you are measuring.
5692              
5693             =head2 get_cursor_type
5694              
5695             $cursor = $s->get_cursor_type([$opt]);
5696              
5697             $cursor = $s->get_cursor_type([option=>$opt]);
5698              
5699             Fetch cursor type: (OFF|HBARS|VBARS) default
5700              
5701             cursor type returned as: (OFF|X|Y) if $opt = 'xy';
5702              
5703             =head2 set_cursor_type
5704              
5705             $s->set_cursor_type($type);
5706              
5707             $s->set_cursor_type(type=>$type)
5708              
5709             $type = OFF|HBAr|Y|VBAr|X
5710              
5711             =head2 get_cursor_xunits
5712              
5713             $units = $s->get_cursor_xunits()
5714              
5715             gets the x (horizontal) units for the cursors (VBAR type),
5716             returns either SECONDS or HERTZ.
5717              
5718             =head2 get_cursor_yunits
5719              
5720             $self->get_cursor_yunits();
5721              
5722             Fetch the units used for the cursor y positions (HBARS, or the
5723             waveform vertical position with VBARS).
5724              
5725             The units returned can be: VOLTS, DIVISIONS, DECIBELS UNKNOWN AMPS
5726             VOLTSSQUARED AMPSSQUARED VOLTSAMPS.
5727              
5728             =head2 get_cursor_source
5729              
5730             $src = $s->get_cursor_source();
5731              
5732             Fetch the source waveform being used with the cursors, determines
5733             the units of the cursor for horizontal bar (HBAR, Y) cursors.
5734              
5735             =head2 set_cursor_source
5736              
5737             $s->set_cursor_sourch($chan);
5738              
5739             $s->set_cursor_source(channel => $chan);
5740              
5741             =head2 set_cursor_xunits
5742              
5743             $s->set_cursor_xunits($units);
5744              
5745             $s->set_cursor_xunits(unit=>$units);
5746              
5747             Set the units used for VBAR (x) cursor, for VBAR the possible
5748             units are (SEConds|s) or (HERtz|Hz). HBAR cursor units
5749             cannot be changed.
5750              
5751             =head2 get_cursor_dx
5752              
5753             $delt = $s->get_cursor_dx();
5754              
5755             Fetch the difference between x (VBAR) cursor positions.
5756              
5757             =head2 get_cursor_dy
5758              
5759             $delt = $s->get_cursor_dy();
5760              
5761             Fetch the difference between y (HBAR) cursor positions.
5762              
5763             =head2 get_cursor_x1
5764              
5765             $pos = $s->get_cursor_x1();
5766              
5767             Fetch the x position of cursor 1 (VBAR), typically in
5768             units of seconds.
5769              
5770             =head2 get_cursor_x2
5771              
5772             $pos = $s->get_cursor_x2();
5773              
5774             Fetch the x position of cursor 2 (VBAR), typically in
5775             units of seconds.
5776              
5777             =head2 get_cursor_y1
5778              
5779             $pos = $s->get_cursor_y1();
5780              
5781             Fetch the y position of cursor 1 (HBAR), typically in
5782             units of volts, but possibly other units
5783              
5784             =head2 get_cursor_y2
5785              
5786             $pos = $s->get_cursor_y2();
5787              
5788             Fetch the y position of cursor 2 (HBAR), typically in
5789             units of volts, but possibly other units.
5790              
5791             =head2 set_cursor_x1
5792              
5793             $s->set_cursor_x1($location);
5794              
5795             $s->set_cursor_x1(position => $location);
5796              
5797             set cursor 1 x location (VBAR type cursor)
5798              
5799             =head2 set_cursor_x2
5800              
5801             $s->set_cursor_x2($location);
5802              
5803             $s->set_cursor_x2(position => $location);
5804              
5805             set cursor 2 x location (VBAR type cursor)
5806              
5807             =head2 set_cursor_y1
5808              
5809             $s->set_cursor_y1($location);
5810              
5811             $s->set_cursor_y1(position => $location);
5812              
5813             set cursor 1 y position (HBAR type)
5814              
5815             =head2 set_cursor_y2
5816              
5817             $s->set_cursor_y2($location);
5818              
5819             $s->set_cursor_y2(position => $location);
5820              
5821             set cursor 2 y position (HBAR type)
5822              
5823             =head2 get_cursor_v1
5824              
5825             $vcursor = $s->get_cursor_v1();
5826              
5827             If using HBAR (y) cursors, get the vertical position of cursors;
5828             if using VBAR (x) cursors, get the waveform voltage (or other vertical unit)
5829             at the cursor1 position.
5830              
5831             =head2 get_cursor_v2
5832              
5833             $vcursor = $s->get_cursor_v2();
5834              
5835             If using HBAR (y) cursors, get the vertical position of cursors;
5836             if using VBAR (x) cursors, get the waveform voltage (or other vertical unit)
5837             at the cursor2 position.
5838              
5839             =head2 get_cursor_dv
5840              
5841             $dv = $s->get_cursor_dv();
5842              
5843             Get the vertical distance between the cursors (dy if HBAR cursors,
5844             dv2-dv1 if VBAR cursors)
5845              
5846             =head2 $hashref = $s->get_cursor()
5847              
5848             Fetches cursor information and returns it in a hash,
5849             in a form that can be used with set_cursor()
5850              
5851             =head2 set_cursor
5852              
5853             $s->set_cursor( type=>$type,
5854             x1 => $x1, x2 => $x2, ...);
5855              
5856             sets cursor information. If used with a hash from get_cursor, the
5857             entries that cannot be used to set the cursors are ignored
5858              
5859             =head1 DISPLAY CONTROLS
5860              
5861             =head2 get_display_contrast
5862              
5863             $cont = $s->get_display_contrast()
5864              
5865             Fetches the display contrast: 1 .. 100
5866              
5867             =head2 set_display_contrast
5868              
5869             $s->set_display_contrast($cont)
5870              
5871             (alternate set_display_contrast(contrast => number) )
5872             Set the display contrast, percent 1..100
5873              
5874             =head2 get_display_format
5875              
5876             $form = $s->get_display_format()
5877              
5878             Fetch the display format: YT or XY
5879              
5880             =head2 set_display_format
5881              
5882             $s->set_display_format($format);
5883              
5884             $s->set_display_format(format => $format);
5885              
5886             Where $format = XY or YT.
5887              
5888             =head2 get_display_persist
5889              
5890             $pers = $s->get_display_persist()
5891              
5892             Fetch the display persistance, values 1,2,5,INF,OFF
5893             Numbers are in seconds.
5894              
5895             =head2 set_display_persist
5896              
5897             $s->set_display_persist($pers);
5898              
5899             $s->set_display_persist(persist=>$pers);
5900              
5901             Sets display persistence. $pers = 1,2,5 seconds, INF, or OFF
5902              
5903             =head2 get_display_style
5904              
5905             $style = $s->get_display_style()
5906              
5907             Fetch the display style = 'DOTS' or 'VECTORS'
5908              
5909             =head2 set_display_style
5910              
5911             $s->set_display_style($style)l\;
5912              
5913             $s->set_display_style(style=>$style);
5914              
5915             Sets the display style: $style is DOTs or VECtors
5916              
5917             =head2 get_display
5918              
5919             $hashref = $s->get_display();
5920              
5921             Fetch display settings (contrast, format, etc) in a
5922             hash, that can be used with "set_display".
5923              
5924             =head2 set_display
5925              
5926             $s->set_display(contrast=>$contrast, ...)
5927              
5928             Set the display characteristics
5929              
5930             =head1 FILESYSTEM ROUTINES
5931              
5932             =head2 get_cwd
5933              
5934             $s->get_cwd();
5935              
5936             Gets the current working directory on any USB flash drive
5937             plugged into the oscilloscope, or a null string ( '' ) if
5938             no drive is plugged in.
5939              
5940             =head2 set_cwd
5941              
5942             $s->set_cwd($cwd);
5943              
5944             $s->set_cwd(cwd => $cwd);
5945              
5946             Set the current working directory on the flash drive.
5947             The flash drive is on the "A:" drive, and the cwd uses
5948             "DOS" type syntax. For compatibility, forward slashes
5949             are translated to backslashes.
5950              
5951             It would be a good idea to check for errors after
5952             this call.
5953              
5954             =head2 delete
5955              
5956             $self->delete($file);
5957              
5958             $self->delete(file => $file);
5959              
5960             Delete a file from the USB filesystem; use DOS format, and
5961             note that the USB filesystem is on "A:\topdir\subdir..."
5962              
5963             For ease of use, this routine translates forward slashes
5964             to backslashes. It would be a good idea to check for errors
5965             after calling this routine.
5966              
5967             =head2 get_dir
5968              
5969             @files = $s->get_dir();
5970              
5971             Get a list of filenames in the current (USB flash drive)
5972             directory.
5973              
5974             =head2 get_freespace
5975              
5976             $bytes = $s->get_freespace();
5977              
5978             Get the amount of freespace on the USB flash.
5979              
5980             =head2 mkdir
5981              
5982             $s->mkdir($dirname);
5983              
5984             $s->mkdir(directory=>$dirname);
5985              
5986             Create a directory on the flash drive, uses MSDOS
5987             file syntax, only on the A: drive.
5988              
5989             Forward slashes are translated to backslashes for compatibility.
5990              
5991             It is a good idea to check for errors after calling this routine.
5992              
5993             =head2 rename
5994              
5995             $s->rename($old,$new);
5996              
5997             $s->rename(old=>$old, new=>$new);
5998              
5999             Rename $old filepath to $new filepath. Note that these are in
6000             MSDOS file syntax, all on the "A:" drive.
6001              
6002             Forward slashes are translated to backslashes.
6003              
6004             It is a good idea to check for errors after calling this routine.
6005              
6006             =head2 rmdir
6007              
6008             $s->rmdir($dir);
6009              
6010             $s->rmdir(directory=>$rmdir);
6011              
6012             Removes a directory from the USB flash drive. The directory
6013             name is in MSDOS syntax; forward slashes are translated to
6014             backslashes.
6015              
6016             A directory must be empty before deletion; it is a good idea
6017             to check for errors after calling this routien.
6018              
6019             =head1 HARDCOPY ROUTINES
6020              
6021             =head2 get_hardcopy_format
6022              
6023             $format = $s->get_hardcopy_format();
6024              
6025             Fetch the hardcopy format, returns one of:
6026              
6027             =over 4
6028              
6029             BMP BUBBLEJET DESKJET DPU3445 DPU411 DPU412 EPSC60 EPSC80
6030              
6031             EPSIMAGE EPSON INTERLEAF JPEG LASERJET PCX RLE THINK TIFF
6032              
6033             =back
6034              
6035             =head2 set_hardcopy_format
6036              
6037             $s->set_hardcopy_format($format);
6038              
6039             $s->set_hardcopy_format(format => $format);
6040              
6041             Set the 'hardcopy' format, used for screen captures:
6042              
6043             =over 4
6044              
6045             BMP BUBBLEJET DESKJET DPU3445 DPU411 DPU412 EPSC60 EPSC80
6046              
6047             EPSIMAGE EPSON INTERLEAF JPEG LASERJET PCX RLE THINK TIFF
6048              
6049             =back
6050              
6051             =head2 get_hardcopy_layout
6052              
6053             $layout = $s->get_hardcopy_layout();
6054              
6055             Fetch the hardcopy layout: PORTRAIT or LANDSCAPE
6056              
6057             =head2 set_hardcopy_layout
6058              
6059             $s->set_hardcopy_layout($layout);
6060              
6061             $s->set_hardcopy_layout(layout => $layout);
6062              
6063             Set the hardcopy layout: LANdscpe or PORTRait.
6064              
6065             =head2 get_hardcopy_port
6066              
6067             $port = $s->get_hardcopy_port();
6068              
6069             Fetch the port used for hardcopy printing; for the TDS2024B, this
6070             should aways return 'USB'.
6071              
6072             =head2 set_hardcopy_port
6073              
6074             $s->set_hardcopy_port($port);
6075              
6076             $s->set_hardcopy_port(port => $port);
6077              
6078             Set the hardcopy port; for the TDS2024B, this should always be USB.
6079             Included for compatibility with other scopes.
6080              
6081             =head2 get_hardcopy
6082              
6083             $hashref = get_hardcopy();
6084              
6085             Fetch hardcopy parameters (format, layout, port; although
6086             port is always 'USB') and return in a hashref.
6087              
6088             =head2 set_hardcopy
6089              
6090             $s->set_hardcopy(format=>$format, layout=>$layout, port=>$port);
6091              
6092             Set hardcopy parameters; this can use a hashref returned from
6093             get_hardcopy();
6094              
6095             =head2 get_image
6096              
6097             $img = $s->get_image();
6098              
6099             $img = $s->get_image($filename[, $force]);
6100              
6101             $img = $s->get_image(file=>$filename, force=>$force,
6102             timeout=>$timeout, read_length=>$rlength,
6103             [hardcopy options]);
6104              
6105             Fetch a screen-capture image of the scope, using the the current
6106             hardcopy options (format, layout). If the filename is specified, write
6107             to that filename (in addition to returning the image data); error
6108             if the file already exists, unless $force is true.
6109              
6110             timeout (in seconds) and read_length (in bytes) are only passed with
6111             the "hash" form of the call.
6112              
6113             =head1 HORIZONTAL CONTROL ROUTINES
6114              
6115             =head2 get_horiz_view
6116              
6117             $view = $s->get_horiz_view();
6118              
6119             Fetch the horizontal view: MAIN, WINDOW, ZONE
6120              
6121             WINDOW is a selection of the MAIN view; ZONE is
6122             the same as MAIN, but with vertical bar cursors
6123             to show the range displayed in WINDOW view.
6124              
6125             =head2 set_horiz_view
6126              
6127             $s->set_horiz_view($view);
6128              
6129             $s->set_horiz_view(view=>$view);
6130              
6131             Set the horizontal view to MAIn, WINDOW, or ZONE.
6132              
6133             =head2 get_horiz_position
6134              
6135             $pos = $s->get_horiz_position();
6136              
6137             Fetch the horizontal position of the main view, in seconds; this
6138             is the difference between the trigger point and the horizontal
6139             center of the screen.
6140              
6141             =head2 set_horiz_position
6142              
6143             $s->set_horiz_position($t);
6144              
6145             $s->set_horiz_position(time => $t);
6146              
6147             Set the horizontal position, in seconds, for the main view.
6148             Positive time values puts the trigger point to the left of the
6149             center of the screen.
6150              
6151             =head2 get_delay_position
6152              
6153             $time = $s->get_delay_position();
6154              
6155             Fetch the delay time for the WINDOW view. Time is relative to the
6156             center of the screen.
6157              
6158             =head2 set_delay_position
6159              
6160             $s->set_delay_position($time);
6161              
6162             $s->set_delay_position(delaytime=>$time);
6163              
6164             Set the postion of the WINDOW view horizontally. $time is in
6165             seconds, relative to the center of the screen.
6166              
6167             =head2 get_horiz_scale
6168              
6169             $secdiv = $s->get_horiz_scale();
6170              
6171             Fetch the scale (in seconds/division) for the 'main' view.
6172              
6173             =head2 set_horiz_scale
6174              
6175             $s->set_horiz_scale($secdiv);
6176              
6177             $s->set_horiz_scale(scale=>$secdiv);
6178              
6179             Set the horizontal scale, main window, to $secdiv
6180             seconds/division.
6181              
6182             =head2 get_delay_scale
6183              
6184             $secdiv = $s->get_delay_scale();
6185              
6186             Fetch the scale (in seconds/division) for the 'window' view.
6187              
6188             =head2 set_del_scale
6189              
6190             $s->set_del_scale($secdiv);
6191              
6192             $s->set_del_scale(delayscale=>$secdiv);
6193              
6194             Set the horizontal scale, window view, to $secdiv
6195             seconds/division.
6196              
6197             =head2 get_recordlength
6198              
6199             $samples = $s->get_recordlength();
6200              
6201             Returns record length, in number of samples. For the TDS200B,
6202             this is always 2500, so a constant is returned.
6203              
6204             =head2 get_horizontal
6205              
6206             $hashref = $s->get_horizontal();
6207              
6208             Fetch a hashref, with entries that describe the horizontal setup, and
6209             can be passesd to set_horizontal
6210              
6211             keys: view, time, delaytime, scale, delayscale, recordlength
6212              
6213             =head2 set_horizontal
6214              
6215             $s->set_horizontal(time=>..., scale=>...);
6216              
6217             Set the horizontal characteristics. See get_horizontal()
6218              
6219             =head1 MATH/FFT ROUTINES
6220              
6221             =head2 get_math_definition
6222              
6223             $string = $s->get_math_definition();
6224              
6225             Fetch the definition used for the MATH waveform
6226              
6227             =head2 set_math_definition
6228              
6229             $s->set_math_definition($string);
6230              
6231             $s->set_math_definition(math => $string);
6232              
6233             Define the 'MATH' waveform; the input is sufficiently complex that
6234             the user should check for errors after calling this routine.
6235              
6236             Choices:
6237              
6238             =over
6239              
6240             CH1+CH2
6241              
6242             CH3+CH4
6243              
6244             CH1-CH2
6245              
6246             CH2-CH1
6247              
6248             CH3-CH4
6249              
6250             CH4-CH3
6251              
6252             CH1*CH2
6253              
6254             CH3*CH4
6255              
6256             FFT (CHx[, <window>])
6257              
6258             =back
6259              
6260             <window> is HANning, FLATtop, or RECTangular.
6261              
6262             =head2 get_math_position
6263              
6264             $y => $s->get_math_position();
6265              
6266             Fetch the MATH trace vertical position, in divisions
6267             from the center of the screen.
6268              
6269             =head2 set_math_position
6270              
6271             $s->set_math_position($y);
6272              
6273             $s->set_math_postition(position=>$y);
6274              
6275             Set the MATH trace veritical position, in divisions from the center
6276             of the screen.
6277              
6278             =head2 get_fft_xposition
6279              
6280             $pos = $s->get_fft_xposition();
6281              
6282             Fetch FFT horizontal position, a percentage of the total FFT
6283             length, relative to the center of the screen.
6284              
6285             =head2 set_fft_xposition
6286              
6287             $s->set_fft_xposition($percent);
6288              
6289             $s->set_fft_xposition(fft_xposition=>$percent);
6290              
6291             Set the horizontal position of the FFT trace; the "percent"
6292             of the trace is placed at the center of the screen.
6293              
6294             =head2 get_fft_xscale
6295              
6296             $scale = $s->get_fft_xscale();
6297              
6298             Fetch the horizontal zoom factor for FFT display,
6299             possible values are 1,2,5 and 10.
6300              
6301             =head2 set_fft_xscale
6302              
6303             $s->set_fft_xscale($zoom);
6304              
6305             $s->set_fft_xscale(fft_xscale => $zoom);
6306              
6307             Set the FFT horizontal scale zoom factor: 1,2,5, or 10.
6308              
6309             =head2 get_fft_position
6310              
6311             $divs = $s->get_fft_position();
6312              
6313             Fetch the y position of the FFT display, in division from the
6314             screen center.
6315              
6316             =head2 set_fft_position
6317              
6318             $s->set_fft_position($divs);
6319              
6320             $s->set_fft_position(fft_position=>$divs);
6321              
6322             Set the FFT trace y position, in screen divisions relative to the
6323             screen center.
6324              
6325             =head2 get_fft_scale
6326              
6327             $zoom = $s->get_fft_scale();
6328              
6329             Fetch the FFT vertical zoom factor, returns one of 0.5, 1, 2, 5, 10
6330              
6331             =head2 set_fft_scale
6332              
6333             $s->set_fft_scale($zoom);
6334              
6335             $s->set_fft_yscale(fft_scale => $zoom);
6336              
6337             Set the fft vertical zoom factor, valid values are
6338             0.5, 1, 2, 5, 10
6339              
6340             =head1 MEASUREMENT ROUTINES
6341              
6342             The TDS2024B manual suggests using the 'IMMediate' measurements;
6343             when measurements 1..5 are used, it results in an on-screen display
6344             of the measurement results, because the on-screen display is update
6345             (at most) every 500ms. It would be a good idea to check for errors
6346             after calling get_measurement_value, because errors can result if
6347             the waveform is out of range. Also note that when the MATH trace
6348             is in FFT mode, 'normal' measurement is not possible.
6349              
6350             The 'IMMediate' measurements cannot be accessed from the scope
6351             front panel, so will be cached even if the scope is in an 'unlocked'
6352             state. (see set_locked)
6353              
6354             =head2 get_measurement_type
6355              
6356             $type = $s->get_measurement_type($n);
6357              
6358             $type = $s->get_measurement_type(measurement=>$n);
6359              
6360             Fetch the measurement type for measurement $n = 'IMMediate' or 1..5
6361             $n defaults to 'IMMediate'
6362              
6363             returns one of:
6364             FREQuency | MEAN | PERIod |
6365             PHAse | PK2pk | CRMs | MINImum | MAXImum | RISe | FALL |
6366             PWIdth | NWIdth | NONE
6367              
6368             =head2 set_measurement_type
6369              
6370             $s->set_measurement_type($n,$type);
6371              
6372             $s->set_measurement_type(measurement=>$n, type=>$type);
6373              
6374             $s->set_measurement_type($type); (defaults to $n = 'IMMediate')
6375              
6376             Set the measurement type, for measurement $n= 'IMMediate', 1..5
6377              
6378             The type is one of: FREQuency | MEAN | PERIod |
6379             PHAse | PK2pk | CRMs | MINImum | MAXImum | RISe | FALL | PWIdth | NWIdth
6380             or NONE (only for $n=1..5).
6381              
6382             =head2 get_measurement_units
6383              
6384             $units = $s->get_measurement_units($n);
6385              
6386             $units = $s->get_measurement_units(measurement=>$n);
6387              
6388             Fetch the measurement units for measurement $n (IMMediate, 1..5)
6389             result: V, A, S, Hz, VA, AA, VV
6390              
6391             If $n is missing or undefined, uses IMMediate.
6392              
6393             =head2 get_measurement_source
6394              
6395             $wfm = $s->get_measurement_source($n);
6396              
6397             $wfm = $s->get_measurement_source(measurement=>$n);
6398              
6399             Fetch the source waveform for measurements: CH1..CH4 or MATH
6400             for measurement $n = IMMediate, 1..5
6401              
6402             If $n is undefined or missing, IMMediate is used.
6403              
6404             =head2 set_measurement_source
6405              
6406             $s->set_measurement_source($n,$wfm);
6407              
6408             $s->set_measurement_source(measurement=>$n, measurement_source => $wfm);
6409              
6410             Set the measurement source, CH1..CH4 or MATH for measurement
6411             $n = IMMediate, 1..5. If $n is undefined or missing uses IMMediate.
6412              
6413             =head2 get_measurement_value
6414              
6415             $val = $s->get_measurement_value($n);
6416              
6417             $val = $s->get_measurement_value(measurement=>$n);
6418              
6419             Fetch measurement value, measurement $n = IMMediate, 1..5
6420             If $n is missing or undefined, use IMMediate.
6421              
6422             =head1 TRIGGER ROUTINES
6423              
6424             =head2 trigger
6425              
6426             $s->trigger();
6427              
6428             Force a trigger, equivalent to pushing the "FORCE TRIGGE" button on
6429             front panel
6430              
6431             =head2 get_trig_coupling
6432              
6433             $coupling = $s->get_trig_coupling();
6434              
6435             returns $coupling = AC|DC|HFREJ|LFREJ|NOISEREJ
6436              
6437             (only applies to 'EDGE' trigger)
6438              
6439             =head2 set_trig_coupling
6440              
6441             $s->set_trig_coupling($coupling);
6442              
6443             $s->set_trig_coupling(coupling=>$coupling);
6444              
6445             Set trigger coupling, $coupling = AC|DC|HFRej|LFRej|NOISErej
6446             Only applies to EDGE trigger
6447              
6448             =head2 get_trig_slope
6449              
6450             $sl = $s->get_trig_slope();
6451              
6452             Fetch the trigger slope, FALL or RISE
6453             only applies to EDGE trigger.
6454              
6455             =head2 set_trig_slope
6456              
6457             $s->set_trig_slope($sl);
6458              
6459             $s->set_trig_slope(slope=>$sl);
6460              
6461             Set the trigger slope: RISE|UP|POS|+ or FALL|DOWN|NEG|-
6462              
6463             Only applies to EDGE trigger
6464              
6465             =head2 get_trig_source
6466              
6467             $ch = $s->get_trig_source([$trigtype]);
6468              
6469             $ch = $s->get_trig_source([type=>$trigtype]);
6470              
6471             Fetch the trigger source, returns one of CH1..4, EXT, EXT5, LINE
6472              
6473             (EXT5 is 'external source, attenuated by a factor of 5')
6474              
6475             Trigger type is the "currently selected" trigger type, unless
6476             specified with the type parameter.
6477              
6478             =head2 set_trig_source
6479              
6480             $s->set_trig_source($ch);
6481              
6482             $s->set_trig_source(source=>$ch[, type=>$type]);
6483              
6484             Set the trigger source to one of CH1..4, EXT, EXT5, LINE (or 'AC LINE')
6485             for the current trigger type, unless type=>$type is specified.
6486              
6487             =head2 get_trig_frequency
6488              
6489             $f = $s->get_trig_frequency();
6490              
6491             Fetch the trigger frequency in Hz. This function is not for use when
6492             in 'video' trigger type. If the frequcency is less than 10Hz, 1Hz
6493             is returned.
6494              
6495             =head2 get_trig_holdoff
6496              
6497             $hold = $s->get_trig_holdoff();
6498              
6499             Fetch the trigger holdoff, in seconds
6500              
6501             =head2 set_trig_holdoff
6502              
6503             $s->set_trig_holdoff($time);
6504              
6505             $s->set_trig_holdoff(holdoff=>$time);
6506              
6507             Set the trigger holdoff. If $time is a number it is
6508             taken to be in seconds; text can be passed with the
6509             usual order-of-magnitude and unit suffixes.
6510              
6511             holdoff can range from 500ns to 10s
6512              
6513             =head2 get_trig_level
6514              
6515             $lev = $s->get_trig_level();
6516              
6517             Fetch the trigger level, in volts
6518              
6519             =head2 set_trig_level
6520              
6521             $s->set_trig_level($lev);
6522              
6523             $s->set_trig_level(level => $lev);
6524              
6525             Set the trigger level, in volts. The usual magnitude/suffix
6526             rules apply. This routine has no effect when the trigger ssource
6527             is set to 'AC LINE'
6528              
6529             =head2 get_trig_mode
6530              
6531             $mode = $s->get_trig_mode();
6532              
6533             Fetch the trigger mode: AUTO or NORMAL
6534              
6535             =head2 set_trig_mode
6536              
6537             $s->set_trig_mode($mode);
6538              
6539             $s->set_trig_mode(mode=>$mode);
6540              
6541             Set the trigger mode: AUTO or NORMAL
6542              
6543             =head2 get_trig_type
6544              
6545             $type = $s->get_trig_type();
6546              
6547             Fetch the trigger type, returns EDGE or PULSE or VIDEO.
6548              
6549             =head2 set_trig_type
6550              
6551             $s->set_trig_type($type);
6552              
6553             $s->set_trig_type(type=>$type);
6554              
6555             Set trigger type to EDGE, PULse or VIDeo.
6556              
6557             =head2 get_trig_pulse_width
6558              
6559             $wid = $s->get_trig_pulse_width();
6560              
6561             Fetch trigger pulse width for PULSE trigger type
6562              
6563             =head2 set_trig_pulse_width
6564              
6565             $s->set_trig_pulse_width($wid);
6566              
6567             $s->set_trig_pulse_width(width=>$wid);
6568              
6569             Set the pulse width for PULSE type triggers, in seconds. Valid
6570             range is from 33ns to 10s.
6571              
6572             =head2 get_trig_pulse_polarity
6573              
6574             $pol = $s->get_trig_pulse_polarity();
6575              
6576             Fetch the polarity for the PULSE type trigger,
6577             returns POSITIVE or NEGATIVE
6578              
6579             =head2 set_trig_pulse_polarity
6580              
6581             $s->set_trig_pulse_polarity($pol);
6582              
6583             $s->set_trig_pulse_polarity(pulse_polarity=>$pol);
6584              
6585             Set the polarity for PULSE type trigger.
6586              
6587             $pol can be (Postive|P|+) or (Negative|N|M|-)
6588              
6589             =head2 get_trig_pulse_when
6590              
6591             $when = $s->get_trig_pulse_when();
6592              
6593             Fetch the "when" condition for pulse triggering, possible
6594             values are
6595              
6596             =over 4
6597              
6598             EQUAL: triggers on trailing edge of specified width)
6599              
6600             NOTEQUAL: triggers on trailing edge of pulse shorter than specified
6601             width, or if pulse continues longer than specified width.
6602              
6603             INSIDE: triggers on the trailing edge of pulses that are less than
6604             the specified width.
6605              
6606             OUTSIDE: triggers when a pulse continues longer than the specified
6607             width
6608              
6609             =back
6610              
6611             =head2 set_trig_pulse_when
6612              
6613             $s->set_trig_pulse_when($when);
6614              
6615             $s->set_trig_pulse_when(pulse_when=>$when);
6616              
6617             Set the PULSE type trigger to trigger on the specified
6618             condition, relative to the pulse width.
6619              
6620             =over 4
6621              
6622             EQ|EQUAL|= : trigger on trailing edge of pulse equal to 'width'.
6623              
6624             NOTE|NOTEQUAL|NE|!=|<>: trigger on trailing edge of pulse that is shorter than specified width, or when the pulse exceeds the specified width.
6625              
6626             IN|INSIDE|LT|< : trigger on trailing edge when less than specified width
6627              
6628             OUT|OUTSIDE|GT|> : trigger when pulse width exceeds specified width.
6629              
6630             The pulse width for this trigger is set by set_trig_pulse_width();
6631              
6632             =back
6633              
6634             =head2 get_trig_vid_line
6635              
6636             $line = $s->get_trig_vid_line();
6637              
6638             Get the video line number for triggering when
6639             SYNC is set to LINENUM.
6640              
6641             =head2 set_trig_vid_line
6642              
6643             $s->set_trig_vid_line($line);
6644              
6645             $s->set_trig_vid_line(vid_line => $line);
6646              
6647             Set the video line number for triggering with video
6648             trigger, when SYNC is set to LINENUM.
6649              
6650             =head2 get_trig_vid_polarity
6651              
6652             $pol = $s->get_trig_vid_polarity();
6653              
6654             Fetch the video trigger polarity: NORMAL or INVERTED
6655              
6656             =head2 set_trig_vid_polarity
6657              
6658             $s->set_trig_vid_polarity($pol);
6659              
6660             $s->set_trig_vid_polarity(vid_polarity=>$pol);
6661              
6662             Set the video trigger polarity: NORMal|-SYNC or INVerted|+SYNC
6663              
6664             =head2 get_trig_vid_standard
6665              
6666             $std = $s->get_trig_vid_standard();
6667              
6668             Fetch the video standard used for video-type triggering;
6669             returns NTSC or PAL (PAL = PAL or SECAM).
6670              
6671             =head2 set_trig_vid_standard
6672              
6673             $s->set_trig_vid_standard($std);
6674              
6675             $s->set_trig_vid_standard(vid_standard=>$std);
6676              
6677             Set the video standard used for video triggering.
6678             $std = NTSC, PAL, SECAM (SECAM selects PAL triggering).
6679              
6680             =head2 get_trig_vid_sync
6681              
6682             $sync = $s->get_trig_vid_sync();
6683              
6684             Fetcht the syncronization used for video trigger, possible
6685             values are FIELD, LINE, ODD, EVEN and LINENUM.
6686              
6687             =head2 set_trig_vid_sync
6688              
6689             $s->set_trig_vid_sync($sync);
6690              
6691             $s->set_trig_vid_sync(vid_sync => $sync);
6692              
6693             Set the synchronization used for video triggering; possible values
6694             are FIELD, LINE, ODD, EVEN, and LINENum.
6695              
6696             =head2 get_trig_state
6697              
6698             $state = $s->get_trig_state();
6699              
6700             Fetch the trigger state (warning: this is not a good way to determine
6701             if acquisition is completed). Possible values are:
6702              
6703             =over 4
6704              
6705             ARMED: aquiring pretrigger information, triggers ignored
6706              
6707             READY: ready to accept a trigger
6708              
6709             TRIGGER: trigger has been accepted, scope is processing postrigger information.
6710              
6711             AUTO: in auto mode, acquiring even without a trigger.
6712              
6713             SAVE: acquisition stopped, or all channels off.
6714              
6715             SCAN: scope is in scan mode
6716              
6717             =back
6718              
6719             =head1 WAVEFORM ROUTINES
6720              
6721             =head2 get_data_width
6722              
6723             $nbytes = $s->get_data_width();
6724              
6725             Fetch the number of bytes transferred per waveform sample, returns 1 or 2.
6726              
6727             Note that only the MSB is used, unless the waveform is averaged or a
6728             MATH waveform.
6729              
6730             =head2 set_data_width
6731              
6732             $s->set_data_width($nbytes);
6733              
6734             $s->set_data_width(nbytes=>$nbytes);
6735              
6736             Set the number of bytes per waveform sample, either 1 or 2.
6737              
6738             Note that only the MSB is used for waveforms that are not the
6739             result of averaging or MATH operations.
6740              
6741             =head2 get_data_encoding
6742              
6743             $enc = $s->get_data_encoding();
6744              
6745             Fetch the encoding that is used to transfer waveform
6746             data from the scope.
6747              
6748             returns one of
6749              
6750             =over 4
6751              
6752             ASCII: numbers returned as ascii signed integers, comma separated
6753              
6754             RIBINARY: signed integer binary, MSB transferred first (if width=2)
6755              
6756             RPBINARY: unsigned integer binary, MSB first
6757              
6758             SRIBINARY: signed integer binary, LSB first
6759              
6760             SRPBINARY: unsigned integer binary, LSB first
6761              
6762             =back
6763              
6764             RIBINARY is the fastest transfer mode, particularly with width=1,
6765             as is used for simple waveform traces, with values ranging from
6766             -128..127 with 0 corresponding to the center of the screen.
6767              
6768             (width = 2 data range -32768 .. 32767 with center = 0)
6769              
6770             For unsigned data, width=1, range is 0..255 with 127 at center,
6771             width=2 range is 0..65535.
6772              
6773             In all cases the "lower limit" is one division below the bottom of the
6774             screen, and the "upper limit" is one division above the top of the screen.
6775              
6776             =head2 set_data_encoding
6777              
6778             $s->set_data_encoding($enc);
6779              
6780             $s->set_data_encoding(encoding=>$enc);
6781              
6782             Set the waveform transfer encoding, see get_waveform_encoding for
6783             possible values and their meanings.
6784              
6785             =head2 get_data_start
6786              
6787             $i = $s->get_data_start();
6788              
6789             Fetch the index of the first waveform sample
6790             for transfers $i = 1..2500
6791              
6792             =head2 set_data_start
6793              
6794             $s->set_data_start($i);
6795              
6796             $s->set_data_start(start=>$i);
6797              
6798             Set the index of the first waveform sample
6799             for transfers, $i = 1..2500.
6800              
6801             =head2 get_data_stop
6802              
6803             $i = $s->get_data_stop();
6804              
6805             Fetch the index of the last waveform sample
6806             for transfers $i = 1..2500
6807              
6808             =head2 set_data_stop
6809              
6810             $s->set_data_stop($i);
6811              
6812             $s->set_data_stop(stop=>$i);
6813              
6814             Set the index of the lat waveform sample
6815             for transfers, $i = 1..2500.
6816              
6817             =head2 get_data_destination
6818              
6819             $dst = $s->get_data_destination();
6820              
6821             Fetch the destination (REFA..REFD) for data transfered
6822             TO the scope.
6823              
6824             =head2 set_data_destination
6825              
6826             $s->set_data_destination($dst);
6827              
6828             $s->set_data_destination(destination=>$dst);
6829              
6830             Set the destination ($dst = REFA..REFD) for waveforms
6831             transferred to the scope.
6832              
6833             =head2 set_data_init
6834              
6835             $s->set_data_init();
6836              
6837             initialize all data parameters (source, destination, encoding, etc)
6838             to factory defaults
6839              
6840             =head2 get_data_source
6841              
6842             $src = $s->get_data_source();
6843              
6844             Fetch the source of waveforms transferred FROM the scope.
6845              
6846             Possible values are CH1..CH4, MATH, or REFA..REFD.
6847              
6848             =head2 set_data_source
6849              
6850             $s->set_data_source($src);
6851              
6852             $s->set_data_source(source => $src);
6853              
6854             Set the source of waveforms transferred from the scope. Possible
6855             values are CH1..CH4, MATH, or REFA..REFD.
6856              
6857             =head2 get_data
6858              
6859             $h = $s->get_data();
6860              
6861             return a hash reference with data transfer information
6862             such as width, encoding, source, etc, suitable for use with
6863             the set_data($h) routine
6864              
6865             =head2 set_data
6866              
6867             $s->set_data(width=>$w, start=>$istart, ... );
6868              
6869             set data transfer characteristics, call with a hash
6870             or hashref similar to what one gets from get_data()
6871              
6872             =head2 get_waveform
6873              
6874             $hashref = $s->get_waveform();
6875              
6876             $hashref = $s->get_waveform( waveform=>$wfm,
6877             start=>$startbin, stop=>$stopbin,
6878             ...data parameters...);
6879              
6880             Fetch waveform from specified channel; if parameters are not
6881             set, use the current setup from the scope (see get_data_source)
6882             The value of $wfm can be CH1..4, MATH, or REFA..D.
6883              
6884             returns $hashref = { v=>[voltages], t=>[times], various x,y parameters };
6885              
6886             Note that voltages and times are indexed starting at '1', or at the
6887             'data_start' index (see set_data_start())
6888             $hashref->{v}->[1] ...first voltage sample, default
6889              
6890             Alternately:
6891             $s->set_data_start(33);
6892             ...
6893             $hashref->{v}->[33] ... first voltage sample
6894              
6895             The hashref contains keys DAT:STAR and DAT:STOP for start and stop
6896             sample numbers.
6897              
6898             If you are going to alter the data in $hashref->{v}->[], make
6899             sure to delete($hashref->{rawdata}) before the waveform is transmitted
6900             to the scope, this will case the rawdata to be regenerated from
6901             the $hashref->{v}->[] entries.
6902              
6903             =head2 create_waveform
6904              
6905             $hwfd = $s->create_waveform();
6906              
6907             $hwfd = $s->create_waveform($t0,$t1[,$n[,\&vfunc]]);
6908              
6909             $hwfd = $s->create_waveform(tstart=>$t0, tstop=>$t1[, nbins=$n][, vfunc=\&vfunc]);
6910              
6911             returns a hashref with an array of time values (useful for creating
6912             a waveform) starting at $t0 and ending at $t1 with $n bins. Please
6913             note that the TDS2024B can use $n=2500 at most, although this routine
6914             will work for larger values of $n. If $n is not specified $n=2500 for
6915             a simple waveform, and $n=1250 for an 'envelope' waveform.
6916              
6917             $t0 and $t1 can be numbers, in seconds, or text with suffixes: $t1='33ms'
6918              
6919             The bin numbers start with '1', matching the scope behavior: $hwfd->{t}->[1] = $t0 ... $hwfd->{t}->[$n] = $t1
6920              
6921             If a "vfunc" is given, it is called with the time values:
6922              
6923             $v = vfunc($t); # $t in seconds
6924              
6925             If vfunc returns an array of two voltages, it is taken as "min,max" values
6926             for an 'ENVELOPE' style waveform:
6927              
6928             ($vmin,$vmax) = vfunc($t);
6929              
6930             In either case, the result is
6931             analyzed to produce a 'rawdata' entry with 8 bit waveform data,
6932             filling in the parameters needed for
6933             transmitting the waveform to the scope.
6934              
6935             If you do not provide a reference to a "vfunc" function, you will
6936             have to create and fill in an array: $hwfd->{v}->[$n] = voltage($n)
6937             If you do not specify the $t0 and $t1 times, then you will also
6938             have to create and fill in the $hwfd->{t}->[$n] = time($n) array.
6939              
6940             To make use of an "envelope" waveform, fill in $hwfd->{vmin}->[$n]
6941             and $hwfd->{vmax}->[$n].
6942              
6943             =head2 put_waveform
6944              
6945             $s->put_waveform($hwfm);
6946              
6947             $s->put_waveform(waveform=>$hwfm,
6948             [destination=>$dst, position=>$ypos, scale=>$yscale] )
6949              
6950             Store waveform to one of the REFA..REFD traces. If not set explicitly
6951             in the call arguments, uses the location set in the scope (see
6952             get_data_destination).
6953              
6954             The vertical position of the trace is set with $ypos = divisions from
6955             the screen center, and the vertical scale with $yscale = V/div.
6956              
6957             If $hwfm->{rawdata} exists, it will be transmitted to the scope
6958             unchanged. Otherwise the $hwfm->{rawdata} entry will be regenerated
6959             from the $hwfm->{v}->[] (or $hwfm->{vmin|vmax}->[]) array(s).
6960              
6961             The error/consistency checking is certainly not complete, so
6962             doing something 'tricky' with the $hwfm hash may give unexpected
6963             results.
6964              
6965             =head2 print_waveform
6966              
6967             $s->print_waveform($hwfm [,$IOhandle]);
6968              
6969             $s->print_waveform(waveform=>$hwfm [,output=>$iohandle]);
6970              
6971             print information from the waveform stored in a
6972             hasref $hwfm, taken from get_waveform();
6973              
6974             This is mostly for diagnostic purposes.
6975              
6976             =head1 COPYRIGHT AND LICENSE
6977              
6978             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
6979              
6980             Copyright 2016 Charles Lane
6981             2017 Andreas K. Huettel
6982             2020 Andreas K. Huettel
6983             2021 Charles Lane
6984              
6985              
6986             This is free software; you can redistribute it and/or modify it under
6987             the same terms as the Perl 5 programming language system itself.
6988              
6989             =cut