Паскаль (I семестр) / K02-172 / 08 / wordz_3

{$M 64000,0,600000}
program wordz3;
uses dos;
(*
(c) 2005 Dima Zolotukhin aka 'Zlogic' <zlogic@gmail.com>
Redistributable under GNU GPL license
*)
const
MAX_LENGTH = 100;
type
str_filename = string[79];
str_message = string[70];
str_word = string[MAX_LENGTH];
str1 = string[1];
pword = ^tword;
tword = record
data:str_word;
next:pword;
count:integer;
end;
type_time = record
h,m,s,s100:real;
end;

function get_string(m:str_message):str_filename;
var
temp_str:str_filename;
begin
write(m,'> ');
readln(temp_str);
get_string:=temp_str;
end;
function open_files(file_in_name,file_out_name:str_filename;var file_in,file_out:text):boolean;
begin
assign(file_in,file_in_name);
assign(file_out,file_out_name);
{$I-}
rewrite(file_out);
reset(file_in);
{$I+}
open_files:=ioresult=0;
end;

function find_element(root:pword;data_to_find:str_word):pword;
begin
while(root<>NIL)and(root^.data<>data_to_find)do
root:=root^.next;
find_element:=root;
end;

procedure read_line(var file_in:text;var wordz,current_pword:pword);
var
current_symbol:str1;
current_word:str_word;
new_pword:pword;
found_word:pword;
begin
current_word:='';
while not eoln(file_in)do{¤® Є®­ж  бва®ЄЁ}
begin
read(file_in,current_symbol);{зЁв Ґ¬ бЁ¬ў®«}
if(current_symbol<>' ')then{Ґб«Ё нв® ЎгЄў }
current_word:=current_word+current_symbol;{¤®Ў ў«пҐ¬ Є ⥪г饩 бва®ЄҐ}
if(current_symbol=' ')or eoln(file_in) or(length(current_word)=MAX_LENGTH)then{Ё­ зҐ}
begin
if length(current_word)<>0 then{Ґб«Ё бва®Є  ­Ґ Їгбв п}
begin
found_word:=find_element(wordz,current_word);
if(found_word=NIL)then{Ґб«Ё б«®ў® ­®ў®Ґ}
begin
new(new_pword);{ ««®жЁа㥬 Ї ¬пвм}
new_pword^.data:=current_word;
new_pword^.next:=NIL;
new_pword^.count:=1;
if(current_pword<>NIL)then
current_pword^.next:=new_pword;
current_pword:=new_pword;{¤®Ў ў«пҐ¬ ҐҐ Є ¬ ббЁўг}
if(wordz=NIL)then
wordz:=new_pword;
end
else
found_word^.count:=found_word^.count+1;
current_word:='';{®Ў­г«пҐ¬ б«®ў®}
end;
end;
end;
end;

procedure read_wordz(var file_in:text;var wordz:pword);
var
current_word:pword;
begin
current_word:=NIL;
while not eof(file_in)do{¤® Є®­ж  д ©« }
begin
read_line(file_in,wordz,current_word);{зЁв Ґ¬ бва®Єг}
readln(file_in);{ЇҐаҐе®¤Ё¬ ­  б«Ґ¤гойго бва®Єг}
end;
end;
procedure find_min(wordz:pword;var min:pword);
begin
min:=wordz;
while(wordz<>NIL)do
begin
if(min^.data>wordz^.data)then
min:=wordz;
wordz:=wordz^.next;
end;
end;
procedure swap(var x,y:pword);
var
temp_str:str_word;
temp_count:integer;
begin
temp_str:=x^.data;
x^.data:=y^.data;
y^.data:=temp_str;
temp_count:=x^.count;
x^.count:=y^.count;
y^.count:=temp_count;
end;
procedure sort_wordz(wordz:pword);
var
min:pword;
begin
while(wordz<>NIL)do
begin
find_min(wordz,min);
swap(wordz,min);
wordz:=wordz^.next;
end;
end;
procedure write_wordz(var file_out:text;wordz:pword);
begin
while(wordz<>NIL)do
begin
writeln(file_out,wordz^.data,'-',wordz^.count);
wordz:=wordz^.next;
end;
end;

procedure get_time(var clock:type_time);
var
t_h,t_m,t_s,t_s100:word;
begin
gettime(t_h,t_m,t_s,t_s100);
with clock do
begin
h:=t_h;
m:=t_m;
s:=t_s;
s100:=t_s100;
end;
end;

function timespan(start_time:type_time):real;
var
current_time:type_time;
begin
get_time(current_time);
timespan:=0.01*(current_time.s100-start_time.s100)+(current_time.h-start_time.h)*3600+(current_time.m-start_time.m)*60+
(current_time.s-start_time.s);

end;

var
file_in_name,file_out_name:str_filename;
file_in,file_out:text;
wordz:pword;
start_time:type_time;
begin
wordz:=NIL;
file_in_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п ўе®¤­®Ј® д ©« ');{Ї®«гз Ґ¬ Ё¬Ґ­  д ©«®ў}
file_out_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п д ©«  ¤«п ўлў®¤ ');

if(open_files(file_in_name,file_out_name,file_in,file_out))then{®вЄалў Ґ¬ д ©«л}
begin{Ґб«Ё ®вЄал«Ёбм}
get_time(start_time);
read_wordz(file_in,wordz);{зЁв Ґ¬ б«®ў  Ё§ д ©«  ў ¬ ббЁў}
sort_wordz(wordz);{б®авЁа㥬 ¬ ббЁў}
write_wordz(file_out,wordz);{ўлў®¤Ё¬ ®вб®авЁа®ў ­­л© ¬ ббЁў ў д ©«}
close(file_in);{§ Єалў Ґ¬ д ©«л}
close(file_out);
writeln('ЋЎа Ў®вЄ  ўҐ« бм ',timespan(start_time):0:2,' ᥪ㭤');
end
else{Ё­ зҐ}
writeln('ЌҐў®§¬®¦­® ®вЄалвм д ©«л!');{ўлў®¤Ё¬ б®®ЎйҐ­ЁҐ}
writeln('Ќ ¦¬ЁвҐ RETURN ¤«п ўл室 .');
readln;
end.