Используйте Perl для добавления изображения GIF, отличного от 8-битного, в PDF

Я пытаюсь добавить изображения GIF без чересстрочной развертки, отличные от 8-битных, в документ PDF без полного декодирования потока битов с помощью PDF::Create для Perl.

Алгоритм LZWDecode, являющийся частью стандарта PDF, требует наличия всех изображений. иметь минимальный размер кода LZW, равный 8 битам, а PDF::Create жестко закодировано для встраивания только 8-битных изображений.

На данный момент я адаптировал загрузчик изображений. из PDF::Create для чтения 5-битного изображения и полного декодирования потока LZW. Затем я могу использовать алгоритм кодировщика из PDF::Create, чтобы повторно упаковать изображение как 8-битное.

Что я хотел бы сделать, так это исключить шаг декодирования/кодирования с интенсивным использованием памяти. В этой ветке предполагается, что это возможно путем "расширения или сдвига битов", чтобы коды LZW имели правильную длину. для LZWDecode.

Я связался с автором темы, и он предоставил некоторые дополнительные сведения, в частности, что коды индексов цвета остаются прежними, но дополняются нулями (например, [10000] становится [000010000]), что коды <Clear> и <End> заменяются на <256> и <257> соответственно, и что все остальные коды смещены на 256 - исходный код <Clear>.

Однако он не смог уточнить подробности из-за ограничений со стороны своего работодателя. В частности, я не уверен, как обращаться с кодом, когда его измененное значение превышает <4095> (максимальный индекс для кодовой таблицы LZW). Я также не уверен, как повторно упаковать пересмотренные коды в битовый поток.

Алгоритмы, которые я сейчас использую, приведены ниже.

# Read 5-bit data stream

sub ReadData5 {

    my $data = shift;

    my $c_size = 6;                # minimium LZW code size
    my $t_size = 33;               # initial code table size
    my ($i_buff,$i_bits) = (0,0);  # input buffer
    my ($o_buff,$o_bits) = (0,0);  # output buffer

    my $stream = '';               # bitstream
    my $pos    = 0;

    SUB_BLOCK: while (1){
        my $s = substr($data, $pos++, 1);

        # get sub-block size
        my $n_bytes  = unpack('C', $s) or last SUB_BLOCK;
        my $c_mask   = (1 << $c_size) - 1;

        BYTES: while (1){
            # read c_size bits
            while ($i_bits < $c_size){

                # end of sub-block
                !$n_bytes-- and next SUB_BLOCK;

                $s = substr($data, $pos++, 1);
                my $c = unpack('C', $s);

                $i_buff |= $c << $i_bits;
                $i_bits += 8;
            }

            # write c_size bits
            my $code   = $i_buff & $c_mask;

            my $w_bits = $c_size;
            $i_buff  >>= $c_size;
            $i_bits   -= $c_size;
            $t_size++;

            if ($o_bits > 0){
                $o_buff |= $code >> ($c_size - 8 + $o_bits);
                $w_bits -= 8 - $o_bits;
                $stream .= pack('C', $o_buff & 0xFF);
            }

            if ($w_bits >= 8){
                $w_bits -= 8;
                $stream .= pack('C', ($code >> $w_bits) & 0xFF);
            }

            if (($o_bits = $w_bits) > 0){
                $o_buff = $code << (8 - $o_bits);
            }

            # clear code
            if ($code == 32){
                $c_size   = 6;
                $t_size   = 33;
                $c_mask   = (1 << $c_size) - 1;
            }

            # end code
            if ($code == 33){
                $stream .= pack('C', $o_buff & 0xFF);
                last SUB_BLOCK;
            }

            if ($t_size == (1 << $c_size)){
                if (++$c_size > 12){
                    $c_size--;
                } else {
                    $c_mask = (1 << $c_size) - 1;
                }
            }
        }
    }

    # Pad with zeros to byte boundary
    $stream .= '0' x (8 - length($stream) % 8);

    return $stream;
}

#---------------------------------------------------------------------------

# Decode 5-bit data stream

sub UnLZW5 {
    my $data = shift;

    my $c_size = 6;                 # minimium LZW code size
    my $t_size = 33;                # initial code table size
    my ($i_buff,$i_bits) = (0,0);   # input buffer

    my $stream = '';                # bitstream
    my $pos    = 0;

    # initialize code table
    my @table  = map { chr($_) } 0..$t_size-2;
    $table[32] = '';
    my $prefix = '';
    my $suffix = '';

    # get first code word
    while ($i_bits < $c_size){
        my $d     = unpack('C', substr($data, $pos++, 1));
        $i_buff   = ($i_buff << 8) + $d;
        $i_bits += 8;
    }

    my $c2     = $i_buff >> ($i_bits - $c_size);
    $i_bits   -= $c_size;
    my $c_mask = (1 << $i_bits) - 1;
    $i_buff   &= $c_mask;

    # get remaining code words
    DECOMPRESS: while ($pos < length($data)){
        my $c1 = $c2;

        while ($i_bits < $c_size){
            my $d     = unpack('C', substr($data, $pos++, 1));
            $i_buff   = ($i_buff << 8) + $d;
            $i_bits  += 8;
        }

        $c2      = $i_buff >> ($i_bits - $c_size);
        $i_bits -= $c_size;
        $c_mask  = (1 << $i_bits) - 1;
        $i_buff &= $c_mask;

        # clear code
        if ($c2 == 32){
            $stream  .= $table[$c1];
            $#table   = 32;
            $c_size   = 6;
            $t_size   = 33;
            next DECOMPRESS;
        }

        # end code
        if ($c2 == 33){
            $stream .= $table[$c1];
            last DECOMPRESS;
        }

        # get prefix and suffix
        $prefix = $table[$c1] if $c1 < $t_size;
        $suffix = $c2 < $t_size ? substr($table[$c2], 0, 1) : substr($prefix, 0, 1);

        # write prefix
        $stream .= $prefix;

        # write multiple-character sequence
        $table[$t_size++] = $prefix . $suffix;

        # increase code size
        if ($t_size == 2 ** $c_size){
            if (++$c_size > 12){
                $c_size--;
            }
        }
    }

    return $stream;
}