Алгоритм Хаффмана, проблемы с битовыми операциями, Написан весь алгоритм, но нужна помощь с кодированием двоичных кодов в Опции

[Amgeliemo]

Здравствуйте! Есть ДЗ по информатике - создать программу на Pascal ABCnet, которая сжимает файл по алгоритму Хаффмана.

Я сначала написал программу хотя бы создания дерева и словаря, чтобы была основа, и думал, что с битами разберусь позже. Дело в том, что нам вообще ничего не рассказывали про саму кодировку, и если на Си я нашел очень много информации по тому, как можно менять биты внутри байтового символа, например, то на Паскале я так и не нашел решения..

В общем, ниже представлена программа, которая кодирует ТЕКСТОВЫЙ файл по алгоритму Хаффмана (текстовый или нет - не важно, это я, скорее всего, поменяю), и она заменяет один байт символа на пять-шесть байт последовательностей цифр :DD А нужно, чтобы эти цифры вгонялись в биты.

Плюс преподаватель рассказывал, что обратная программа (разархиватор) идет по коду, находит префиксный код и прекращает чтение, переключается на следующий "байт" как бы, а найденный заменяет числом. Но я не представляю, как можно сделать так, чтобы читались БИТЫ, и если находится последовательность БИТ из 4 штук, то все это прекращалось. Пожалуйста, просветите невежду!

Буду очень благодарен, если хотя бы расскажете, как мне это сделать (я не прошу именно менять что-то в программе). Просто на основе моих замен объяснить, как то же самое запихнуть внутрь байта. Я знаю лишь shr и shl, но не смог придумать применения этому(

Еще самое обидное, что дедлайн передвинули на 10 дней ближе, и теперь вообще все плохо..

Код

Program Huffman;

Const
  n = 255;
  textIn = 'Huffman1.txt'; //Ввод текста
  textOut = 'Huffman2.txt'; //Вывод текста

Type
  symbolsArray = array[1..20000] of string;
  numbersArray = array[1..n] of integer;

Procedure sorting(var tempSymbols: symbolsArray; var numbers: numbersArray; var k: integer);
  Var
    i, j: integer; //Счетчики
    temp1: string; //Переменная для обмена значений
    temp2: integer; //Переменная для обмена значений
  Begin
    for i := 1 to k do
      for j := 1 to (k - 1) do
        if (numbers[j] > numbers[j + 1]) then begin
          temp1 := tempSymbols[j]; tempSymbols[j] := tempSymbols[j + 1]; tempSymbols[j + 1] := temp1;
          temp2 := numbers[j]; numbers[j] := numbers[j + 1]; numbers[j + 1] := temp2;
          end;
  End;

Procedure code(m, k: integer; symbols, tempSymbols: symbolsArray; var codes: symbolsArray);
Var
  i, j: integer; //Счетчики
  flag: boolean; //Флаг
  a, b: byte; //Коды
  line: string;
  Begin
    a := 0; b := 1;
    line := tempSymbols[m + 1];
    for i := 1 to length(line) do begin
      flag := false; j := 1; //Сбрасывание флага и счетчика
      while (flag = false) and (j <= k) do begin
        if (line[i] = symbols[j]) then begin
          if (m = 0) then codes[j] := a + codes[j] else codes[j] := b + codes[j];
          flag := true;
          end;
        j := j + 1;
        end;
      end;
  End;

Var
  tfIn, tfOut: textfile; //Файлы
  text1, text2: symbolsArray; //Текст из файла и текст в файл
  text: string; //Строка текста
  symbols, tempSymbols: symbolsArray; //Символы
  codes: symbolsArray; //Коды символов
  numbers: numbersArray; //Кол-во повторений
  i, j, l, m: integer; //Счетчики
  k, tempK: integer; //Длины массивов
  flag: boolean; //Флаг для прерывание цикла

Begin
  assignfile(tfIn, textIn);
  reset(tfIn);
  m := 0; //Кол-во строк
  //Ввод текста до последней строки
  while not eof(tfIn) do begin
    m := m + 1; //Кол-во строк
    readln(tfIn, text1[m]);
    end;
  closefile(tfIn);
  //Ввод символов
  k := 0; //Кол-во символов
  for l := 1 to m do begin
    text := text1[l];
    for i := 1 to length(text) do begin
      flag := false; j := 1; //Сбрасывание флага и счетчика
      while (flag = false) and (j <= n) do begin  //Нет совпадений - flag = false
        if (text[i] = symbols[j]) then begin
          flag := true;
          numbers[j] := numbers[j] + 1; //+1 к кол-ву повторений
          end;
        j := j + 1;
        end;
      if (flag = false) then begin
        k := k + 1;
        symbols[k] := text[i];
        tempSymbols[k] := text[i];
        numbers[k] := 1;
        end;
      end;
    end;
  tempK := k;
  if (tempK = 1) then codes[1] := '0';
  while (tempK > 1) do begin
    //Сортировка по возрастанию кол-ва повторений
    sorting(tempSymbols, numbers, tempK);
    //Добавление 0 к самому редкому символу
    code(0, k, symbols, tempSymbols, codes);
    //Добавление 1 ко 2-ому самому редкому символу
    code(1, k, symbols, tempSymbols, codes);
    //Соединение двух самых редких строк
    numbers[1] := numbers[1] + numbers[2];
    tempSymbols[1] := tempSymbols[1] + tempSymbols[2];
    if (tempK > 2) then
      for i := 2 to (tempK - 1) do begin
        numbers[i] := numbers[i + 1];
        tempSymbols[i] := tempSymbols[i + 1];
        end;
    tempK := tempK - 1;
    end;
  //Создание нового текста
  for l := 1 to m do begin
    text := text1[l];
    for i := 1 to length(text) do begin
      flag := false; j := 1;
      while (flag = false) and (j <= k) do begin
        if (text[i] = symbols[j]) then text2[l] := text2[l] + codes[j];
        j := j + 1;
        end;
      end;
    end;
  //Вывод архивированного текста
  if (k > 0) then begin
    assignfile(tfOut, textOut);
    rewrite(tfOut);
    for i := 1 to k do writeln(tfOut, symbols[i],' - ', codes[i]);
    writeln(tfOut);
    for i := 1 to m do writeln(tfOut, text2[i]);
    closefile(tfOut);
    end;
end.

[Федосеев Павел]

Может быть, сделать так? Это только идея.
Запись в бинарный файл

  Mask:=$80;
  CurrByte:=0;
  while (ещё есть символы в тексте) do
  begin
    CurrChar:=GetNextCharFromText(); //берём следующий символ из текста
    for i:=1 to (длина кода символа CurrChar) do
    begin
      if GetBit(CurrChar, i)=1 then  //если i-ый бит в коде символа CurrChar равен 1
      begin
        CurrByte:=CurrByte or Mask; //устанавливаем этот бит в выходном байте
      end;
      Mask:=Mask shr 1; // смещаем маску к следующей позиции в байте
      if Mask=0 then  // если мы полностью заполнили байт
      begin
        write(tfOut, CurrByte);  // то сохраняем байт в файле
        Mask:=$80;       // и начинаем заполнять следующий байт
        CurrByte:=0;
      end;
    end;
  end;
  if Mask<>$80 then          // если остались несохранённые биты,
    write(tfOut, CurrByte);  // то сохраняем байт в файле

И примерно так же обратное преобразование.

Единственно, при сохранении нужно учесть, что незаполненные биты последнего байта могут дать несколько дополнительных символов при раскодировке. Их бы как-то пометить, что они не подлежат декодированию.