Получение нового текстового файла, в котором все слова во всех предложениях записаны в обратном порядке

uses crt;
const
  MaxStek = 10;
var
  a: array[1..MaxStek] of string;
  t, g: text;
  i, n, k, q, st: integer;
  s, m: string;
 
procedure POP;
begin
  write(g, a[q], ' ');
  a[q] := '';
  q := q - 1;
  writeln ('Из стека убрано значение. Текущее количество элементов в стеке: ',q)
end;
 
procedure PUSH(str: string);
begin
  q := q + 1;
  a[q] := str;
  writeln ('В стек помещено значение. Текущее количество элементов в стеке:',q)
end;
 
begin
  assign(g, 'g.txt');
  rewrite(g);
  assign(t, 'k.txt'); {исходный файл}
  reset(t);
 
  m:= '';
 
  while not EOF(t) do begin
    readln(t, s);
    if (Length(s)>0) and (s[Length(s)]<>' ') then s := s + ' ';
    k:= 0;
    n:= 1;
    i:= 0;
    for n:= 1 to length(s) do begin
      i:= n - k; 
 
      if (s[n] = ' ') then begin 
        m := copy(s, k, i);
        k := n; 
      end;
 
      if (m <> '') and (q <= MaxStek) then begin 
        PUSH(m);
        m:= '';
      end;
 
      if q = MaxStek then begin
        for st := 1 to q do
          POP;
        writeln(g);
      end;
 
    end;
 
  end;
 
if q<>0 then begin
for i:=1 to q do
POP()
end;
 
  close(g);
  close(t);
end.

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Sw : String;
  i, Len, LenW, Cnt : Integer;
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnIn);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Извлекаем из стека слова и записываем их в выходной файл.}
          Cnt := 0;
          while Pop(PSt, Sw) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Sw);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  StMaxSize = 10; {Наибольшая глубина стека.}
  
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении
заведомо пустого стека. Иначе, будут утечки памяти.}
procedure StInit(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
Если в стеке есть свободное место (количество элементов в стеке меньше,
чем StMaxSize), то новый элемент добавляется на вершину стека и функция
возвращает значение True.
Если в стеке свободного места нет, то действие отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < StMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 больше.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 меньше.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Data : String;
  i, Len, LenW, Cnt : Integer;
  IsAdd : Boolean; {True - элемент добавлен в стек, False - произошло переполнение стека.}
begin
  {Начальная инициализация стека.}
  StInit(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    IsAdd := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            IsAdd := Push(St, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Если было переполнение стека, значит некоторые слова в конце предложения
          в стек не попали. Извещаем об этом путём записи в выходной файл
          текста '(*!!!Переполнение!!!*)' - на том месте, где должны были находиться
          не уместившиеся слова.}
          Cnt := 0;
          if not IsAdd then
          begin
            Write(FOut, '(*!!!Переполнение!!!*)');
            Inc(Cnt);
          end;
          {Извлекаем из стека слова и записываем их в выходной файл.}
          while Pop(St, Data) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Data);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  StMaxSize = 10; {Наибольшая глубина стека.}
  
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении
заведомо пустого стека. Иначе, будут утечки памяти.}
procedure StInit(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
Если в стеке есть свободное место (количество элементов в стеке меньше,
чем StMaxSize), то новый элемент добавляется на вершину стека и функция
возвращает значение True.
Если в стеке свободного места нет, то действие отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < StMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 больше.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 меньше.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Data : String;
  i, Len, LenW, Cnt : Integer;
begin
  {Начальная инициализация стека.}
  StInit(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            {Добавляем слово в стек. Слово добавится только, если в стеке есть
            свободное место.}
            Push(St, Copy(S, i - LenW + 1, LenW));
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Извлекаем из стека слова и записываем их в выходной файл.}
          Cnt := 0;
          while Pop(St, Data) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Data);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Data, DataTmp : String;
  Ch : Char;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, j, Len, LenW, LenBw : Integer;
  IsOff : Boolean; {True - индекс находится внутри предложения, иначе - False.}
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения,
    слова и части, расположенные между слов (междусловия). Слова и междусловия
    складываем в стек. После записи каждого слова/междусловия добавляем в стек
    признак, который будет определять тип предыдущего элемента. Например,
    пускай, для слова признаком будет строка '1', для междусловия - строка '2'.
    Как только обнаружится конец предложения, изымаем из стека все слова и
    междусловия и записываем их в выходной файл. При этом междусловия записываем
    задом наперёд, а слова - как есть.
    Из за того, что междусловия могут быть разделены переносами строк, во время
    их записи в стек будем выполнять склейку. Склейка будет происходить так.
    Если надо добавить в стек междусловие, то мы проверяем - если на вершине
    стека уже лежит другое междусловие, то мы это другое междусловие изымаем
    из стека и склеиваем его с текущим междусловием. И затем склеенное
    междусловие записываем обратно - в стек.
    В отношении переносов строк будем поступать так. Переносы строк, расположенные
    в начале предложений не будем учитывать. А те переносы, которые расположены
    внутри предложений будем заменять на пробелы.
    Флаг IsOff будет сигнализировать: True - индекс (i) внутри предложения,
    False - индекс за пределами предложения.}
    IsOff := False;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          if (i = Len) or not (S[i + 1] in Dw) then {Отслеживаем конец междусловия.}
          begin
            Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки текущее междусловие.}
            {Если на вершине стека уже лежит другое междусловие, то изымаем это
            междусловие с вершины стека, выполняем его склейку с текущим
            междусловием, а затем склеенное междусловие записываем обратно - в стек.}
            if Pop(PSt, DataTmp) then {Берём из стека признак.}
              if DataTmp = '2' then {Если признак соответствует междусловию.}
              begin
                Pop(PSt, DataTmp); {Берём из стека междусловие.}
                Data := DataTmp + Data; {Склеиваем взятое междусловие с текущим междусловием.}
              end
              else {Если признак НЕ соответствует междусловию.}
                Push(PSt, DataTmp); {Возвращаем признак в стек.}
            Push(PSt, Data); {Добавляем междусловие в стек.}
            Push(PSt, '2'); {Добавляем в стек признак междусловия.}
            LenBw := 0; {Сброс длины междусловия.}
            IsOff := True; {True означает, что мы находимся внутри предложения.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            Push(PSt, '1'); {Добавляем в стек признак слова.}
            LenW := 0; {Сброс длины слова.}
          end;
          IsOff := True; {True означает, что мы находимся внутри предложения.}
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
          while Pop(PSt, Data) do {Извлекаем из стека признак слова/междусловия.}
            {Далее поступаем в зависимости от значения признака.}
            case Data[1] of
              '1' : {'1' - значит следующий элемент в стеке является словом.}
              begin
                Pop(PSt, Data);    {Извлекаем из стека слово.}
                Write(FOut, Data); {Записываем слово в выходной файл.}
              end;
              '2' : {'2' - значит следующий элемент в стеке является междусловием.}
              begin
                {Извлекаем из стека междусловие.}
                Pop(PSt, Data);
                {Переворачиваем междусловие.}
                LenBw := Length(Data);
                for j := 1 to LenBw div 2 do
                begin
                  Ch := Data[LenBw - j + 1];
                  Data[LenBw - j + 1] := Data[j];
                  Data[j] := Ch;
                end;
                Write(FOut, Data); {Записываем междусловие в выходной файл.}
              end;
              else
                Write(FOut, '(*Ошибка! Незарегистрированный тип: ', Data, '!*)');
            end;
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
          IsOff := False; {False означает, что мы вышли за пределы предложения.}
        end;
        {Обработка переносов строк.
        Переносы строк внутри предложений будем заменять на пробелы и записывать
        в стек в виде междусловий.}
        if IsOff and (i = Len) and Eoln(FIn) and not Eof(FIn) then
        begin
          Push(PSt, ' '); {Добавляем пробел в стек.}
          Push(PSt, '2'); {Добавляем в стек признак междусловия.}
        end;
      end;
      Readln(FIn); {Переход на следующую строку во входном файле.}
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    Sign : Char;    {'1' - слово, '2' - междусловие.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
aSign - знак, задающий тип данных: '1' - слово, '2' - междусловие.}
procedure Push(var aPSt : TPElem; const aData : TData; const aSign : Char);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  PElem^.Sign := aSign; {Записываем сведения о типе данных.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметры aData и aSign. В этом случае,
функция возвращает значение True. Если стек пуст, то операция отменяется,
и функция возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData; var aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    aSign := PElem^.Sign; {Читаем сведения о типе данных.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
  Sign : Char;
begin
  while Pop(aPSt, Data, Sign) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(const aF : Text; var aPSt : TPElem);
var
  Data, DataTmp : TData;
  Sign : Char;
  i, Len : Integer;
  Ch : Char;
begin
  {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
  while Pop(aPSt, Data, Sign) do
  begin
    {Если выбрано междусловие.}
    if Sign = '2' then
    begin
      {Склейка смежных междусловий.}
      while Pop(aPSt, DataTmp, Sign) and (Sign = '2') do
        Data := DataTmp + Data;
      {Если поседний выбранный из стека элемент не является междусловием,
      то возвращаем его обратно - в стек.}
      if Sign <> '2' then
        Push(aPSt, DataTmp, Sign);
      {Переворачиваем муждусловие.}
      Len := Length(Data);
      for i := 1 to Len div 2 do
      begin
        Ch := Data[Len - i + 1];
        Data[Len - i + 1] := Data[i];
        Data[i] := Ch;
      end;
    end;
    Write(aF, Data); {Записываем элемент в файл.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Sw, Sb : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    Sw := ''; {Слово.}
    Sb := ''; {Междусловие.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Push(PSt, Copy(S, i - LenBw + 1, LenBw), '2'); {Добавление междусловия в стек.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW), '1'); {Добавление слова в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, PSt); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Push(PSt, #10#13, '2'); {Добавляем в стек перевёрнутый перенос строки.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, PSt);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  aStackMaxSize = 100; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    Sign : Char;    {'1' - слово, '2' - междусловие.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
aSign - знак, задающий тип данных: '1' - слово, '2' - междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData; const aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    PElem^.Sign := aSign; {Записываем сведения о типе данных.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметры aData и aSign. В этом случае,
функция возвращает значение True. Если стек пуст, то операция отменяется,
и функция возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData; var aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    aSign := PElem^.Sign; {Читаем сведения о типе данных.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
  Sign : Char;
begin
  while Pop(aSt, Data, Sign) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(const aF : Text; var aSt : TStack);
var
  Data, DataTmp : TData;
  Sign : Char;
  i, Len : Integer;
  Ch : Char;
begin
  {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
  while Pop(aSt, Data, Sign) do
  begin
    {Если выбрано междусловие.}
    if Sign = '2' then
    begin
      {Склейка смежных междусловий.}
      while Pop(aSt, DataTmp, Sign) and (Sign = '2') do
        Data := DataTmp + Data;
      {Если поседний выбранный из стека элемент не является междусловием,
      то возвращаем его обратно - в стек.}
      if Sign <> '2' then
        Push(aSt, DataTmp, Sign);
      {Переворачиваем муждусловие.}
      Len := Length(Data);
      for i := 1 to Len div 2 do
      begin
        Ch := Data[Len - i + 1];
        Data[Len - i + 1] := Data[i];
        Data[i] := Ch;
      end;
    end;
    Write(aF, Data); {Записываем элемент в файл.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Sw, Sb : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
begin
  {Начальная инициализация стека.}
  Init(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    Sw := ''; {Слово.}
    Sb := ''; {Междусловие.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Push(St, Copy(S, i - LenBw + 1, LenBw), '2'); {Добавление междусловия в стек.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(St, Copy(S, i - LenW + 1, LenW), '1'); {Добавление слова в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, St); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Push(St, #10#13, '2'); {Добавляем в стек перевёрнутый перенос строки.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, St);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}         
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(var aF : Text; var aPStW, aPStBw : TPElem; const aIsWord : Boolean);
var
  PSt1, PSt2 : TPElem;
  Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsData1, IsData2 : Boolean;
begin
  {Переливаем междусловия в стек PSt1 и выполняем переворачивания.}
  PSt1 := nil; {Инициализация стека PSt1}
  while Pop(aPStBw, Data) do {Берём междусловие из стека междусловий.}
  begin
    {Переворачиваем междусловие.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    Push(PSt1, Data); {Записываем междусловие в стек PSt1.}
  end;
  {Переливаем междусловия обратно - в стек междусловий.}
  while Pop(PSt1, Data) do
    Push(aPStBw, Data);
 
  {Выбираем очерёдность стеков.}
  if aIsWord then
  begin
    PSt1 := aPStW;
    PSt2 := aPStBw;
  end
  else
  begin
    PSt1 := aPStBw;
    PSt2 := aPStW;
  end;
 
  {Извлекаем из стеков слова и междусловия и записываем их в выходной файл.}
  repeat
    IsData1 := Pop(PSt1, Data);
    if IsData1 then
      Write(aF, Data);
    IsData2 := Pop(PSt2, Data);
    if IsData2 then
      Write(aF, Data);
  until not (IsData1 or IsData2);
  {Теперь стеки пусты, выполняем инициализацию представляющих их параметров.}
  aPStW := nil;
  aPStBw := nil;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PStW, PStBw : TPElem; {Стек слов и стек междусловий.}
  Data, DataTmp : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord:
  True - последний записанный в стек элемент является словом,
  False - последний записанный в стек элемент является междусловием.}
  IsWord : Boolean;
begin
  {Начальная инициализация стеков.}
  PStW := nil;
  PStBw := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки междусловие.}
            {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
            if not IsWord and Pop(PStBw, DataTmp) then
              Data := DataTmp + Data;
            Push(PStBw, Data); {Добавление междусловия в стек.}
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(PStW, Copy(S, i - LenW + 1, LenW)); {Добавление слова в стек.}
            IsWord := True; {Флаг: последний добавленный элемент - слово.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, PStW, PStBw, IsWord); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Data := #10#13; {Перевёрнутый перенос строки.}
        {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
        if not IsWord and Pop(PStBw, DataTmp) then
          Data := DataTmp + Data;
        Push(PStBw, Data); {Добавление междусловия в стек.}
        IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, PStW, PStBw, IsWord);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(PStW);
    StFree(PStBw);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

program Project1;
 
const
  aStackMaxSize = 100; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае функция
возвращает значение True. Если стек пуст, то операция отменяется и функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(var aF : Text; var aStW, aStBw : TStack; const aIsWord : Boolean);
var
  St1, St2 : TStack;
  Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsData1, IsData2 : Boolean;
begin
  {Переливаем междусловия в стек St1 и выполняем переворачивания.}
  Init(St1);
  while Pop(aStBw, Data) do {Берём междусловие из стека междусловий.}
  begin
    {Переворачиваем междусловие.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    Push(St1, Data); {Записываем междусловие в стек St1.}
  end;
  {Переливаем междусловия обратно - в стек междусловий.}
  while Pop(St1, Data) do
    Push(aStBw, Data);
 
  {Выбираем очерёдность стеков.}
  if aIsWord then
  begin
    St1 := aStW;
    St2 := aStBw;
  end
  else
  begin
    St1 := aStBw;
    St2 := aStW;
  end;
 
  {Извлекаем из стеков слова и междусловия и записываем их в выходной файл.}
  repeat
    IsData1 := Pop(St1, Data);
    if IsData1 then
      Write(aF, Data);
    IsData2 := Pop(St2, Data);
    if IsData2 then
      Write(aF, Data);
  until not (IsData1 or IsData2);
  {Теперь стеки пусты, выполняем инициализацию представляющих их параметров.}
  Init(aStW);
  Init(aStBw);
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  StW, StBw : TStack; {Стек слов и стек междусловий.}
  Data, DataTmp : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord = True - последний записанный в стек элемент является словом,
    False - последний записанный в стек элемент является междусловием.
  IsDataW = True - слово успешно добавлено в стек слов. Иначе - False.
  IsDataBw = True - междусловие успешно добавлено в стек междусловий. Иначе - False.}
  IsWord, IsDataW, IsDataBw : Boolean;
begin
  {Начальная инициализация стеков.}
  Init(StW);
  Init(StBw);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    IsDataW := True;
    IsDataBw := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            if IsDataBw then
            begin
              Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки междусловие.}
              {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
              if not IsWord and Pop(StBw, DataTmp) then
                Data := DataTmp + Data;
              IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
              if IsDataBw then
                IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            end;
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            if IsDataW then
            begin
              IsDataW := Push(StW, Copy(S, i - LenW + 1, LenW)); {Добавление слова в стек.}
              if IsDataBw then
                IsWord := True; {Флаг: последний добавленный элемент - слово.}
            end;
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          StWrite(FOut, StW, StBw, IsWord); {Запись содержимого стека в файл.}
          IsDataW := True;
          IsDataBw := True;
        end;
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        {Если в стеке междусловий есть свободное место, то добавляем в него
        перевёрнутый перенос строки.}
        if IsDataBw then
        begin
          Data := #10#13; {Перевёрнутый перенос строки.}
          {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
          if not IsWord and Pop(StBw, DataTmp) then
            Data := DataTmp + Data;
          IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
          if IsDataBw then
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        end;
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, StW, StBw, IsWord);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(StW);
    StFree(StBw);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.