#!/usr/bin/perl use strict; my $csd = ''; $csd .= << "END"; ; This file generated by perl sr = 44100 kr = 4410 ksmps = 10 nchnls = 1 instr 1 idur = p3 iamp = p4 kenv1 expseg 900, 0.01, 50, idur - 0.01, 20 asig1 oscil3 1, kenv1, 1 kenv2 line 1, idur, 0 asig1 = asig1 * kenv2 asig2 gauss 1 kenv5 expseg 800, 0.1, 50, idur - 0.1, 20 asig2 tone asig2, kenv5 amix = asig1 + asig2 kenv5 expseg 500, 0.05, 60, idur - 0.05, 20 amix rezzy amix, kenv5, 10 kenv6 linseg 50, idur, 20 aosc oscil3 1, kenv6, 1 kenv4 expseg 2, 0.15, 1, idur - 0.15, 1 kenv4 = kenv4 - 1 amix = ( amix * 0.8 + aosc * 1.2 ) * 15000 * kenv4 * iamp out amix endin instr 2 idur = p3 idynamic = p4 atri oscil3 1, 111 + idynamic * 5, 2 areal, aimag hilbert atri ifshift = 175 asin oscil3 1, ifshift, 1 acos oscil3 1, ifshift, 1, .25 amod1 = areal * acos amod2 = aimag * asin ashift1 = ( amod1 + amod2 ) * 0.7 ifshift2 = 224 asin oscil3 1, ifshift2, 1 acos oscil3 1, ifshift2, 1, .25 amod1 = areal * acos amod2 = aimag * asin ashift2 = ( amod1 + amod2 ) * 0.7 kenv1 linseg 1, 0.15, 0, idur - 0.15, 0 ashiftmix = ( ashift1 + ashift2 ) * kenv1 aosc1 oscil3 1, 180, 1 aosc2 oscil3 1, 330, 1 kenv2 linseg 1, 0.08, 0, idur - 0.08, 0 aoscmix = ( aosc1 + aosc2 ) * kenv2 anoise gauss 1 anoise butterhp anoise, 2000 anoise butterlp anoise, 3000 + idynamic * 3000 anoise butterbr anoise, 4000, 200 kenv3 expseg 2, 0.15, 1, idur - 0.15, 1 anoise = anoise * ( kenv3 - 1 ) amix = aoscmix + ashiftmix + anoise * 4 out amix * 7000 * idynamic endin instr 3 idur = p3 idynamic = p4 ifreq = 125 + ( 2 * idynamic ) a1 oscil 1, ifreq * 1, 5 a2 oscil 1, ifreq * 2.333, 5 a3 oscil 1, ifreq * 3.578, 5 a4 oscil 1, ifreq * 5.123, 5 a5 oscil 1, ifreq * 7.632, 5 a6 oscil 1, ifreq * 9.843, 5 amix = a1 + a2 + a3 + a4 + a5 + a6 idecay1 = 0.08 + ( 0.03 * ( 1 - idynamic ) ) kenv1 expseg 1, 0.01, 2, idecay1, 1, idur - idecay1 - 0.01, 1 kenv1 = kenv1 - 1 amix = amix * kenv1 idecay2 = 0.11 + 0.05 * idynamic kenv2 linseg 1, idecay2, 0, idur - idecay2, 0 anoise gauss 1 amix = ( anoise * kenv2 ) + amix * 0.5 amix butterhp amix, 7000 amix butterlp amix, 9000 + idynamic * 3000 out amix * 10000 * idynamic endin f1 0 65536 10 1 f2 0 8192 -7 -1 4096 1 4096 -1 f3 0 8192 -7 -1 8192 1 f5 0 8192 -7 1 200 1 0 -1 7912 -1 t 0 100 END use constant KICK => 1; # instr 1 is the kick drum use constant SNARE => 2; # instr 2 is the snare drum use constant HIHAT => 3; # instr 3 is the hihat # Classic rock beat my $time = 0; $csd .= dseq( HIHAT, $time, "f.f. f.f. f.f. f.f." ); $csd .= dseq( SNARE, $time, ".... f... .... f..." ); $csd .= dseq( KICK, $time, "f... .... f.f. ...." ); # Classic rock beat with dynamics $time += 4; $csd .= dseq( HIHAT, $time, "c.6. a.6. c.6. a.6." ); $csd .= dseq( SNARE, $time, ".... 8... .... 8..a" ); $csd .= dseq( KICK, $time, "8... .... c.a. ...." ); # Classic rock beat pattern rewritten with resolution directive "r_" $time += 4; $csd .= dseq( HIHAT, $time, "r8 c6a6 c6 a 6 " ); $csd .= dseq( SNARE, $time, "r4 . 8 . r16 8. .a" ); $csd .= dseq( KICK, $time, "r4 8 . r8 a8 . . " ); # Triplet hi-hats using resolution triplet directive "r_t" $time += 4; $csd .= dseq( HIHAT, $time, "r8t f88 a88 f88 a88 " ); $csd .= dseq( SNARE, $time, " .... c... .... c..." ); $csd .= dseq( KICK, $time, " f... .... f... ...." ); # Triplet hi-hats rewritten using resolution divide directive "r_d_" $time += 4; $csd .= dseq( HIHAT, $time, "r4d3 f88 a88 f88 a88 " ); $csd .= dseq( SNARE, $time, " .... c... .... c..." ); $csd .= dseq( KICK, $time, " f... .... f... ...." ); # Demonstration using "r_d_" with irregular rhythms $time += 4; $csd .= dseq( HIHAT, $time, "r4d4 aaaa r4d5 aaaaa r4d6 aaaaaa r4d7 aaaaaaa" ); $csd .= dseq( SNARE, $time, " .... f... .... f... " ); $csd .= dseq( KICK, $time, " f... .... f..f .... " ); # Dirt + H2O $time += 4; $csd .= dseq( HIHAT, $time, "a... a... a... a..." ); $csd .= dseq( SNARE, $time, ".... c... ..c. ...." ); $csd .= dseq( KICK, $time, "f.f. ..f. f... ...." ); $csd .= << "END"; e END print $csd; open( CSD, "> drumseq2.csd" ) || die "Can't write file drumseq2.csd: $!"; print CSD $csd; close CSD; sub dseq { my $instr = shift; # The instrument to write to my $startTime = shift; # When in the global score to write to my $thePattern = shift; # String of rhythm data my $thisTime = 0; # Internal time of sub call my $resolution = 1 / 16 * 4; # Default resolution of beat, 1/16 notes my $score = ''; # Stores score events to return # Parse and Process $thePattern while( $thePattern =~ /(\.|[a-fA-F]|r\d+d\d+|r\d+t|r\d+|\d)/g ) { my $char = substr( $1, 0, 1 ); # Note triggered by hexidecimal values between 0 and F. if( $char =~ /[a-fA-F]|\d/ ) { $score .= sprintf( "i%d %.4f 1 %.4f\n", $instr, $startTime + $thisTime, hex($char) / 15 ); $thisTime += $resolution; } # Rest indicated by ".". Advance the local clock if( $char eq "." ) { $thisTime += $resolution; } # Process "r" directives if( $char eq "r" ) { my $i; my @foo = split( /(r|\d+|d)/, $1 ); # Eliminate undefs in split array for( $i = $#foo; $i >= 0; $i-- ) { if( $foo[ $i ] eq undef ) { splice( @foo, $i, 1 ); } } # Change note resolution SWITCH: { # ( 'r', n1 ) Resolution = 1/n1 if( ( scalar( @foo ) == 2 ) && ( $foo[ 1 ] =~ /\d+/ ) ) { $resolution = 1 / $foo[ 1 ] * 4; last SWITCH; } # ( 'r', n1, t ) Resolution = 1/n1 Triplet if( ( scalar( @foo ) == 3 ) && ( $foo[ 1 ] =~ /\d+/ ) && ( $foo[ 2 ] eq "t" ) ) { $resolution = 1 / $foo[ 1 ] * 4 * 2 / 3; last SWITCH; } # ( 'r', n1, d, n2) Resolution = 1/n1 divided by n2 if( ( scalar( @foo ) == 4 ) && ( $foo[ 1 ] =~ /\d+/ ) && ( $foo[ 2 ] eq "d" ) && ( $foo[ 3 ] =~ /\d+/ ) ) { $resolution = 1 / $foo[ 1 ] / $foo[ 3 ] * 4; } } } } return $score; }