Радио-86РК/Радио 10,11-90/PK плюс PC/Таблица 7
|
Данный материал защищён авторскими правами!
Использование материала заявлено как добросовестное, исключительно для образовательных некоммерческих целей. Автор: А. ДОЛГИЙ |
Таблица 7.
program rk_plus_pc;
const HIMEM:lnteger=$75FF; (Верхняя граница области)
(пользователя в ОЗУ "Радио-86РК.)
EDBUF:integer=$1900; ( Начальный адрес буфера текста)
(редактора ED.МИКРОН.)
var В,COUT,L,H,N,D1,D2,D3,D4:byte;
А0,ADR,ADRBEG,ADREND,ER,I,I1,J,J1,CCTR:Integer;
LCTR,LC,SL,SH,CSUM:Integer;
LINE,SNAME:string[64];
С,C1,C2:char;
INTD,ENDBLK:boolean;
T:text;
BUF:array[1.. $7600] of byte;
procedure HEXBYTE(B:byte);
function HEXCHAR(B:byte):char;
var B1: byte;
begin
B1:=B AND $F;IF B1>9 THEN B1:=B1+7;
HEXCHAR:=CHR(B1+48);
end;
begin
WRITE(HEXCHAR(B shr 4));
WRITE(HEXCHAR(B));
end;
procedure HEXINT(I:integer);
begin HEXBYTE(HI(I));
HEXBYTE(LO(I))
end;
function YES: boolean;
var C: char;
begin
WRITE(' (Д/Н) ? ');
repeat READ(KBD,C)
until С in ['Y', 'y', 'N', 'n', 'Д', 'д', 'H', 'н');
WRITELN(C);YES:=(C in ['Y', 'y','Д','д'));
end;
procedure START;
procedure INIT(K:byte);
(приводится описание процедуры настройки порта СОM1)
(ЕС-1640. Об изменениях в процедуре для компьютеров)
(других типов см. в тексте статьи. при выводе через)
(параллельный порт процедура INIT и ее вызов исключаются)
(из программы. )
const H1:real=2.16;
КЗ:real=6.61;
S9600:integer=8;
CTRL:lnteger=$3FC;
CW53:lnteger=$3FB;
CTR:integer=$3F8;
CW51:lnteger=$3F9;
DАТ51:integer=$3F8;
TMODE:byte=$36;
var S:integer;
begin
PORT[CTRL]:=$88;
PORT[CW33]:=TMODE;
S:=ROUND(S9600*(K*N1+N2));
PORT[CTR]:=LO(S);
PORT[CTR]:=HI(S);
PORT[CTRL]:=$48;
PORT[CTRL]:=8;
PORT[CW51]:=$OC;
PORT[CW51]:=0;
PORT[CW51]:=0;
PORT[CW51]:=$27;
end;
begin
WIHDOW(1,18,80,25);GOTOXY(13,1);
WRITE('Подготовьте магнитофон к записи ');
WRITELN('и нажмите любую клавишу. ');
repeat until keypressed;
INIT($1D); ( Только для последоват. интерфейса. )
WRITE(' Идет запись... ');
end;
procedure OUTMAG(B:byte);
(Процедура OUTMAG должна соответствовать используемому)
(интерфейсу (см. табл.1 и 2 в тексте статьи). приводится)
(описание процедуры вывода байта через последовательный)
(порт СОM1 ЕС-1840. )
const phm: array[0.. 15] of integer;
($55,$99,$65,$А5,$59,$99,$69,$А9,
$56,$96,$65,$А6,$5А,$9А,$6А,$АА);
procedure SEND(C:byte);
const CW51:lnteger=$3F9;
DAT5l:lnteger=$3F8;
begin
repeat until(PORT[CW51] and 1)<>0;
PORT[DAT51]:=C;
end;
begin
SEND(PHM[(B shr 4) and $0F]);
SEND(PHM[B and $0F]);
end;
procedure QRX:
begin
WINDOW(1,18,80,25);CLRSCR:GOTOXV(35,3);
WRITELN('Ждитe, читаю ',SNAME);
end;
procedure LDBUF(C:char: var I,CCTR,CSUM:integer);
const LINELEN:integer=62; ( Максимальная длина строки )
( редактора ED. МИКРОН)
var В:byte;
begin
B:=ORD(C);
repeat
BUF[I]:=B;CSUM:=CSUM+B;I:=I+1;
If B=$0D then CCTR:=0 else CCTR:=CCTR+1;
B:=$0D;
until CCTR<LINELEN;
end;
function TRANSTEXT (C:char;D1,D2,D3,D4:byte):char;
var J:byte;
begin
J:=POS(C,'@ABCDEFGHIJKLMHOPQRSTUVWXYZ[\1');
If J<>0 then TRANSTEXT:=CHR(J+D1)
else begin
J:=POS(C,'•abcdefghljklmnopqrstuvwxyz{|}" ');
If J<>0 then TRANSTEXT:=CHR(J+D2)
else begin
J:=POS(C,'юабпдефгхийклмнопярстужвьызшэшчь');
If J<>0 then TRANSTEXT:=CHR(J+D3)
else begin
J:=POS(C,'ЮАБЦДЕФГХИИКЛ1ШОПЯРСТУЖВЬЫЭЖЭШЧЪ');
If J<>0 then TRANSTEXT:=CHR(J+D4)
else TRANSTEXT:='_'
end
end
end
end;
procedure TRANSDUMP;
begin
саse J1 of
1:A0:=M;
2,3:A0:=(A0 shl 4)+H;
4:begin
A0:=(A0 shl 4)+H;
If I=5 then begin
ADR:=А0; ADRBEG:=А0:
BUF[1]:=HI(ADRBEG);BUF12):=LO(ADRBEG)
end else If ADR<>A0 then begin
ENDBLK:=true; ADREND:=ADR-1; I1:=I-1
end;
end:
5..255:if not ODD(J1) then begin
BUF[I]:=(N shl 4)+M;I:=I+1;ADR:=ADR+1;
end else N:=M;
end
end:
procedure TRANSHEX;
begin
case J1 of
1:L:=M;
2:L:=(L shl 4)+H;
3:A0:=M;
4,5: А0:=(А0 shl 4)+M;
6:begin
A0:=(А0 shl 4)+M;
if I=5 then begin
ADR:=A0;ADRBEG:=A0;
BUF[1]:=HI(ADRBEG);BUF[2]:=LO(ADRBEG)
end else if ADR<>A0 then begin
ENDBLK:=true:ADREND:=ADR-1: I1:=I-1
end;
end;
7,8:;
9..255:if not ODD(J1) then begin
if L>0 then begin
BUF[I]:=(N shl 4>+M;I:=I+1;ADR:=ADR+1:L:=L-1
end
end else N:=M;
end
end:
procedure OUTBLOCK;
begin
CLRSCR;WIHDOW(41,11,80,17);CLRSCR;
WRITELN;WRITELN;
WRITE(' Начало блока : ') ;HEXINT(ADRBEG);
WRITELN;
WRITE(' Конец блока : ');HEXINT(ADREND);
WRITELN;
WRITE (' контр, сумма : ');
SL:=0;SH:=0;
for I:=5 to I1-1 do begin
SL:=SL+BUF[I]; SH:=SH+BUF[I]+HI(SL); SL:=LO(SL)
end;
SL:=LO(SL+BUF[I1]):BUF[I1+1]:=0;BUF[I1+2]:=0;
BUF[I1+3]:=$E0:BUF[I1+4]:=LO(SH);BUF[I1+5]:=LO(SL)
HEXBYTE(LO(SH)):HEXBYTE(LO(SL));WRITELN;
START:
(Если используется параллельный интерфейс и необходимо)
(во время записи на магнитофон запретить прерывания,)
(здесь вставить оператор INLINE(*FA): )
for I:=1 to 256 do OUTMAG(0);
OUTMAG($E6);
for I:=1 to I1+5 do OUTMAG(BUF[I]);
( Если прерывания были запрещены, здесь разрешить их )
( вновь, вставив оператор INLINE($FB); )
WRITE(' готово, повторить ')
end;
function NEXTBLOCK:boolean;
begin
If EOF(T) or (ER>0) then NEXTBLOCK:=false
else begin
CLKSCR;GOTOXY(6,3);
WRITE('В Файле ',SNAME.' имеются еше данные.',
' продолжить вывод ');NEXTBLOCK:=YES
end
end;
begin
CLRSCR;WINDOW(5,1,80,10);
WRITELN(' r-ASD-90--------------------------------------------------|');
WRITELN(' I');
WRITELN('| Запись данных на магнитофон',
' в Формате РАДИО-86РК |');
WRITELN('|');
WRITELN('------------------•------', '----------------------');
WRITELN;
WRITE('Имя Файла, содержашего данные : ');
READLN(SNAME);ASSIGN(T,SNAME);RESET(Т);INTD:=false;
WINDOW(1,11,80,25);
WRITELN(' Тип данных :');
WRITELN;
WRITELN(' Текст. ................. 1');
WRITELN(' Таблица кодов (dump).... 2');
WRITELN(' НЕХ-ФаИЛ. .............. 3');
WINDOW(1,18,80,25);CLRSCR;
WRITELN(' Введите цифру, соответствующую');
WRITE(' типу данных в Файле ',SNAME);
repeat READ(KBD,C) until С in ['1','2','3'];
CLRSCR;WIHDOW(34,0RD(C)-36,35,23);WRITE '+');
саsе С of
'1':begin
ER:=0;WINDOW(41,11,80,17);CLRSCR;
WRITELN(' Преобразование текста :');
WRITELN;
WRITELN(' ABCdef АБВгде в ABCDEF АБВГДЕ. . . . 1');
WRITELN(' ABCdef АБВгде в АВСДЕФ АБВГДЕ. . . . 2');
WRITELN(' ABCdef АБВгде в ABCdef abwGDE. . . . 3');
WRITELN(' ABCdef АБВгде в абцДЕФ АБВгде. . . . 4');
WINDOW(1,18,80,25);
WRITE('Введите цифру, соответствуютщую ');
WRITE(' нужному преобразованию. ');
repeat READ(KBD,C1) until C1 in ['1'..'4');
CLRSCR;WINDOW(79,ORD(C1)-36,80,23);WRITE ('+');
case C1 of
'1':begin D1:=$3F;D2:=$3F;D3:=$5F;D4:=$5F end;
'2':begin D1:=$3F;D2:=$5F;D3:=$5F;D4:=$5F end;
'3':begin D1:=$3F;D2:=$5F:D3:=$3F;D4:=$5F end;
'4':begin D1:=$5F;D2:=$3F;D3:=$5F;D4:=$3F end;
end;
repeat
QRX;I:=3;CCTR:=0;CSUM:=0;
while not(EOF(T)or(I>HIMEM-EDBUF-*FF)) do
begin
READ(T,C);B:=ORD(C);
case В of
$00..$08, $0B,$0C,$0E..$1F:
LDBUF('.',I,CCTR,CSUM);
$09:
repeat LDBUF(' ',I,CCTR,CSUM)
until (CCTR mod 8)=0;
$0A:;
$0D,$20..$3F:
LDBUF(C,I,CCTR,CSUM);
else
LDBUF(TRANSTEXT(C,D1,D2,D3,D4),I,CCTR,CSUM);
end;
end:
LDBUF(#$0D,I,CCTR,CSUM); BUF[I]:=$FF;
BUF[I+1]:=LO(CSUM);BUF[I+2]:=HI(CSUM);
I1:=I+2;I:=2-I;BUF[1]:=LO(I); BUF[2]:=HI(I);
repeat
CLRSCR;START;
(Ecли используется параллельный интерфейс и необхо-)
(димо во время записи на магнитофон запретить прерывания,)
(здесь вставить оператор INLINE(*FA); )
for I:=1 to 64 do OUTMAG($55);
for I:=1 to 64 do OUTMAG(0);
for I:=1 to 64 do OUTHAG($55);
for I:=1 to 64 do OUTMAG(0);
for I:=1 to 5 do OUTMAG($E6);
for I:=1 to LENGTH(SNAME) do OUTMAG(ORD(SNAME[I]) and $7F);
for I:=1 to 512 do OUTMAG(0); OUTMAG($E6);
for I:=1 to I1 do OUTMAG(BUF[I]);
(Если прерывания были запрещены, здесь разрешить их )
(вновь, вставив оператор INLINE(*FB); )
WRITE(' готово. Повторить ');
until not YES;
until not NEXTBLOCK:
end;
'2','3':begin
LCTR:=0;
repeat
ER:=0;ENDBLK:=false;I:=5;QRX;
while not(EOF(T) or (I>HIMEM+4) or ENDBLK) do
begin
READLN(T,LINE); LCTR:=LCTR+1;
J1:=1;
for J:=1 to LENGTH(LINE) do begin
C2:=LINE[J]:
саse C2 of
' ':;
':':if C='2' then ER:=ER+1;
'0'..'9','A'..'F':begin
M:=ORD(C2)-$30;if M>9 then M:=M-7;
If C='2' then TRANSDUMP else TRANSHEX;
J1:=J1+1
end else ER:=ER+1;
end
end
end;
if ER=0 then begin
If not ENDBLK then begin
ADREND:=ADR-1;I1:=I-1
end;
BUF[3]:=HI(ADREND);BUF[4]:=LO(ADREND);
repeat OUTBLOCK until not YES;
end else begin
WINDOW(1,20,80,25);CLRSCR;GOTOXY(20, 3);
WRITE(' исправьте ошибк');
if ER=1 then WRITE('у') else WRITE('и');
WRITE(' в Файле ',SNAME);
end;
if ENDBLK and (POS(':00',LINE)=0) then begin
RESET (T);LC:=LCTR;
while LC>1 do begin READLN(T);LC:=LC-1 end;
end:
until not NEXTBLOCK;
end;
end;
end.