for my $y ( 0 .. $HEIGHT-1 ) {
    my $s = substr( $$str, $y * $WIDTH, $WIDTH );
    while( $s =~ m[(([^\0])+)]g ) {
        my $c = ord($1); #, $-[0], $+[0];
        $b[ $c ][ LEFT   ] = $-[0]   if $-[0]   < $b[ $c ][ LEFT   ];
        $b[ $c ][ RIGHT  ] = $+[0]-1 if $+[0]-1 > $b[ $c ][ RIGHT  ];
        $b[ $c ][ TOP    ] = $y      if      $y < $b[ $c ][ TOP    ];
        $b[ $c ][ BOTTOM ] = $y      if      $y > $b[ $c ][ BOTTOM ];
    }
}

##</code><code>##

yr() took 3.484375
buk() took 1.233143
buk2() took 0.670660
buk3() took 0.029448

##</code><code>##

PDL::IO::Image-> new_from_pdl( 
    pdl([ unpack 'C*', $pdl ])
        -> reshape( 1000, 1000 )-> bitnot
)-> save( 'buk.png', 'PNG' );

##</code><code>##

PDL: Short D [7616,1200]
max = 145

       s/iter unpack   buk2  regex   buk3
unpack   3.02     --    -6%   -36%   -88%
buk2     2.84     6%     --   -32%   -87%
regex    1.92    57%    48%     --   -81%
buk3    0.362   733%   684%   430%     --