一行音楽をPerlワンライナーで書く奴
Ubuntuだと/dev/dspがないんだけど、aplayとかpacatで行けることがわかった
perl -e 'while(1){print pack("S",(((($t*(($t<<3)+303|$t<<7|$t>>10|($t<<4)+200|($t>>5&80)|($t*$t-606)&(~$t>>4))&808+$t>>12)&(101|151)&$t>>4))|($t|(($t>>8|$t<<5|$t<<7|$t>>14)&7|(~$t>>5))&$t>>6)&(~$t>>10))).pack("S",(((($s*(($s<<3)+303|$s<<7|$s>>10|($s<<4)+200|($s>>5&80)|($s*$s-606)&(~$s>>4))&808+$s>>12)&(101|151)&$s>>4))|($s|(($s>>8|$s<<5|$s<<7|$s>>14)&7|(~$s>>5))&$s>>6)&(~$s>>10))); $t+=1.5; $s+=96}' | pacat
Macだと多分こう
perl -e 'while(1){print pack("S",(((($t*(($t<< 3)+303|$t<<7|$t>>10|($t<<4)+200|($t>>5&80)|($t*$t-606)&(~$t>>4))&808+$t>>12)&(101|151)&$t>>4))|($t|(($t>>8|$t<<5|$t<<7|$t>>14)&7|(~$t>>5))&$t>>6)&(~$t>>10))).pack("S",(((($s*(($s<< 3)+303|$s<<7|$s>>10|($s<<4)+200|($s>>5&80)|($s*$s-606)&(~$s>>4))&808+$s>>12)&(101|151)&$s>>4))|($s|(($s>>8|$s<<5|$s<<7|$s>>14)&7|(~$s>>5))&$s>>6)&(~$s>>10))); $t+=1.5; $s+=96}' | play -c 2 -b 16 -e signed -L -t raw -r 44.1k -
datamosh
avi
open $f_in, '<', $ARGV[0]; read $f_in, my $buf, -s $ARGV[0]; my ( $movi, $idx1 ) = ( index( $buf, "movi" ), index( $buf, "idx1" ) ); my @frames = map { [ unpack( 'a4VVV', substr( $buf, $idx1 + 8 + $_ * 16, 16 ) ) ] } 0 .. ( ( unpack( 'V', substr( $buf, $idx1 + 4, 4 ) ) / 16 ) - 1 ); my ( $movi_new, $idx1_new, $count ) = ( "movi", substr( $buf, $idx1, 8 ), 0 ); for (@frames) { my $offset = length $movi_new; if (@$_[0] =~ /00d./ && @$_[1] & 0x10 && $count != 0) { $movi_new .= @$_[0] . "\x00\x00\x00\x00"; @$_[3] = "\x00\x00\x00\x00"; } else { $count++ if @$_[0] =~ /00d./ && @$_[1] & 0x10; $movi_new .= substr( $buf, $movi + @$_[2], @$_[3] + 8 ); $movi_new .= "\x00" if length($movi_new) % 2 == 1; } @$_[1] = "\x00\x00\x00\x00" if @$_[0] =~ /00d./ && @$_[1] & 0x10; @$_[2] = $offset; $idx1_new .= pack( 'a4VVV', @$_ ); } my $size = $movi + (length $movi_new) + (length $idx1_new) - 8; substr($buf, 4, 4, pack('V', $size)); substr($buf, $movi - 4, 4, pack('V', length $movi_new)); open $f_out, '>', $ARGV[1]; print $f_out substr( $buf, 0, $movi ) . $movi_new . $idx1_new;
保存して
$ perl mosh.py foo.avi out.avi
flv
open $f_in, '<', $ARGV[0]; read $f_in, my $buf, -s $ARGV[0]; my ($buf_new, $i, $first) = ("", 13, 1); while ($i < length $buf) { my $l = (substr($buf, $i, 1) =~ /\x08|\x09|\x12/) * (unpack('N', substr($buf, $i+1, 4)) >> 8); if (substr($buf, $i, 20) =~ /^\x09.{10}(.).*$/ && unpack('B8', $1) =~ /^0001....$/ && rand(10) < 7) { $first? ($first = 0) : (substr($buf, $i, $l+15, "") && ($i -= ($l + 15))); } $i += 11 + $l + 4; # tag + size + lasttagsize } open $f_out, '>', $ARGV[1]; print $f_out $buf;
Perlは汚くて短いコードが得意だって聞いたからできるだけ読みづらいコードを心がけました