如何在Perl中使用方括号,如C？

昨天,Computerphile上传了一段关于代码高尔夫和bitshift变化的视频,我真的对生成音乐的程序非常着迷.这是我在视频中的代码格式化版本.

int g(int sample, int x, int t, int overdrive) {
 return (
  (
   3 & x & (
    sample *
    (
     (
      3 & sample >> 16
      ?
      "BY}6YB6%"
      :
      "Qj}6jQ6%"
     )[t % 8]
     +
     51
    ) >> overdrive
   )
  ) << 4
 );
}

int main(int n, int s) {
 for (int sample=0 ;; sample++)
  putchar(
   g(sample, 1, n=sample >> 14, 12)
    +
   g(sample, s=sample >> 17, n^sample >> 13, 10)
    +
   g(sample, s/3, n + ((sample >> 11) % 3), 10)
    +
   g(sample, s/5, 8 + n-((sample >> 10) % 3), 9)
  );
}

我想尝试将程序转换为纯 perl,这是我的尝试.

sub g {
 return (
  (
   3 & $_[1] & (
    $_[0] *
    (
     (
      3 & $_[0] >> 16
      ?
      "BY}6YB6%"
      :
      "Qj}6jQ6%"
     )[$_[2] % 8]
     +
     51
    ) >> $_[3]
   )
  ) << 4
 );
}

for($i=0;;$i++){
  print pack('C',
   g($i, 1, $n=$i >> 14, 12)
    +
   g($i, $s=$i >> 17, $n^$i >> 13, 10)
    +
   g($i, $s/3, $n + (($i >> 11) % 3), 10)
    +
   g($i, $s/5, 8 + $n-(($i >> 10) % 3), 9)
  );
}

根据putchar手册,该值在内部转换为unsigned char写入时.所以我在perl中使用了pack函数,C模板是unsigned char.但是,当我将两个程序的结果输出到aplay它们时,它们不会产生相同的音乐.

如果我使用内联C并g从perl 调用该函数它可以正常工作.

use Inline C => <<'END_C';

int g(int sample, int x, int t, int overdrive) {
 return (
  (
   3 & x & (
    sample *
    (
     (
      3 & sample >> 16
      ?
      "BY}6YB6%"
      :
      "Qj}6jQ6%"
     )[t % 8]
     +
     51
    ) >> overdrive
   )
  ) << 4
 );
}

END_C

for($i=0;;$i++){
  print pack('C',
   g($i, 1, $n=$i >> 14, 12)
    +
   g($i, $s=$i >> 17, $n^$i >> 13, 10)
    +
   g($i, $s/3, $n + (($i >> 11) % 3), 10)
    +
   g($i, $s/5, 8 + $n-(($i >> 10) % 3), 9)
  );
}

我唯一的解释[$_[2] % 8]就是没有做我认为的perl.

如何让程序在perl和C中产生相同的音乐？在Windows上,perl theprogram.pl | sox -c 1 -b 8 -e unsigned -t raw -r 8k - -t waveaudio 0如果安装了sox,则可以使用.

String不是perl中的数组,需要通过调用substr()函数替换数组访问:

...
ord(substr((
 3 & $_[0] >> 16
 ?
 "BY}6YB6%"
 :
 "Qj}6jQ6%"
), $_[2] % 8, 1))
...

更高效:

# Outside the sub.
my $a1 = [ unpack 'C*', "BY}6YB6%" ];
my $a2 = [ unpack 'C*', "Qj}6jQ6%" ];

...
${ 3 & $_[0] >> 16 ? $a1 : $a2 }[ $_[2] % 8 ]
...