File Coverage

blib/lib/Lab/Moose/Instrument/TBS1000C.pm
Criterion Covered Total %
statement 23 60 38.3
branch 0 2 0.0
condition n/a
subroutine 8 24 33.3
pod 15 16 93.7
total 46 102 45.1


line stmt bran cond sub pod time code
1             package Lab::Moose::Instrument::TBS1000C;
2             $Lab::Moose::Instrument::TBS1000C::VERSION = '3.880';
3             #ABSTRACT: Tektronix TBS 1000C series Oscilloscope.
4              
5 1     1   4208 use v5.20;
  1         4  
6              
7 1     1   9 use Moose;
  1         2  
  1         8  
8 1     1   7810 use MooseX::Params::Validate;
  1         3  
  1         11  
9 1     1   622 use Moose::Util::TypeConstraints qw/enum/;
  1         4  
  1         12  
10             use Lab::Moose::Instrument
11 1     1   542 qw/validated_getter validated_setter setter_params/;
  1         5  
  1         75  
12 1     1   7 use Lab::Moose::Instrument::Cache;
  1         4  
  1         12  
13 1     1   748 use Carp 'croak';
  1         3  
  1         72  
14 1     1   10 use namespace::autoclean;
  1         3  
  1         11  
15              
16             extends 'Lab::Moose::Instrument';
17              
18             around default_connection_options => sub {
19             my $orig = shift;
20             my $self = shift;
21             my $options = $self->$orig();
22             my $usb_opts = { vid => 0x0699, pid => 0x03c4 };
23             $options->{USB} = $usb_opts;
24             $options->{'VISA::USB'} = $usb_opts;
25             return $options;
26             };
27              
28             sub BUILD {
29 0     0 0   my $self = shift;
30 0           $self->clear();
31 0           $self->cls();
32             }
33              
34              
35             #
36             # ACQUIRE
37             #
38              
39              
40             sub acquire_state {
41 0     0 1   my ( $self, $value, %args ) = validated_setter(
42             \@_,
43             value => { isa => enum( [qw/0 1/] ) }
44             );
45 0           $self->write( command => "ACQUIRE:STATE $value", %args );
46             }
47              
48             sub acquire_state_query {
49 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
50 0           return $self->query( command => "ACQUIRE:STATE?", %args );
51             }
52              
53              
54             sub acquire_stopafter {
55 0     0 1   my ( $self, $value, %args ) = validated_setter(
56             \@_,
57             value => { isa => enum( [qw/RUNSTOP SEQUENCE/] ) }
58             );
59 0           $self->write( command => "ACQUIRE:STOPAFTER $value", %args );
60             }
61              
62             sub acquire_stopafter_query {
63 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
64 0           return $self->query( command => "ACQUIRE:STOPAFTER?", %args );
65             }
66              
67             #
68             # BUSY
69             #
70              
71              
72             sub busy_query {
73 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
74 0           return $self->query( command => "BUSY?", %args );
75             }
76              
77             #
78             # CURVE
79             #
80              
81              
82             sub curve_query {
83 0     0 1   my ( $self, %args ) = validated_getter( \@_ );
84 0           my $encoding = $self->waveform_output_encoding_query();
85 0 0         if ( $encoding ne 'ASCII' ) {
86 0           croak("only supports ASCII encoding, so far");
87             }
88              
89 0           my $data = $self->query( command => "CURVE?", %args );
90 0           return [ split /,/, $data ];
91             }
92              
93             #
94             # DATA
95             #
96              
97              
98             sub data_source {
99 0     0 1   my ( $self, $value, %args ) = validated_setter(
100             \@_,
101             value => { isa => enum( [qw/CH1 CH2 MATH REF1 REF2/] ) }
102             );
103 0           $self->write( command => "DATA:SOURCE $value", %args );
104             }
105              
106             sub data_source_query {
107 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
108 0           return $self->query( command => "DATA:SOURCE?", %args );
109             }
110              
111             #
112             # TRIGGER
113             #
114              
115              
116             sub trigger_query {
117 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
118 0           return $self->query( command => "TRIGGER:A?", %args );
119             }
120              
121              
122             sub trigger_force {
123 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
124 0           return $self->write( command => "TRIGGER FORCE", %args );
125             }
126              
127              
128             sub trigger_state_query {
129 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
130 0           return $self->query( command => "TRIGGER:STATE?", %args );
131             }
132              
133              
134             sub trigger_mode {
135 0     0 1   my ( $self, $value, %args ) = validated_setter(
136             \@_,
137             value => { isa => enum( [qw/AUTO NORMAL/] ) }
138             );
139 0           $self->write( command => "TRIGGER:A:MODE $value", %args );
140             }
141              
142             sub trigger_mode_query {
143 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
144 0           return $self->query( command => "TRIGGER:A:MODE?", %args );
145             }
146              
147             #
148             # Waveform
149             #
150              
151              
152             sub waveform_output_encoding {
153 0     0 1   my ( $self, $value, %args ) = validated_setter(
154             \@_,
155             value => { isa => enum( [qw/BINARY ASCII/] ) }
156             );
157 0           $self->write( command => "WFMOUTPRE:ENCDG $value", %args );
158             }
159              
160             sub waveform_output_encoding_query {
161 0     0 1   my ( $self, %args ) = validated_getter( \@_, );
162 0           return $self->query( command => "WFMOUTPRE:ENCDG?", %args );
163             }
164              
165             with qw(
166             Lab::Moose::Instrument::Common
167             );
168              
169             __PACKAGE__->meta()->make_immutable();
170              
171             1;
172              
173             __END__
174              
175             =pod
176              
177             =encoding UTF-8
178              
179             =head1 NAME
180              
181             Lab::Moose::Instrument::TBS1000C - Tektronix TBS 1000C series Oscilloscope.
182              
183             =head1 VERSION
184              
185             version 3.880
186              
187             =head1 SYNOPSIS
188              
189             use Lab::Moose;
190              
191             my $tbs = instrument(
192             type => 'TBS1000C',
193             connection_type => 'USB' # For NT-VISA use 'VISA::USB'
194             );
195              
196             # Configure measurement setup
197             $tbs->waveform_output_encoding(value => 'ASCII');
198             $tbs->trigger_mode(value => 'NORMAL');
199             $tbs->data_source(value => 'CH1');
200             $tbs->acquire_stopafter(value => 'SEQUENCE');
201              
202             # Start acquisition
203             $tbs->acquire_state(value =>1);
204              
205             # Waveform will be recorded once triggered
206             # software trigger:
207             # $tbs->trigger_force();
208              
209             # Wait until acquisition is finished
210             $tbs->opc_query();
211            
212             # Get waveform as arrayref
213             my $data_block = $tbs->curve_query();
214            
215             # Logging multiple blocks into a datafile
216            
217             $sweep->log_block(prefix => ..., block => [$block1, $block2]);
218              
219             =head1 METHODS
220              
221             Used roles:
222              
223             =over
224              
225             =item L<Lab::Moose::Instrument::Common>
226              
227             =back
228              
229             =head2 acquire_state/acquire_state_query
230              
231             $tbs->acquire_state(value => 1);
232             say $tbs->acquire_state_query();
233              
234             Allowed values: C<0,1>
235              
236             =head2 acquire_stopafter/acquire_stopafter_query
237              
238             $tbs->acquire_stopafter(value => 'SEQUENCE');
239             say $tbs->acquire_stopafter_query();
240              
241             Allowed values: SEQUENCE, STOPAFTER
242              
243             =head2 busy_query
244              
245             my $busy = $tbs->busy_query();
246              
247             Return 1 if busy, 0 if idle.
248              
249             =head2 curve_query
250              
251             my $data_block = $tbs->curve_query();
252              
253             Get waveform from instrument as arrayref.
254              
255             The channel is defined by the C<data_source> method.
256              
257             =head2 data_source/data_source_query
258              
259             $tbs->data_source(value => 'CH1');
260             say $tbs->data_source_query();
261              
262             Data source for the C<curve_query> method.
263             Allowed values: C<CH1, CH2, MATH, REF1, REF2>
264              
265             =head2 trigger_query
266              
267             my $info = $tbs->trigger_query();
268              
269             Info about trigger setup.
270              
271             =head2 trigger_force
272              
273             $tbs->trigger_force();
274              
275             Force a trigger.
276              
277             =head2 trigger_state_query
278              
279             say $tbs->trigger_state_query();
280              
281             Returns one of C<ARMED, AUTO, READY, SAVE, TRIGGER>.
282              
283             =head2 trigger_mode/trigger_mode_query
284              
285             $tbs->trigger_mode(value => 'NORMAL');
286             say $tbs->trigger_mode_query();
287              
288             Allowed values: C<NORMAL, AUTO>
289              
290             =head2 waveform_output_encoding/waveform_output_encoding_query
291              
292             $tbs->waveform_output_encoding(value => 'ASCII');
293             say $tbs->waveform_output_encoding_query();
294              
295             Allowed values: C<ASCII, BINARY>
296              
297             =head1 COPYRIGHT AND LICENSE
298              
299             This software is copyright (c) 2023 by the Lab::Measurement team; in detail:
300              
301             Copyright 2020 Simon Reinhardt
302              
303              
304             This is free software; you can redistribute it and/or modify it under
305             the same terms as the Perl 5 programming language system itself.
306              
307             =cut