Скачиваний:
17
Добавлен:
08.01.2014
Размер:
1.4 Кб
Скачать
uses linux,stdio;

const
TIMEOUT=5; (* ЧТЕНС Ч УЕЛХОДБИ *)
MAXTRIES=5; (* ЮЙУМП РПРЩФПЛ *)
LINESIZE=100; (* ДМЙОБ УФТПЛЙ *)
CTRL_G=#7; (* ASCII УЙНЧПМ ЪЧХЛПЧПЗП УЙЗОБМБ *)

var
(* жМБЗ, ПРТЕДЕМСАЭЙК, ЙУФЕЛМП МЙ ЪБДБООПЕ ЧТЕНС *)
timed_out:boolean;
(* рЕТЕНЕООБС, ЛПФПТБС ВХДЕФ УПДЕТЦБФШ ЧЧЕДЕООХА УФТПЛХ *)
answer:array [0..LINESIZE-1] of char;

(* чЩРПМОСЕФУС РТЙ РПМХЮЕОЙЙ УЙЗОБМБ SIGALRM *)
procedure catch (sig:integer);cdecl;
begin
(* хУФБОПЧЙФШ ЖМБЗ timed_out *)
timed_out := TRUE;
(* рПДБФШ ЪЧХЛПЧПК УЙЗОБМ *)
write(CTRL_G);
end;


function quickreply(prompt:pchar):pchar;
var
ntries:integer;
act, oact:sigactionrec;
begin
(* рЕТЕИЧБФЙФШ УЙЗОБМ SIGALRM Й УПИТБОЙФШ УФБТЩК ПВТБВПФЮЙЛ *)
act.handler.sh := @catch;
sigaction (SIGALRM, @act, @oact);
for ntries:=1 to MAXTRIES do
begin
timed_out := FALSE;
writeln;
write(prompt, ' > ');
(* хУФБОПЧЙФШ ФБКНЕТ *)
alarm (TIMEOUT);
(* рПМХЮЙФШ ЧЧЕДЕООХА УФТПЛХ *)
gets (answer);
(* чЩЛМАЮЙФШ ФБКНЕТ *)
alarm (0);
(* еУМЙ ЖМБЗ timed_out ТБЧЕО TRUE, ЪБЧЕТЫЙФШ ТБВПФХ *)
if not timed_out then
break;
end;
(* чПУУФБОПЧЙФШ УФБТЩК ПВТБВПФЮЙЛ *)
sigaction (SIGALRM, @oact, nil);
(* чЕТОХФШ УППФЧЕФУФЧХАЭЕЕ ЪОБЮЕОЙЕ *)
if ntries = MAXTRIES then
quickreply:=nil
else quickreply:=answer;
end;


begin
writeln;
writeln(quickreply ('Reply'));
end.
Соседние файлы в папке 6