Паскаль / 2 семестр / курсач / CTASKS

unit ctasks;

interface

{ ®ЇаҐ¤Ґ«Ё¬ вЁЇ ¤Ё­ ¬ЁзҐбЄ®Ј® ¬ ббЁў  ¤«п Ў®«м襩 ЈЁЎЄ®бвЁ }
type
DynamicArray = array[1..1] of integer;
DynamicArrayPtr = ^DynamicArray;

{ вЁЇ н«Ґ¬Ґ­в  бЇЁбЄ  (¤«п ўв®а®© § ¤ зЁ) }
type
PElement = ^TElement;
TElement = record
Data : integer;
Next : PElement;
end;

{ ¬®¤г«м ЇаҐ¤®бв ў«пҐв ўбҐЈ® ¤ўҐ дг­ЄжЁЁ - ¤«п Є ¦¤®© § ¤ зЁ ᮮ⢥вб⢥­­® }
procedure SolveTask1 (srcFileName : string; dstFileName : string);
procedure SolveTask2 (srcFileName : string; dstFileName : string);

implementation
uses Crt;
{$R-} { ®вЄ«оз Ґ¬ Їа®ўҐаЄг ¤Ё Ї §®­®ў ¬ ббЁў  (­ ¤® ¤«п ¤Ё­¬ ЁзҐбЄЁе ¬ ббЁў®ў) }

{ ¤«п б®авЁа®ўЄЁ ®ЎкпўЁ¬ ®¤Ё­ ¬ ббЁў Ё ўбҐ дг­ЄжЁЁ Ўг¤гв а Ў®в вм б ­Ё¬
ў ЇаЁ­жЁЇҐ ¬®¦­® ᤥ« вм Ё ­  ®б­®ўҐ дг­ЄжЁ© }
var
numArray : DynamicArrayPtr;
numArraySize : integer;

gotError : boolean;


function readInteger (var srcFile : Text; isFile : boolean; var gotError : boolean) : integer;
var
res : integer;
gotResult : boolean;
begin
res := 0;
gotError := false;
gotResult := false;

{$I-}
repeat
readln (srcFile, res);
if IOResult <> 0 then
begin
if isFile then
begin
gotError := true;
gotResult := true;
end
else
begin
writeln ('ЌҐўҐа­л© д®а¬ в 楫®Ј® зЁб« ! ‚ўҐ¤ЁвҐ зЁб«® ҐйҐ а §:');
end;
end
else
gotResult := true;
until gotResult;
{$I+}

readInteger := res;
end;

function readPositiveNumber (str : string) : integer;
var
num : integer;
begin
repeat
write (str);
readln (num);
if num <= 0 then
begin
writeln ('—Ёб«® ¤®«¦­® Ўлвм Ї®«®¦ЁвҐ«м­л¬!');
end
until num > 0;
readPositiveNumber := num;
end;

function readNumbersList (var listSize : integer; var srcFile : Text; isFile : boolean) : PElement;
var
cur, prev : PElement;
number : integer;
gotError : boolean;
begin
cur := nil;
prev := nil;
readNumbersList := nil;
listSize := 0;

repeat
number := readInteger (srcFile, isFile, gotError);
{Readln (srcFile, number);}
{…б«Ё ЇаЁ з⥭ЁЁ Ё§ д ©«  Їа®Ё§®и«  ®иЁЎЄ , в® Їа®бв® Їа®ЇгбЄ Ґ¬ нв® зЁб«®}
if gotError then continue;

if number <> 0 then
begin
cur := New (PElement);
cur^.Data := number;
cur^.Next := Nil;

if prev <> Nil then
prev^.Next := cur
else
readNumbersList := cur;
prev := cur;
Inc (listSize);
end;
until number = 0;
end;

procedure freeNumbersList (list : PElement);
var
cur, prev : PElement;
begin
cur := list;
while (cur <> Nil) do
begin
prev := cur;
cur := cur^.Next;
Dispose (prev);
end;
end;

{-------------- Џа®жҐ¤гал ¤«п аҐиҐ­Ёп ЇҐаў®© § ¤ зЁ -----------------------}

procedure readSourceData1 (srcFileName : string);
var
srcFile : Text;
i : integer;
number : integer;
readFromFile : boolean;
list, cur : PElement;
begin
readFromFile := length (srcFileName) > 0;
Assign (srcFile, srcFileName);
{$I-}
Reset (srcFile);
{$I+}
if IOResult = 0 then
begin
{„«п ­ з «  ­ ¤® Ї®«гзЁвм Є®«ЁзҐбвў® н«Ґ¬Ґ­в®ў ў ¬ ббЁўҐ}
writeln ('‚ўҐ¤ЁвҐ зЁб« . Љ ¦¤®Ґ а §¤Ґ«Ґ­® Є« ўЁиҐ© Enter. Љ®­Ґж ўў®¤  - зЁб«® 0.');
list := readNumbersList (numArraySize, srcFile, readFromFile);

{Ґб«Ё Є®«ЁзҐбвў® Ў®«миҐ ­г«п в® зЁв Ґ¬ б ¬Ё н«Ґ¬Ґ­вл ¬ ббЁў }
if numArraySize >= 0 then
begin
cur := list;
GetMem (numArray, numArraySize * SizeOf (integer));
for i:=1 to numArraySize do
begin
numArray^[i] := cur^.Data;
cur := cur^.Next;
end;
clrscr;
end
else
begin
gotError := true;
writeln ('Љ®«ЁзҐбвў® н«Ґ¬Ґ­в®ў ¬ ббЁў  ¤®«¦­® Ўлвм Ї®«®¦ЁвҐ«м­л¬!');
end;

freeNumbersList (list);

Close (srcFile);

{ ‚лў®¤Ё¬ Ї®«г祭­лҐ Ёб室­лҐ ¤ ­­лҐ }
if not gotError then
begin
WriteLn ('€б室­лҐ ¤ ­­лҐ: ');
for i:=1 to numArraySize do
write (' ', numArray^[i]);
WriteLn;
end;
end
else
begin
WriteLn ('ЌҐ г¤ «®бм ®вЄалвм д ©«!');
gotError := true;
end
end;

procedure writeResultData1 (dstFileName : string);
var
i : integer;
begin
{ ‚лў®¤Ё¬ Ї®«г祭­л© १г«мв в б®авЁа®ўЄЁ }
WriteLn ('ђҐ§г«мв в б®авЁа®ўЄЁ: ');
for i:=1 to numArraySize do
write (' ', numArray^[i]);
WriteLn;

{ ­ ¤® ®бў®Ў®¤Ёвм ўл¤Ґ«Ґ­­го Ї ¬пвм ¤«п ¤Ё­ ¬ЁзҐбЄ®Ј® ¬ ббЁў  }
FreeMem (numArray, numArraySize * SizeOf (integer));
numArraySize := 0;
end;

{ дг­ЄжЁп б®авЁа®ўЄЁ ў ЇаЁ­жЁЇҐ ўбҐ ¤®ў®«м­® Їа®бв® }
procedure simpleSort;
var
i, j : integer;
maxIndex : integer;
tmpNumber : integer;
begin
for i:= 1 to numArraySize - 1 do
begin
maxIndex := 1;
for j:=i + 1 to numArraySize do
begin
if numArray^[j] > numArray^[maxIndex] then
maxIndex := j;
end;

if maxIndex <> 1 then
begin
tmpNumber := numArray^[i];
numArray^[i] := numArray^[maxIndex];
numArray^[maxIndex] := tmpNumber;
end;
end;
end;

procedure SolveTask1 (srcFileName : string; dstFileName : string);
begin
{ ўў®¤ Ёб室­ле ¤ ­­ле }
gotError := false;
readSourceData1 (srcFileName);
if not gotError then
begin
{ б®авЁа®ўЄ  }
simpleSort;
{ ўлў®¤ १г«мв в  }
writeResultData1 (dstFileName);
end;

{ ®¦Ё¤ Ґ¬ ­ ¦ вЁп Є« ўЁиЁ (­ ¤® ¤«п Їа®б¬®ва  аҐ§г«мв в ) }
while KeyPressed do ReadKey;
ReadKey;
end;

{-------------- Џа®жҐ¤гал ¤«п аҐиҐ­Ёп ўв®а®© § ¤ зЁ -----------------------}

function readSourceData2 (srcFileName : string) : PElement;
var
srcFile : Text;
result : PElement;
cur, prev : PElement;
count : integer;
i : integer;
number : integer;
readFromFile : boolean;
begin
readFromFile := length (srcFileName) > 0;
Assign (srcFile, srcFileName);
{$I-}
Reset (srcFile);
{$I+}
if IOResult = 0 then
begin
writeln ('‚ўҐ¤ЁвҐ зЁб« . Љ ¦¤®Ґ а §¤Ґ«Ґ­® Є« ўЁиҐ© Enter. Љ®­Ґж ўў®¤  - зЁб«® 0.');
result := readNumbersList (count, srcFile, readFromFile);
Close (srcFile);
clrscr;

{ ®в®Ўа ¦Ґ­ЁҐ Ёб室­ле ¤ ­­ле }
if not gotError then
begin
WriteLn ('€б室­лҐ ¤ ­­лҐ: ');
cur := result;
while (cur <> Nil) do
begin
write (' ', cur^.Data);
cur := cur^.Next;
end;
WriteLn;
end;
end
else
begin
WriteLn ('ЌҐ г¤ «®бм ®вЄалвм д ©«!');
gotError := true;
end;

readSourceData2 := result;
end;

procedure writeResultData2 (list : PElement; dstFileName : string);
var
cur : PElement;
begin
{ ўлў®¤ १г«мв в  ®Ўа вЎ®ЄЁ бЇЁбЄ  }
WriteLn ('ђҐ§г«мв в ®Ўа Ў®вЄЁ: ');
cur := list;
while (cur <> Nil) do
begin
write (' ', cur^.Data);
cur := cur^.Next;
end;
WriteLn;
end;

{ дг­ЄжЁп Їа®ўҐаЄЁ §­ зҐ­Ёп н«Ґ¬Ґ­в  бЇЁбЄ  (㤮ў«Ґвў®паҐв «Ё гб«®ўЁо) }
function matchCondition (number : integer) : boolean;
begin
matchCondition := (number < 0) and (number mod 2 = 0);
end;

procedure sortList (var list : PElement);
var
searchRes, prevSearchRes : PElement;
start, prevStart, cur, prev : PElement;
realStart : PElement;
begin
{ ®Ўа Ў®вЄ  Ё¬ҐҐв б¬лб« в®«мЄ® Ґб«Ё бЇЁб®Є ­Ґ Їгбв }
if list <> Nil then
begin

{ Їа®ЇгбЄ н«Ґ¬Ґ­в®ў ў ­ з «Ґ бЇЁбЄ  (Є®в®алҐ г¤®ў«Ґвў®апов гб«®ўЁо) }
start := list;
realStart := list;
prevStart := Nil;
while ((start <> Nil) and matchCondition (start^.Data)) do
begin
prevStart := start;
start := start^.Next;
end;

{ ¤ «миҐ Ґбвм б¬лб« а Ў®в вм Ґб«Ё Ўл« ­ ©¤Ґ­ е®вм ®¤Ё­ н«Ґ¬Ґ­в
Є®в®ал© ­Ґ 㤮ў«Ґвў®апҐв гб«®ўЁо }
if start <> Nil then
begin
{ Ї®ўв®а塞 ЇҐаҐ¬ҐйҐ­ЁҐ Ї®Є  ­ е®¤пвбп н«Ґ¬Ґ­вл, 㤮ў«Ґвў®-
апойЁҐ гб«®ўЁо }
repeat
{ ­ е®¤Ё¬ н«Ґ¬Ґ­в, Ї®ЁбЄ ўбҐЈ¤  ­ зЁ­ Ґ¬ б ЇҐаў®Ј®
­Ґг¤®ў«Ґвў®апо饣® гб«®ўЁо н«Ґ¬Ґ­в  }
searchRes := Nil;
prevSearchRes := Nil;
cur := start^.Next;
prev := start;
while (cur <> Nil) do
begin
if matchCondition (cur^.Data) then
begin
searchRes := cur;
prevSearchRes := prev;
{ зв®Ўл б®еа ­Ёвм ®в­®бЁвҐ«м­®Ґ а бЇ®«®¦Ґ­ЁҐ
­ ¤® ®бв ­®ўЁвмбп ­  ЇҐаў®¬ ¦Ґ н«Ґ¬Ґ­вҐ
Ґб«Ё Ўг¤Ґ¬ ўбҐЈ¤  ­ е®¤Ёвм Ї®б«Ґ¤­Ё© н«Ґ¬Ґ­в
в® в®Ј¤  Ї®«гзЁвбп ®Ўа в­л© Ї®а冷Є }
break;
end;
prev := cur;
cur := cur^.Next;
end;

{ Ґб«Ё ­ и«Ё н«Ґ¬Ґ­в, ЇҐаҐ¬Ґй Ґ¬ ҐЈ®}
if searchRes <> Nil then
begin
prevSearchRes^.Next := searchRes^.Next;
searchRes^.Next := start;
if prevStart <> Nil then
prevStart^.Next := searchRes
else
realStart := searchRes;
prevStart := searchRes;
end;
{ ЇҐаҐ¬Ґй Ґ¬ н«Ґ¬Ґ­вл Ї®Є  ®­Ё ­ е®¤пвбп }
until searchRes = Nil;
end;

{ ­ ¤® б®еа ­Ёвм १г«мв в - Ё§¬Ґ­Ё«бп Ј®«®ў­®© н«Ґ¬Ґ­в ў бЇЁбЄҐ }
list := realStart;
end;
end;

procedure SolveTask2 (srcFileName : string; dstFileName : string);
var
list : PElement;
begin
gotError := false;
{ ўў®¤ Ёб室­ле ¤ ­­ле }
list := readSourceData2 (srcFileName);
if not gotError then
begin
{ ®Ўа Ў®вЄ  бЇЁбЄ  }
sortList (list);
{ ўлў®¤ १г«мв в®ў }
writeResultData2 (list, dstFileName);
end;
freeNumbersList (list);

{ ®¦Ё¤ Ґ¬ ­ ¦ вЁп «оЎ®© Є« ўЁиЁ (­ ¤® ¤«п ®в®Ўа ¦Ґ­Ёп १г«мв в ) }
while KeyPressed do ReadKey;
ReadKey;
end;

{$R+} { ўЄ«оз Ґ¬ Їа®ўҐаЄг Ја ­Ёж ¬ ббЁў®ў }
begin
{ ­ з «м­ п Ё­ЁжЁ «Ё§ жЁп а §¬Ґа  ¤Ё­ ¬ЁзҐбЄ®Ј® ¬ ббЁў  }
numArraySize := 0;
end.