Код:
(**************************************************************************
П Р Е О Б Р А З О В А Т Е Л Ь Ф А Й Л О В D O C => M F T
* * D O C M U L * *
( * * Z E C K - 6 4 . 1 * * )
*************************************************************
(C) КАФЕДРА ВТ ЛЭТИ **ZECK** 08.84.
***************************************************************************)
LABEL
90,100,101,110;
(** ТИПЫ **)
TYPE
NAM=ARRAY[1..3] OF CHAR;
POSIT=RECORD
NM:NAM; CO:INTEGER;
END;
(** ОПИСАНИЕ ПЕРЕМЕННЫХ **)
VAR
NF: TEXT; (* ВХОДНОЙ ФАЙЛ *)
UF: TEXT; (* ВЫХОДНОЙ ФАЙЛ *)
FNAM: ARRAY[1..14] OF CHAR;(*ИМЯ ФАЙЛА *)
INTI: BOOLEAN; (* ИНДИКАТОР АННОТАЦИИ *)
SBT: ARRAY[1..128] OF CHAR;(*МАССИВ КОЛОНТИТУЛА *)
SBTL: INTEGER; (* КОЛИЧЕСТВО СИМВОЛОВ КОЛОНТИТУЛА *)
INS: NAM; (* ДИРЕКТИВА *)
I: INTEGER; (* СЛУЖЕБНАЯ ПЕРЕМЕННАЯ *)
S: CHAR; (* СИМВОЛ *)
K: INTEGER; (* НОМЕР ПОСИЦИИ В ТАB *)
TL: INTEGER; (* ЧИСЛО ДИРЕКТИВ DOC *)
TAB: ARRAY [1..30] OF POSIT;(* ТАБЛИЦА ДИРЕКТИВ DOC *)
NST: INTEGER; (* НОМЕР ВХОДНОЙ СТРОКИ *)
NAPN: INTEGER; (* НОМЕР ПРИЛОЖЕНИЯ *)
(** ВЫВОД ДИРЕКТИВЫ **)
PROCEDURE PUTD(D:INTEGER);
BEGIN
IF (D=6) AND INTI
THEN
BEGIN
WRITELN(UF,'.5');INTI:=FALSE;
END;
WRITE(UF,'.');
IF D<10
THEN WRITE(UF,D:1)
ELSE WRITE(UF,D:2);
WRITE(UF,' ');
END;
(** ИНИЦИАЛИЗАЦИЯ ТАБЛИЦЫ ДИРЕКТИВ **)
PROCEDURE INITD;
PROCEDURE A(N:NAM;C:INTEGER);
BEGIN
TL:=TL+1;TAB[TL].NM:=N;TAB[TL].CO:=C;
END;
BEGIN
TL:=0;
A('LIN',1);A('BLN',2);A('SWT',10);A('LST',4);A('TES',4);
A('HLV',6);A('AND',26);A('CHA',15);A('STL',17);A('TCT',25);
A('COM',20);A('CPY',16);A('PAG',5);A('TOC',10);A('CLN',4);
A('TLU',10);A('TTL',10);A('INT',10);A('APN',10);A('TBL',10);
A('ATT',1);A('SKI',23);A('RIT',3);A('MID',7);A('CPT',6);
A('MRR',10);
END;
(* ПРОПУСК ДО КОНЦА СТРОКИ *)
PROCEDURE SKIP;
BEGIN
WHILE NOT EOLN(NF) DO
BEGIN
READ(NF,S);WRITE(UF,S);
END;
READLN(NF);WRITELN(UF);NST:=NST+1;
END;
(* РАЗДЕЛЕНИЕ ДИРЕКТИВЫ И АРГУМЕНТА *)
PROCEDURE RAZD;
BEGIN
PUTD(TAB[K].CO);WRITELN(UF,'0');S:=' ';
WHILE (S=' ') AND NOT EOLN(NF) DO READ(NF,S);
WRITE(UF,' ');
IF S<>' '
THEN WRITE(UF,S);
SKIP;
WRITELN(UF,'.10 0');
END;
(* ВЫВОД ****** *)
PROCEDURE WRITEZV(Z:INTEGER);
VAR
I:INTEGER;
BEGIN
FOR I:=1 TO Z DO WRITE('*');
END;
(***** ОСНОВНАЯ ПРОГРАММА *********************************************)
BEGIN
INITD;NAPN:=0;NST:=0;SBTL:=0;INTI:=FALSE;
WRITEZV(34);WRITE('ZECK');WRITEZV(34);WRITELN;
FOR K:=1 TO 27 DO WRITE(' ');WRITELN('* * D O C M U L * *');
FOR K:=1 TO 33 DO WRITE(' ');WRITELN('V01.01');WRITEZV(72);WRITELN;
WRITE('ВХОДНОЙ ФАЙЛ:');READLN;READLN(FNAM);
RESET(NF,FNAM,'DOC',K);
IF K<0
THEN
BEGIN
WRITELN('?Z64-F-НЕТ ФАЙЛА',FNAM); GOTO 110;
END;
WRITE('ВЫХОДНОЙ ФАЙЛ:');READLN(FNAM);
REWRITE(UF,FNAM,'MFT');
WRITELN(UF,'.27 1');WRITELN(UF,'.18 1');
WHILE NOT EOF(NF) DO
BEGIN
IF EOLN(NF)
THEN SKIP
ELSE
BEGIN
READ(NF,S);
IF S<> '.'
THEN
BEGIN
WRITE(UF,S);SKIP;
END
ELSE
BEGIN
FOR K:=1 TO 3 DO
BEGIN
IF EOLN(NF)
THEN GOTO 100; READ(NF,INS[K]);
END;
FOR I:=1 TO 3 DO
IF INS[I]>'Z'
THEN INS[I]:=CHR(ORD(INS[I])-(ORD('Б')-ORD('B')));K:=0;
FOR I:=1 TO TL DO
IF TAB[I].NM=INS
THEN
BEGIN
K:=I;GOTO 90;
END;
GOTO 100;
90:
CASE K OF
1,2,3,4,5,7,8,10,11,12,13,14,15:
BEGIN
PUTD(TAB[K].CO);SKIP;
END;
6:
BEGIN
WRITELN(UF,'.10 3');WRITELN(UF,'.4 5');PUTD(TAB[K].CO);SKIP;
END;
23,24: RAZD;
22:
BEGIN
WRITELN(UF,'.4');PUTD(23);SKIP;WRITELN(UF,'.2 0');
END;
21:
BEGIN
WRITE(UF,'.1 П_Р_И_М_Е_Ч_А_Н_И_Е. '); SKIP;
END;
20:
BEGIN
RAZD;WRITELN(UF,'.26 0');
END;
18,19:
BEGIN
WRITELN(UF,'.5');WRITELN(UF,'.18 0');WRITELN(UF,'.6 0');
IF K=19
THEN
BEGIN
NAPN:=NAPN+1;WRITELN(UF,'ПРИЛОЖЕНИЕ ',NAPN:2);
END
ELSE
BEGIN
INTI:=TRUE;WRITELN(UF,'АННОТАЦИЯ');
END;
WRITELN(UF,'.18 1');WRITE(UF,'.11 3 ');SKIP;
END;
25:
BEGIN
WRITELN(UF,'.5');RAZD;
END;
26:
BEGIN
WRITELN(UF,'.10 0');READLN(NF);NST:=NST+1;
END;
17:
BEGIN
WRITELN(UF,'.5');WRITE(UF,'.10 3 '); SKIP;WRITELN(UF,'УТВЕРЖДЕН');
WRITELN(UF); FOR I:=1 TO SBTL DO WRITE(UF,SBT[I]);
WRITELN(UF,'-ЛУ');WRITELN(UF,'.21 14');
WRITELN(UF,'ПРОГРАММНОЕ ОБЕСПЕЧЕНИЕ СМ ЭВМ');
WRITELN(UF,'ОПЕРАЦИОННАЯ СИСТЕМА С РАЗДЕЛЕНИЕМ ФУНКЦИЙ');WRITELN(UF);
WRITELN(UF,'Р А Ф О С');WRITELN(UF);
SKIP;SKIP;SKIP;SKIP;SKIP;WRITELN(UF);
FOR I:=1 TO SBTL DO WRITE(UF,SBT[SBTL]);WRITELN(UF);
WRITELN(UF,'.22 4');SKIP;WRITELN(UF,'.3 0');WRITELN(UF,'ЛИТЕРА');
WRITELN(UF,'.10 0');WRITELN(UF,'ПЕРВ.ПРИМЕН.');SKIP;WRITELN(UF,'.5');
END;
9:
BEGIN
PUTD(TAB[K].CO);SBTL:=0;
WHILE NOT EOLN(NF) DO
BEGIN
SBTL:=SBTL+1;READ(NF,SBT[SBTL]);
END;
FOR I:=1 TO SBTL DO WRITE(UF,SBT[I]);
SKIP;
END;
16:
BEGIN
WRITELN(UF,'.5');SKIP;FOR I:=1 TO 15 DO SKIP;WRITELN(UF,'.5');
END;
END;
END;
END;
GOTO 101;
100:
WRITELN('?Z64-W-НЕДОПУСТИМАЯ ДИРЕКТИВА. СТРОКА:',NST:4);
101:
BEGIN
END;
END;
110:
WRITEZV(72);WRITELN;
CLOSE(UF);CLOSE(NF);
END.