12.6.5. Интернационализация

Многие версии ОС UNIX могут поддерживать различные национальные среды – позволяют учитывать языковые среды, менять порядок сортировки строк, задавать символы денежных единиц, форматы чисел и т.д. Попробуйте найти процедуры setlocale или catopen. Справочное руководство системы может содержать дополнительные сведения по этой теме под заголовком environ.

12.6.6. Математические функции

ОС UNIX предоставляет обширную библиотеку математических функций для программирования научных и технических приложений. Для применения некоторых из этих функций необходимо подключать файл math, который включает определения функций, некоторых важных констант (таких как е или π) и структур, относящихся к обработке ошибок. Для использования большинства функций, которых коснемся ниже, потребуется также подключить математическую библиотеку:

uses math;

12.6.7. Работа с портами ввода вывода

ОС UNIX предоставляет набор низкоуровневых функций для чтения и записи в порты ввода-вывода:

IOperm	Устанавливает права для доступа к порту
ReadPort	Читает данные и порта
ReadPortB	Читает 1 байт из порта
ReadPortL	Читает 4 байта из порта
ReadPortW	Читает 2 байта из порта
WritePort	Пишет данные в порт
WritePortB	Пишет 1 байт в порт
WritePortL	Пишет 4 байта в порт
WritePortW	Пишет 4 байта в порт

Глава 13. Задачи с решениями

13.1. Введение

В последней главе будут рассмотрены несколько блоков задач, которые соответствуют тематике всех предыдущих глав, с примерами решения.

13.2. Обработка текста

Упражнение 13.1. Напишите программу, отсекающую n пробелов в начале каждой строки (или n первых любых символов). Учтите, что в файле могут быть строки короче n (например, пустые строки).

Program Tabs;

uses sysutils,linux;

var

f1,f2:Text;

TmpS:string;

n,Code:Integer;

begin

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

if ParamCount=3 then val(ParamStr(3),n,Code)

else n:=0;

While Not(eof(f1)) do

begin

Readln(f1,TmpS);

Writeln(f2,Copy(TmpS,n,Ord(TmpS[0])-n));

end;

Close(f1);

Close(f2);

end.

Упражнение 13.2. Составьте программу, центрирующую строки файла относительно середины экрана, т.е. добавляющую в начало строки такое количество пробелов, чтобы середина строки печаталась в 40-ой позиции (считаем, что обычный экран имеет ширину 80 символов).

Program Center;

uses crt;

var

s:string;

f:text;

procedure writecenter(s:string);

begin

if ord(s[0])<80 then

begin

GotoXY(wherex+(80-ord(s[0]))div 2,wherey);

writeln(s);

end

else writeln(s);

end;

begin

if paramcount<1 then

begin

Writeln('error');

Halt(1);

end;

Assign(f,paramstr(1));

Reset(f);

While not(eof(f)) do

begin

Readln(f,s);

writecenter(s);

end;

Close(f);

end.

Упражнение 13.3. Напишите программу, переносящую слишком длинные строки. Слова разбивать нельзя (неумещающееся слово следует перенести целиком). Ширину строки считать равной 60.

Program Tabs;

var

f1,f2:Text;

TmpS,StrBuf:string;

n,Code:Integer;

const

step=60;

begin

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

StrBuf:='';

While Not(eof(f1)) do

begin

Readln(f1,TmpS);

TmpS:=StrBuf+TmpS;

n:=step;

if ord(Tmps[0])>step then

begin

While (not(TmpS[n]in [' ',',','(',')',';','.']))do if n>=1 then Dec(n) else Exit;

While (TmpS[n]in [' ',',','(',')',';','.'])do if n>=1 then Dec(n) else Exit;;

if n<1 then n:=Pos(',',TmpS);

Writeln(f2,Copy(TmpS,1,n));

StrBuf:=Copy(TmpS,n+1,Ord(TmpS[0])-n);

while Ord(strbuf[0])>step do

begin

if Pos(',',Strbuf)>Pos(' ',StrBuf) then

begin

Writeln(f2,Copy(StrBuf,1,Pos(',',StrBuf)));

Delete(StrBuf,1,Pos(',',StrBuf));

end

else

begin

Writeln(f2,Copy(StrBuf,1,Pos(' ',StrBuf)));

Delete(StrBuf,1,Pos(' ',StrBuf));

end

end;

end

else Writeln(f2,TmpS);

end;

Close(f1);

Close(f2);

end.

Упражнение 13.4. Напишите программу, разбивающую файл на два по вертикали: в первый файл попадает левая половина исходного файла, во второй – правая. Ширину колонки задавайте из аргументов командной строки. Если же аргумент не указан – 40 позиций.

Program InTwo;

var

f1,f2,f:Text;

WidthCol:Byte;

Code:Integer;

s:string;

begin

if ParamCount<3 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./2 <file1> <file2> <file3> n');

Writeln('<file1> - input file');

Writeln('<file2> - first output file');

Writeln('<file3> - first output file');

Writeln('n - number of column in first file');

Halt(1);

end;

if ParamCount<4 then WidthCol:=40

else Val(Paramstr(4),WidthCol,Code);

assign(f,ParamStr(1));

reset(f);

assign(f1,ParamStr(2));

rewrite(f1);

assign(f2,ParamStr(3));

rewrite(f2);

While Not(Eof(f)) do

begin

Readln(f,s);

if Ord(s[0])>WidthCol then

begin

Writeln(f1,Copy(s,1,WidthCol));

Writeln(f2,Copy(s,WidthCol+1,Ord(s[0])-WidthCol));

end

else

begin

Writeln(f1,s);

Writeln(f2);

end;

end;

close(f2);

close(f1);

close(f);

end.

Упражнение 13.5. Напишите функцию, сжимающую подряд идущие пробелы в табуляции.

Program Tabs;

var

f1,f2:Text;

sin,sou:string;

i:Byte;

CheckSpaces:Boolean;

SetTab:Boolean;

begin

if ParamCount<2 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./task <inputfile> <outputfile>');

Halt(1);

end;

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

While Not(eof(f1)) do

begin

Readln(f1,sin);

CheckSpaces:=False;

SetTab:=False;

sou:='';

For i:=1 to Ord(sin[0]) do

if (sin[i]=' ')and(not CheckSpaces) then begin CheckSpaces:=True;sou:=sou+' ';end

else if not(sin[i]=' ')then begin sou:=sou+sin[i]; CheckSpaces:= False;SetTab:=False;end

else if (sin[i]=' ')and(CheckSpaces)and(not SetTab) then begin sou[ord(sou[0])]:=#9;SetTab:=True;end

else if (not (sin[i]=' '))and(CheckSpaces)and (SetTab) then

begin

sou:=sou+sin[i];

SetTab:=False;

end;

Writeln(f2,sou);

end;

Close(f1);

Close(f2);

end.

Упражнение 13.6. Напишите программу сортировки строк в алфавитном порядке.

uses strings;

type

achar=array [0..255] of char;

mas=array [1..1] of achar;

var s:achar;

t:text;

a:^mas;

n,i,j,k:byte;

begin

if ParamCount<>2 then

begin

Writeln('Error!!!');

Writeln('Format: ./task <sourcefile> <destfile>');

Halt(1);

end;

s:=ParamStr(1);

assign(t,s);

reset(t);

k:=0;

while not eof(t) do

begin

readln(t,s);

inc(k)

end;

getmem(a,k*256);

close(t);

reset(t);

for i:=1 to k do

readln(t,a^[i]);

close(t);

for i:=1 to k-1 do

begin

for j:=i+1 to k do

if stricomp(a^[i],a^[j])>0 then

begin

strcopy(s,a^[j]);

strcopy(a^[j],a^[i]);

strcopy(a^[i],s);

end;

end;

s:=ParamStr(2);

assign(t,s);

rewrite(t);

for i:=1 to k do

writeln(t,a^[i]);

freemem(a,k*256);

close(t);

end.

Упражнение 13.7. Напишите функцию, расширяющую табуляции в подряд идущие пробелы.

Program TabsProg;

function Tabs(s:String):String;

begin

While (Pos(#9,s)>0) do

s:=Copy(s,1,Pos(#9,s)-1)+' '+Copy(s,Pos(#9,s)+1,Ord(s[0])-Pos(#9,s));

Tabs:=s;

end;

var

f1,f2:Text;

sin:string;

begin

if ParamCount<2 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./task <inputfile> <outputfile>');

Halt(1);

end;

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

While Not(eof(f1)) do

begin

Readln(f1,sin);

Writeln(f2,Tabs(sin));

end;

Close(f1);

Close(f2);

end.

Упражнение 13.8. Составьте программу, укорачивающую строки исходного файла до заданной величины и помещающую результат в указанный файл.

Program Tabs;

var

f1,f2:Text;

TmpS:string;

n,Code:Integer;

begin

if ParamCount<2 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./task <inputfile> <outputfile> <column>');

Writeln('<column> - number of column');

Halt(1);

end;

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

if ParamCount=3 then val(ParamStr(3),n,Code)

else n:=40;

While Not(eof(f1)) do

begin

Readln(f1,TmpS);

Writeln(f2,Copy(TmpS,1,n));

end;

Close(f1);

Close(f2);

end.

Упражнение 13.9. Разработайте программу, укорачивающую строки входного файла до 60 символов без обрубания слов.

Program Tabs;

var

f1,f2:Text;

TmpS,StrBuf:string;

n,Code:Integer;

const

step=60;

begin

if ParamCount<2 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./task <inputfile> <outputfile>');

Halt(1);

end;

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

StrBuf:='';

While Not(eof(f1)) do

begin

Readln(f1,TmpS);

TmpS:=StrBuf+TmpS;

n:=step;

if ord(Tmps[0])>step then

begin

While (not(TmpS[n]in [' ',',','(',')',';','.']))do if n>=1 then Dec(n) else Exit;

While (TmpS[n]in [' ',',','(',')',';','.'])do if n>=1 then Dec(n) else Exit;;

if n<1 then n:=Pos(',',TmpS);

Writeln(f2,Copy(TmpS,1,n));

StrBuf:=Copy(TmpS,n+1,Ord(TmpS[0])-n);

while Ord(strbuf[0])>step do

begin

if Pos(',',Strbuf)>Pos(' ',StrBuf) then

begin

Writeln(f2,Copy(StrBuf,1,Pos(',',StrBuf)));

Delete(StrBuf,1,Pos(',',StrBuf));

end

else

begin

Writeln(f2,Copy(StrBuf,1,Pos(' ',StrBuf)));

Delete(StrBuf,1,Pos(' ',StrBuf));

end

end;

end

else Writeln(f2,TmpS);

end;

Close(f1);

Close(f2);

end.

Упражнение 13.10. Разработайте программу, заполняющую промежутки между словами строки дополнительными пробелами таким образом, чтобы длина строки была равна 60 символам.

Program Tabs;

var

f1,f2:Text;

sin:string;

i:Byte;

CheckSpaces:Boolean;

SetTab:Boolean;

begin

if ParamCount<2 then

begin

Writeln('Wrong parameters');

Writeln('Format: ./task <inputfile> <outputfile>');

Halt(1);

end;

Assign(f1,Paramstr(1));

Assign(f2,Paramstr(2));

Reset(f1);

Rewrite(f2);

While Not(eof(f1)) do

begin

Readln(f1,sin);

i:=1;

While (ord(sin[0])<60) do

begin

if Pos(' ',sin)=0 then sin:=' '+sin+' ';

if sin[i]=' ' then

begin

sin:=copy(sin,1,i)+' '+copy(sin,i+1,ord (sin[0])-i);

Inc(i);

end;

Inc(i);

if i>Ord(sin[0]) then i:=1;

end;

Writeln(sin);

Writeln(f2,sin);

end;

Close(f1);

Close(f2);

end.

Упражнение 13.11. Отсортируйте массив строк по лексикографическому убыванию, игнорируя различия между строчными и прописными буквами.

uses strings;

type

achar=array [0..255] of char;

mas=array [1..1] of achar;

var s:achar;

t:text;

a:^mas;

n,i,j,k:byte;

begin

s:='SRT4.txt';

assign(t,s);

reset(t);

k:=0;

while not eof(t) do

begin

readln(t,s);

inc(k)

end;

getmem(a,k*256);

close(t);

reset(t);

for i:=1 to k do

readln(t,a^[i]);

close(t);

for i:=1 to k-1 do

begin

for j:=i+1 to k do

if stricomp(a^[j],a^[i])>0 then

begin

strcopy(s,a^[j]);

strcopy(a^[j],a^[i]);

strcopy(a^[i],s);

end;

end;

for i:=1 to k do

writeln(a^[i]);

freemem(a,k*256);

end.

Упражнение 13.12. Простейший строковый редактор. Программа вызывается «tsed s/old/new/ имя_файла», читая указанный текстовый файл и сканируя каждую строку на первое вхождение подстроки old. При совпадении выполняется замена old на new. Отредактированная строка пишется на стандартный вывод.

var

s,myold,mynew,s1:string;

n,l:byte;

t:text;

begin

if paramcount<>2 then begin

writeln('tsed s/old/new/ имя_файла');

exit

end;

s:=paramstr(1);

delete(s,1,2);

n:=pos('/',s);

myold:=copy(s,1,n-1);

l:=length(myold);

delete(s,1,n);

n:=pos('/',s);

mynew:=copy(s,1,n-1);

s:=paramstr(2);

assign(t,s);

reset(t);

while not eof(t) do

begin

n:=0;

readln(t,s);

n:=pos(myold,s);

if n<>0 then

begin

s1:=copy(s,1,n-1)+mynew+copy(s,n+l,length(s));

writeln(s1);

end else writeln(s);

end;

close(t);

end.

Упражнение 13.13. Составьте аналог команды cut.

var

s:string;

n:byte;

er:integer;

t:text;

begin

if paramcount<>2 then begin

writeln('mycut n имя_файла');

exit

end;

s:=paramstr(1);

val(s,n,er);

if er<>0 then begin

writeln('error n ');

exit

end;

s:=paramstr(2);

assign(t,s);

reset(t);

while not eof(t) do

begin

readln(t,s);

if n>length(s) then writeln('')

else begin

s:=copy(s,n,length(s));

writeln(s);

end;

end;

close(t);

end.

Упражнение 13.14. Напишем функцию, которая преобразует строку так, что при ее печати буквы в ней будут подчеркнуты, а цифры – выделены жирно.

function isdigit(c:char):boolean;

begin

isdigit:=c in ['0'..'9'];

end;

function isalpha(c:char):boolean;

begin

isalpha:=(c in ['a'..'z']) or (c in ['A'..'Z']) or (c in ['а'..'я']) or (c in ['А'..'Я']);

end;

function convertor(s:string):string;

var

i:integer;

const

res:string='';

begin

for i:=1 to byte(s[0]) do

if isdigit(s[i]) then

res:=res+s[i]+#8+s[i]

else

if isalpha(s[i]) then

res:=res+s[i]+#8+'_'

else

res:=res+s[i];

convertor:=res;

end;

begin

writeln(convertor('11 сентября 2001 г. - национальный праздник Афганистана (до 2003 г.)'));

end.

Упражнение 13.15. Составьте функцию expand(s1, s2), которая расширяет сокращенные обозначения вида a-z строки s1 в эквивалентный полный список abcd...xyz в строке s2. Допускаются сокращения для строчных и прописных букв и цифр. Учтите случаи типа a-b-c, a-z0-9 и -a-g (соглашение состоит в том, что символ "-", стоящий в начале или в конце, воспринимается буквально).

program demoexpand;

function ex(s1:string; var s2:string):boolean;

var

i:byte;

begin

s2:='';

if (((((s1[1]>='0')and(s1[1]<='9'))and((s1[3]>='0')and(s1[3]<='9')))

or (((s1[1]>='A')and(s1[1]<='Z'))and((s1[3]>='A')and(s1[3]<='Z')))

or (((s1[1]>='a')and(s1[1]<='z'))and((s1[3]>='a')and(s1[3]<='z')))))

and (s1[1]<=s1[3])or(s1[1]='-')

then

begin

for i:=Ord(s1[1]) to Ord(s1[3]) do

s2:=s2+Chr(i);

if s1[1]='-'then delete(s[1],1,1);

ex:=true;

end

else ex:=false;

end;

function expand(s1:string; var s2:string):boolean;

var

i:Byte;

tmpstr:String;

begin

s2:=s1;

while (pos('-',s2)>0) do

if (pos('-',s2)>1)and(pos('-',s2)<Ord(s2[0])) then

begin

if ex(copy(s2,pos('-',s2)-1,3),tmpstr) then

s2:=Copy(s2,1,pos('-',s2)-2)+tmpstr+Copy(s2,pos('-',s2)+2,Ord(s2[0])-(pos('-',s2)+2))

else s2[pos('-',s2)]:='~';

end

else s2[pos('-',s2)]:='~';

While (pos('~',s2)>0) do s2[pos('~',s2)]:='-';

end;

var

m,n:string;

begin

repeat

Readln(m);

if ex(m,n) then expand(m,n);

if m='exit' then exit;

if expand(m,m) then writeln(m)

else writeln('Error');

Until False;

end.

Упражнение 13.16. Составьте программу преобразования прописных букв из файла ввода в строчные, используя при этом функцию, в которой необходимо организовать анализ символа (действительно ли это буква). Строчные буквы выдавать без изменения.

Program demoupcase;

function ischar(c:char):boolean;

begin

if c in ['a'..'z'] then ischar:=true

else ischar:=false;

end;

function upcase(s:string):string;

var

i:Byte;

tmp:string;

begin

tmp:=s;

for i:=1 to ord(tmp[0]) do

if ischar(tmp[i]) then tmp[i]:=Chr(ord(tmp[i])-Ord('a')+Ord('A'));

upcase:=tmp;

end;

begin

writeln(upcase('abcderfFFF123***'));

readln;

end.

Упражнение 13.17. Составьте программу, распечатывающая слова в строках файла в обратном порядке.

program reverse;

var

F1,F2:Text;

tmpstr:string;

function revstr(s:string):string;

var

tmp:string;

begin

tmp:='';

while (pos(' ',s)>0) do

begin

tmp:=' '+copy(s,1,pos(' ',s)-1)+tmp;

delete(s,1,pos(' ',s));

end;

tmp:=s+tmp;

revstr:=tmp;

end;

begin

if paramcount<2 then

begin

writeln('Error: wrong arguments');

writeln('format: 10 <fileinp> <fileout>');

Halt(1);

end;

Assign(F1,paramstr(1));

Reset(F1);

Assign(F2,paramstr(2));

Rewrite(F2);

while not(eof(F1)) do

begin

readln(F1,tmpstr);

writeln(F2,revstr(tmpstr));

end;

close(F2);

close(F1);

end.

Упражнение 13.18. Составьте программу, преобразующую текст, состоящий только из строчных букв в текст, состоящий из прописных и строчных букв. Первая буква и буква после каждой точки – прописные, остальные – строчные.

program check_gram;

var

F1,F2:text;

Temp:string;

Dot:boolean;

i:byte;

begin

Dot:=true;

if paramcount<>2 then halt(1);

assign(F1,paramstr(1));

reset(F1);

assign(F2,paramstr(2));

rewrite(F2);

while not(eof(F1)) do

begin

readln(F1,Temp);

for i:=1 to ord(Temp[0]) do

begin

if (Temp[i] in ['A'..'Z','a'..'z'])and Dot then

begin

Dot:=false;

if Temp[i] in ['a'..'z'] then Temp[i]:=chr(ord(Temp[i])-ord('a')+ord('A'))

end

else if (Temp[i] in ['.','!','?']) then Dot:=true

end;

writeln(F2,Temp);

end;

close(F2);

close(F1);

end.

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

program sortedlist;

type

TRec = record

wrd:string[40];

num:word;

end;

var

List:array [1..1400] of TRec;

F:text;

stroka:string;

nump:byte;

i,j:word;

max:word;

Temp:TRec;

procedure checkadd(sm:string);

var

x:word;

T:boolean;

begin

T:=true;

if nump>0 then

for x:=1 to nump do

if List[x].wrd=sm then

begin

T:=false;

inc(List[x].num);

end;

if T then

begin

inc(nump);

List[nump].wrd:=sm;

List[nump].num:=1;

end;

end;

function add(s:string):boolean;

var

m:byte;

tmp:string;

begin

if s<>'' then

begin

tmp:=s;

for m:=1 to ord(tmp[0]) do

if not (tmp[m] in ['A'..'Z','a'..'z','0'..'9']) then tmp[m]:=' ';

while (pos(' ',tmp)>0) do

begin

if (pos(' ',tmp)>1) then checkadd(copy(tmp,1,pos(' ',tmp)-1));

delete(tmp,1,pos(' ',tmp));

end;

if (pos(' ',tmp)=0)and(ord(tmp[0])>0) then checkadd(tmp);

end;

add:=true;

end;

begin

nump:=0;

writeln('-------------------');

if paramcount<1 then halt(1);

assign(F,paramstr(1));

reset(F);

while not(eof(F)) do

begin

readln(F,stroka);

add(stroka);

end;

close(F);

for j:=1 to nump-1 do

begin

max:=j;

for i:=j+1 to nump do

if List[i].num>List[max].num then max:=i;

Temp:=List[max];

List[max]:=List[j];

List[j]:=Temp;

end;

for i:=1 to nump do

write(List[i].wrd:11,' - ',List[i].num:4,' ');

writeln;

end.

Упражнение 13.20. Напишите программу копирования ввода на вывод таким образом, чтобы из каждой группы последовательно одинаковых строк выводилась только одна строка. Это аналог программы uniq в системе UNIX.

var

first,second:string;

begin

readln(first);

writeln(first);

while not eof(input) do

begin

readln(second);

if first<>second then

begin

writeln(second);

first:=second;

end;

end;

end.

Упражнение 13.21. Составьте аналог команды banner.

Uses Crt;

Type

TArrNum=Array[1..8] of Byte;

Const

stroki:Array [1..42]of string[6]=

(('******'),(' *****'),('***** '),('* '),(' * '),

(' * '),(' * '),(' * '),(' *'),('* *'),

(' * * '),(' ** '),(' '),(' **** '),('* **'),

('* * '),('* * '),('*** '),(' ***'),(' * '),

(' *** '),(' * *'),(' * * '),(' * '),('* * *'),

('** **'),('* ** *'),('** *'),('* * *'),(' ** '),

(' ** **'),(' ** '),('**** *'),(' **'),(' *** '),

('** '),('* ***'),('*** *'),('**** '),(' ** *'),

(' ****'),('* *** ')

);

bukvi:Array ['!'..'_'] of TArrNum=

(

(13,12,14,14,12,12,13,12), {!}

(26,26,11,13,13,13,13,13), {"}

(13,11,11,1,11,1,11,11), {#}

(6,14,10,18,19,10,14,6), {$}

(13,28,26,12,30,31,26,4), {%}

(21,16,17,32,32,25,16,34), {&}

(12,12,32,13,13,13,13,13), {'}

(13,7,6,5,5,5,6,7), {(}

(13,6,7,8,8,8,7,6), {)}

(13,13,11,12,1,12,11,13), {*}

(13,12,12,1,1,12,12,13), {+}

(13,13,13,13,13,12,12,32), {,}

(13,13,13,1,13,13,13,13), {-}

(13,13,13,13,13,13,13,9), {.}

(13,9,34,30,12,32,36,4), {/}

(13,14,15,37,27,38,28,14), {0}

(13,12,21,39,12,12,12,14), {1}

(13,14,26,30,12,6,39,1), {2}

(13,35,22,9,30,9,22,35), {3}

(13,24,12,11,3,7,7,35), {4}

(13,1,4,4,1,9,10,14), {5}

(13,35,5,4,3,10,10,14), {6}

(13,2,31,34,34,30,12,12), {7}

(13,14,10,10,14,10,10,14), {8}

(13,35,22,22,41,9,22,35), {9}

(13,13,12,12,13,12,12,13), {:}

(13,13,12,12,13,12,12,32), {;}

(13,30,12,32,36,32,12,30), {<}

(13,13,13,1,1,13,13,13), {=}

(13,32,12,30,34,30,12,32), {>}

(13,35,22,9,8,7,13,7), {?}

(13,14,27,26,28,42,4,3), {@}

(13,12,11,10,1,10,10,10), {A}

(13,3,10,10,3,10,10,3), {B}

(13,2,4,4,4,4,4,2), {C}

(13,3,10,10,10,10,10,3), {D}

(13,1,4,4,3,4,4,1), {E}

(13,1,4,4,3,4,4,4), {F}

(13,14,10,4,4,15,10,14), {G}

(13,10,10,10,1,10,10,10), {H}

(13,21,6,6,6,6,6,21), {I}

(13,19,20,20,20,16,16,21),{J}

(13,10,16,17,18,17,16,10), {K}

(13,4,4,4,4,4,10,1), {L}

(13,10,26,27,10,10,10,10), {M}

(13,10,28,29,25,30,10,10), {N}

(13,14,10,10,10,10,10,14), {O}

(13,3,10,10,3,4,4,4), {P}

(13,14,10,10,10,10,25,2), {Q}

(13,3,10,10,3,17,16,10), {R}

(13,14,10,5,12,8,10,14), {S}

(13,3,6,6,6,6,6,6), {T}

(13,10,10,10,10,10,10,14), {U}

(13,10,10,10,10,10,11,12), {V}

(13,10,10,10,10,27,27,11), {W}

(13,10,10,11,12,11,10,10), {X}

(13,22,22,22,23,24,24,24), {Y}

(13,1,8,7,6,5,4,1), {Z}

(13,21,5,5,5,5,5,21), {[}

(13,4,36,32,12,30,34,9), {\}

(13,35,8,8,8,8,8,35), {]}

(6,11,10,13,13,13,13,13),{^}

(13,13,13,13,13,13,13,1) {_}

);

procedure showchar(ch:Char);

var

i:Byte;

PosX,PosY:Byte;

begin

PosX:=WhereX;

PosY:=WhereY;

if ch<>' ' then

begin

For i:=1 to 8 do

begin

GotoXY(PosX,PosY+i);

Write(stroki[bukvi[ch][i]]);

end;

end

else GotoXY(PosX+8,PosY);

GotoXY(PosX+8,PosY);

end;

procedure showword(s:String);

var

i:Byte;

begin

For i:=1 to Ord(s[0]) do

begin

if WhereX>90 then GotoXY(1,WhereY+8);

showchar(upcase(s[i]));

end;

end;

var

j:Byte;

begin

clrscr;

if paramcount<1 then

begin

writeln('Incorrect argument');

halt(1);

end;

for j:=1 to paramcount do

showword(paramstr(j));

Readln;

end.

Упражнение 13.22. Напишите программу, печатающую файлы, переданные ей в качестве аргументов, останавливающуюся и ожидающую нажатия клавиши через каждые 20 строк.

uses crt,sysutils,linux;

var

f:text;p:string;i:integer;s:array [0..1000] of char;

BEGIN

clrscr;

writeln('Введите имя файла');

readln(s);

{$I-}

if not access(pchar(s),f_ok or r_ok) then

begin

writeln('Файл '+pchar(s)+' не существует или недоступен для чтения');

halt(1);

end;

assign(f,s);

reset(f);

clrscr;

while not eof(f) do

begin

for i:=1 to 20 do

begin

readln(f,p);

writeln(p);

if eof(f) then break;

end;

readkey;

end;

close(f);

END.

Упражнение 13.23. Составьте программу вывода строк файла в инверсном отображении, причем порядок символов в строках также следует инвертировать.

uses linux,sysutils ;

var f1,f2:text;

kol_strok,

i,j,k:longint;

s:string;

begin

if paramcount<>2 then

begin

writeln('Неправильные аргументы командной строки ',paramcount);

halt(1);

end;

assign(f1,paramstr(1));

assign(f2,paramstr(2));

reset(f1);

rewrite(f2);

kol_strok:=0;

while not eof(f1) do {Подсчет количества строк в файле}

begin

readln(f1);

inc(kol_strok);

end;

for i:=kol_strok downto 1 do

begin

reset(f1);

for j:=1 to i do {Установка на нужную строку и соответствнно ее считуем}

begin

readln(f1,s);

end;

for k:=length(s) downto 1 do {Запись посимвольно в файл начиная с конца строчки}

begin

write(f2,s[k]);

end;

writeln(f2);

end;

writeln(kol_strok);

close(f1);

close(f2);

end.