Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Visualize a Waveform using Tk and PDL

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

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); }

Replies are listed 'Best First'.
Re: Visualize a Waveform using Tk and PDL
by Anonymous Monk on May 14, 2007 at 05:44 UTC
    Screenshot?

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2025-04-27 20:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.