IkinG
, Увы, я тоже хвостист…
Задержка на N… месяцев по вредным обстоятельствам --- не было Инета…
Решение ниже
/////////////////////////////////////////////////////////////
PROGRAM Cutting
PARAMETER Bunny ='PROGRAM Cutting (((()))))----()((())())(**** +++(123),+++ &
(12) +++(123)////(1234),,,,,(12345) 12345 -- Compaq Visual &
Fortran Version 6.1 Home Page !!!(Debugging+++Fortran+++Programs)!!!'
CHARACTER ( Len = 200 ) InString
!
!------------------------------------------------------------------------------
!
InString = Bunny
WRITE (*, *) InString
CALL COMPRESS (InString)
WRITE (*, *) InString
END PROGRAM Cutting
! =============================================================================
!
!
! COMPRESS.F90 Подпрограмма COMPRESS
! Верезает печатные символы между сбалансированными скобками и сжимает строку...
! Освободившийся хвост строки зачищается пробелами
!
! Аргумент (Фиктивный параметр)
! ----------------------------------------------------------------------------
! Str --- Строка символов-
! ВНИМАНИЕ ПОДПРОГРАММА "КАЛЕЧИТ ПАРАМЕТР" !!! *** *** *** +++ +++ ---
!
!-----------------------------------------------------------------------------
!
SUBROUTINE COMPRESS (Str)
CHARACTER Str * (*)
CHARACTER Char ! Промежуточная Рабочая переменная для хранения символа
PARAMETER Left = '(', Rigth = ')', Blank = ' '! Обозвали так скобки и пробел для удобства
! и прозрачности текста программы
! Символ пробела (Нужен для зачистки)
! Blank) = '\0'C Если нужна C - совместимость --- ESC нулями
! (Символические имена лучше литералов...)
INTEGER Head, Tail ! Индексы-Указатели на символ в строке...
! Одиночный Символ интерпретируется как подстрока в строке
! P.S. При выходе из подпрограммы длина сжатой подстроки Head - 1
INTEGER LenStr ! Полная длина строки символов
INTEGER IBlank ! Индексирует "вычищаемые" символы хвоста (после сжатия0
LOGICAL Closed ! Флаг/Переключатель ---.TRUE. --- В Текущем состоянии Скобки закрыты
! ---.FALSE.. --- В Текущем состоянии Левая скобка открыта
!
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
!
! ====================>>> Движение по строке слева направо ==========================>>>
! Обрабатываем строку посимвольно в DO-цикле от 1 до LEN(Str)
!
! Смысл Всего ЭТОГО в некотором Текущем состоянии
! -----------------------------------------------
!
!
! Head --- Текущий указатель на Голову
! ------------------------------------
! |
! | Tail --- Текущий указатель на Хвост
! | -----------------------------------
! | |
! | |
! ----------------------------------------- Строка символов
! | с1 | с2 | с3 | .. | .. | .. | .. | N | <===============
! -----------------------------------------
! 1 2 3 ... ... ... ... | Указатель на Последний символ строки N == LEN(Str)
! ------------------------------------------------------
! N == LenStr
!
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
Head = 1
Closed =.TRUE.
LenStr = LEN(Str)
DO Tail = 1, LenStr
!-------------------------------------------------------
!Основной программный цикл по массиву одиночных символов
!передвигаемся слева направо.
! Нужные символы перебрасываются и хвоста в гллву...
!
! В некотором смысле Хвост из Головы растёт
! --- вначале совпадает с Головой, f затем
! (за счёт"рыхлости"строки символов) иуходит дальше...
!-------------------------------------------------------
!
Char = Str(Tail : Tail)
IF ( Char == Left ) THEN
Closed = .FALSE.
ELSEIF ( Char == Rigth ) THEN
Closed = .TRUE.
END IF
IF ( Closed .AND. (Char /= Rigth) ) THEN
! ---------------------------------------------------------------
! Если прапвая скобка закрыта и символ не правая скобка
! Только в этом случае сохраняем текущий символ ---
!
! Перебрасываем его из хвоста в голову и сдвигаем голову "вправо"
! ---------------------------------------------------------------
Str(Head : Head) = Char
Head = Head + 1
END IF
END DO
DO IBlank = Head, LenStr
! -------------------------------------------------
! Чистим хвост пробелами..---.
!
! Затираем мусор сразу за головой и до конца строки...
!(В Общем случае должен остаться "дубликат")
! перекидываемых символов
!
! Если не было лакун (Скобок),
! то Head > LenStr (Head == LenStr,+ 1)
! и данныый DO - цикл пропускается
! -------------------------------------------------
!
Str(IBlank : IBlank) = Blank ! Стандарт FORTRAN --- забиваем ненужный мусор пробелами
END DO
END SUBROUTINE COMPRESS
