Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Visualize a Waveform using Tk and PDL

by lofichurch (Beadle)
on Jul 05, 2002 at 21:31 UTC ( #179748=snippet: print w/ replies, xml ) Need Help??

Description: A little sub that visualizes the compression and rarefaction of a waveform, given a PDL matrix containing the waveform, using Tk Frames and Canvases. Displays one canvas per channel, and zoom level (x-width) is configurable, via an argument.
sub view_wave {
 #
 # visualize a waveform using Tk frames and Canvas
 #
 # 6 arguments:
 #  A Mainwindow object
 #  A PDL Matrix containing the wave data
 #  Number of bits / sample
 #  Number of channels
 #  Number of samples (that is, number of samples in a single channel,
 #    not all channels combined)
 #  Size (width) of the display, also determines granularity of displa
+y
 #
 # Usage:
 #  view_wave($main_window,$audio_pdl,16,2,$total_samples,300);
 #
 #  NOTE:
 #      The expected structure of the PDL matrix is that:
 #      rows represent channels, columns represent samples
 #
 #      That is, a pdl with dims (5000,2) has five thousand
 #      samples in each of two channels.
 #
 # die()s on error.
 #
 # C. Church (dolljunkie@digitalkoma.com)
 #---------------------------
 
 

 my $mw = shift;
 my $data = shift;
 my $bits = shift;
 my $channels = shift;
 my $samples = shift;
 my $size = shift || 300;

    # die if not enough arguments
    
 if(!defined($mw) || !defined($data) || !defined($bits) || !defined($c
+hannels) || !defined($samples)) {
     die("[view_wave] Invalid # of arguments!\n");
     }
     
     # set some variables needed for processing

 my @channel_frm;
 my $top_vol = 0;

    # maximum (absolute) volume value

 if($bits == 8) {
    $top_vol = 256;
    } elsif($bits == 16) {
        $top_vol = 2 ^ 15;
    } elsif($bits == 32) {
        $top_vol = 2 ^ 31;
    } elsif($bits == 64) {
        $top_vol = 2 ^ 63;
        } else {
            die("[view_wave] Bitrate [$bits] Not supported!\n");
            }

 my $high_val = 0;
 
    # how many samples to move ahead for
    # each pixel
    
 my $most_jumps = int($samples / $size);

    # how many movements up or down per volume value
    
 my $ea_dispY = 150 / $top_vol;
 
    # our y-axis center point
    
 my $baselineY = 75;

    # create a frame to hold the display
    
 my $frame = $mw->Frame(-width => $size, -height => 150 * $channels)->
+pack();

    # create a display canvas for each channel
    
 foreach (1..$channels) {
     push(@channel_frm,$frame->Canvas(-width => $size, -height => 150,
+ -relief => 'sunken', -border => 1, -background => 'white')->pack(-si
+de => 'top'));
     }

    # for each channel...
 foreach (0..$#channel_frm) {
 
     my $cpos = $_;
     my $spos = 0;
        # reset our Y position to center
        
     my $lastYpos = $baselineY;
     
        # create a line down the center as a reference point for
        # compression / rarefaction
        
     $channel_frm[$cpos]->createLine(0,$baselineY,$size,$baselineY);
     
        # foreach pixel in our display...
        
     foreach (1..$size) {
          my $move = $_;
          
            # get the numeric sample value from the piddle
            
          my $value = at($data,$spos,$cpos);

            # get absolute sample value
            
          my $diff_disp = abs($value);
          
          my $Yshow = 0;
          
            # determine if we go up or down on the y-axis
            # compression(positive) == up
            # rarefaction(negative) == down
            
          if($value == 0) {
               $Yshow = $baselineY;
               } elsif($value > 0) {
                    $Yshow = $baselineY;
                    $Yshow -= $ea_dispY * $diff_disp;
               } elsif($value < 0) {
                    $Yshow = $baselineY;
                    $Yshow += $ea_dispY * $diff_disp;
                    }
                    
             # advance our sample position
             # that is, determine which sample we will
             # grab next from the piddle
             
          $spos += $most_jumps;
          
             # draw a line from the last sample point to the current
             # sample point
             
          $channel_frm[$cpos]->createLine($move - 1,$lastYpos,$move,$Y
+show, -fill => 'blue');
          
            # remember where we just left off
            
          $lastYpos = $Yshow;
          }
     }

 return(1);
}

Comment on Visualize a Waveform using Tk and PDL
Download Code
Re: Visualize a Waveform using Tk and PDL
by Anonymous Monk on May 14, 2007 at 05:44 UTC
    Screenshot?

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://179748]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (6)
As of 2015-07-06 05:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (70 votes), past polls