view release on metacpan or  search on metacpan

lib/Lab/Instrument/WR640.pm  view on Meta::CPAN

    }
    $self->{device_cache}->{select} = ( $self->{channel} eq 'CH1' ? 1 : 0 );
    foreach my $wfm (qw(MATH REFA REFB REFC REFD)) {
        $self->{chan_cache}->{$wfm}->{select} = 0;
    }
}

# print error queue; meant to be called at end of routine
# so uses 'caller' info to label the subroutine
sub _debug {
    return unless $DEBUG;
    my $self = shift;
    my ( $p, $f, $l, $subr ) = caller(1);
    while (1) {
        my ( $code, $msg ) = $self->get_error();
        last if $code == 0;
        print "$subr\t$code: $msg\n";
    }
}


sub get_error {
    my $self = shift;

    my $err = $self->query("CHL? CLR");
    $err =~ s/^(CHL\s*)?\"(.*)\"/$2/is;
    my (@lines) = split( /\n/, $err );
    my (@elines) = ();

    foreach my $x (@lines) {
        $x =~ s/^\s*(.*)\s*$/$1/;
        next if $x =~ /^connection\s/i;
        next if $x =~ /^disconnect/i;
        push( @elines, $x );
    }
    return (@elines);

}


our $sbits = [qw(OPC RQC QYE DDE EXE CME URQ PON)];

sub get_status {
    my $self = shift;
    my $bit  = shift;
    my $s    = {};

    my $r = $self->query('*ESR?');
    $self->_debug();

    for ( my $j = 0; $j < 7; $j++ ) {
        $s->{ $sbits->[$j] } = ( $r >> $j ) & 0x01;
    }
    $s->{ERROR} = $s->{CME} | $s->{EXE} | $s->{DDE} | $s->{QYE};

    return $s->{ uc($bit) } if defined $bit;
    return $s;
}


sub test_busy {
    my $self = shift;
    return 1 if $self->query('BUSY?') =~ /^(:BUSY )?\s*1/i;
    return 0;
}


sub get_id {
    my $self = shift;
    my ($tail) = $self->_check_args( \@_ );

    $tail->{read_mode} = $self->{config}->{default_read_mode}
        unless exists( $tail->{read_mode} ) && defined( $tail->{read_mode} );

    if ( $tail->{read_mode} ne 'cache'
        || !defined( $self->{device_cache}->{ID} ) ) {
        $self->{device_cache}->{ID} = $self->query('*IDN?');
        $self->_debug();
    }
    return $self->{device_cache}->{ID};
}


sub recall {
    my $self = shift;
    my ( $mem, $tail ) = $self->_check_args( \@_, 'n' );

    my $n;
    if ( $mem =~ /^\s*([0-6])\s/ ) {
        $n = $1;
    }
    else {
        carp("recall memory n=$mem invalid, should be 0..6");
        return;
    }
    $self->write("*RCL $n");
}

sub get_setup {
    my $self = shift;
    my (@a) = ();

    foreach my $ch (qw(C1 C2 C3 C4 EX EX10 ETM10 LINE)) {
        if ( $ch =~ /C\d/ ) {
            foreach my $q (qw(ATTN CPL OFST OFCT TRA TRCP VDIV)) {
                push( @a, $self->query( $ch . ':' . $q . '?' ) );
            }
        }
        if ( $ch ne 'LINE' ) {
            push( @a, $self->query( $ch . ":TRLV?" ) );
        }
        push( @a, $self->query( $ch . ":TRSL?" ) );
    }

    for ( my $j = 1; $j <= 8; $j++ ) {
        my $ch = "F$j";
        foreach my $q (qw(TRA VMAG VPOS)) {
            push( @a, $self->query( $ch . ":" . $q . "?" ) );
        }
    }

lib/Lab/Instrument/WR640.pm  view on Meta::CPAN

=head2 new

my $s = new Lab::Instrument::TDS2024B(
         usb_serial => '...',
);

serial only needed if multiple TDS2024B scopes are attached, it
defaults to '*', which selects the first TDS2024B found.  See
Lab::Bus::USBtmc.pm documentation for more information.

=head2 reset

$s->reset()

Reset the oscilloscope (*RST)

=head2 get_error

($code,$message) = $s->get_error();

Fetch an error from the device error queue

=head2 get_status

$status = $s->get_status(['statusbit']);

Fetches the scope status, and returns either the requested
status bit (if a 'statusbit' is supplied) or a reference to
a hash of status information. Reading the status register
causes it to be cleared.  A status bit 'ERROR' is combined
from the other error bits.

Example: $s->get_status('OPC');

Example: $s->get_status()->{'DDE'};

Status bit names:

=over

B<PON>: Power on

B<URQ>: User Request (not used)

B<CME>: Command Error

B<EXE>: Execution Error

B<DDE>: Device Error

B<QYE>: Query Error

B<RQC>: Request Control (not used)

B<OPC>: Operation Complete

B<ERROR>: CME or EXE or DDE or QYE

=back

=head2 test_busy

$busy = $s->test_busy();

Returns 1 if busy (waiting for trigger, etc), 0 if not busy.

=head2 get_id

$s->get_id()

Fetch the *IDN? string from device

=head2 recall

$s->recall($n);

$s->recall(n => $n);

Recall setup 0..6

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2023 by the Lab::Measurement team; in detail:

  Copyright 2016       Charles Lane
            2017       Andreas K. Huettel
            2020       Andreas K. Huettel


This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut