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.881';
4	2			2		2372	use v5.20;
	2					7
5
6	2			2		12	use strict;
	2					5
	2					42
7	2			2		10	use warnings;
	2					4
	2					77
8	2			2		615	use Lab::Instrument;
	2					5
	2					60
9	2			2		12	use Lab::SCPI;
	2					5
	2					150
10	2			2		13	use Carp;
	2					4
	2					100
11	2			2		14	use English;
	2					4
	2					17
12	2			2		804	use Time::HiRes qw(sleep);
	2					4
	2					22
13	2			2		184	use Clone 'clone';
	2					4
	2					111
14	2			2		118	use Data::Dumper;
	2					6
	2					1719
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		17	no warnings qw(redefine);
	2					4
	2					64193
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 =~ /^\smath\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 =~ /^\smath\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 =~ /^\sher/i \|\| $in =~ /^\sHz/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)?)?\sC6)/i ) {
2946	0						$f = 'EPSC60';
2947							}
2948							elsif ( $in =~ /^(EPSC8\|EPSON\s(S(TYLUS)?)?\sC8)/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 CH1CH2 CH3CH4)
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 =~ /^\simm/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 =~ /^\simm/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 =~ /^\simm/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 =~ /^\simm/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 =~ /^\simm/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 =~ /^\s1\s$/ ) {
		0
4237	0						$n = 1;
4238							}
4239							elsif ( $in =~ /^\s2\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 =~ /^\sMATH\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.881
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