Advertisement
Ewerlost

aisd

Apr 10th, 2024
190
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 26.12 KB | None | 0 0
  1. program Lab2_AISD;
  2.  
  3. uses
  4.   System.SysUtils;
  5.  
  6. const
  7.     SegmentCount = 10;
  8.     MIN_PAGE_COUNT = 1;
  9.     MAX_PAGE_COUNT = 10000;
  10.  
  11. type
  12.     PTermListEl = ^TTermListEl;
  13.     PPage = ^TPage;
  14.     TTermListEl = record
  15.         Term: String;
  16.         SubtermList: PTermListEl;
  17.         PagesList: PPage;
  18.         NextTerm: PTermListEl;
  19.     end;
  20.     TPage = record
  21.         Page: Integer;
  22.         NextPage: PPage;
  23.     end;
  24.     TTermsArray = array of PTermListEl;
  25.  
  26. procedure AddSubterm(TermListPointer: PTermListEl; Term: String); forward;
  27. procedure ProcessSubterm(Subterm: String; SubtermListElPointer: PTermListEl); forward;
  28. procedure AddTerm(var TermArray: TTermsArray); forward;
  29.  
  30.  
  31. function makeHash(HashString: String; BacketCount: Integer): Integer;
  32. var
  33.     I, Sum: Integer;
  34. begin
  35.     Sum := 0;
  36.     for I := 1 to High(HashString) do
  37.         Sum := Sum + Ord(HashString[I]);
  38.     Result := Sum mod BacketCount;
  39. end;
  40.  
  41. procedure HashTerm(var TermArray: TTermsArray; Term: String);
  42. var
  43.     Hash: Integer;
  44.     NewTermPointer: PTermListEl;
  45. begin
  46.     Hash := makeHash(Term, Length(TermArray));
  47.     if TermArray[Hash] <> nil then
  48.     begin
  49.         NewTermPointer := TermArray[Hash];
  50.         while NewTermPointer^.NextTerm <> nil do
  51.             NewTermPointer := NewTermPointer.NextTerm;
  52.         New(NewTermPointer^.NextTerm);
  53.         NewTermPointer^.NextTerm^.Term := Term;
  54.         New(NewTermPointer^.NextTerm^.SubtermList);
  55.         NewTermPointer^.NextTerm^.SubtermList^.NextTerm := nil;
  56.         New(NewTermPointer^.NextTerm^.PagesList);
  57.         NewTermPointer^.NextTerm^.PagesList^.NextPage := nil;
  58.         NewTermPointer^.NextTerm^.NextTerm := nil;
  59.     end
  60.     else
  61.     begin
  62.         New(TermArray[Hash]);
  63.         TermArray[Hash].Term := Term;
  64.         New(TermArray[Hash].SubtermList);
  65.         TermArray[Hash].SubtermList^.NextTerm := nil;
  66.         New(TermArray[Hash].PagesList);
  67.         TermArray[Hash].PagesList^.NextPage := nil;
  68.         TermArray[Hash].NextTerm := nil;
  69.     end;
  70. end;
  71.  
  72. procedure MakeTermArray(var TermArray: TTermsArray);
  73. var
  74.     I: Integer;
  75. begin
  76.     SetLength(TermArray, SegmentCount);
  77.     for I := 0 to High(TermArray) do
  78.         TermArray[I] := nil;
  79. end;
  80.  
  81. procedure OutputMainMenu;
  82. begin
  83.     Writeln('--------------------------------------------------------');
  84.     Writeln('1. Просмотреть предметный указатель (по алфавиту)');
  85.     Writeln('2. Просмотреть предметный указатель (отсортированный по номерам страниц)');
  86.     Writeln('3. Добавить термин');
  87.     Writeln('4. Редактировать термин');
  88.     Writeln('5. Удалить термин');
  89.     Writeln('6. Поиск терминов по подтермину');
  90.     Writeln('7. Поиск подтермина по термину');
  91.     Writeln('8. Выход');
  92.     Writeln('--------------------------------------------------------');
  93.     Writeln('Выберите желаемое действие:');
  94. end;
  95.  
  96. procedure OutputEditTermMenu;
  97. begin
  98.     Writeln('--------------------------------------------------------');
  99.     Writeln('1. Добавить подтермин');
  100.     Writeln('2. Редактировать подтермин');
  101.     Writeln('3. Удалить подтермин');
  102.     Writeln('4. Добавить номер страницы');
  103.     Writeln('5. Завершить');
  104.     Writeln('--------------------------------------------------------');
  105.     Writeln('Выберите желаемое действие:');
  106. end;
  107.  
  108. function InputNum(Min, Max: Integer): Integer;
  109. var
  110.     Num: Integer;
  111.     IsCorrect: Boolean;
  112. begin
  113.     repeat
  114.         IsCorrect := True;
  115.         try
  116.             Readln(Num);
  117.         except
  118.             Writeln('Некорректный ввод! Попробуйте еще:');
  119.             IsCorrect := False;
  120.         end;
  121.         if IsCorrect and ((Num < Min) or (Num > Max)) then
  122.         begin
  123.             Writeln('Некорректный ввод! Попробуйте еще:');
  124.             IsCorrect := False;
  125.         end;
  126.     until IsCorrect;
  127.     InputNum := Num;
  128. end;
  129.  
  130. {Олег
  131.     Никита
  132.         Рустам
  133. Блять
  134.     Рустам}
  135.  
  136. procedure InsertElementInAlphabet(Header: PTermListEl; NewTermin : String; NewSubTermInList : PTermListEl; NewPageList : PPage);
  137. var
  138.     Curr, Temp: PTermListEl;
  139.     NewCopy : PTermListEL;
  140. begin
  141.  
  142.     Curr := Header;
  143.     while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Term <= NewTermin) do
  144.         Curr := Curr^.NextTerm;
  145.  
  146.     New(Temp);
  147.     Temp^.NextTerm := Curr^.NextTerm;
  148.     Curr^.NextTerm := Temp;
  149.     Temp^.Term := NewTermin;
  150.     Temp^.SubTermList := NewSubTermInList;
  151.     Temp^.PagesList := NewPageList;
  152. end;
  153.  
  154. function InitializeList(): PTermListEl;
  155. var
  156.     Header: PTermListEl;
  157. begin
  158.     New(Header);
  159.     Header^.NextTerm := nil;
  160.     InitializeList := Header;
  161. end;
  162.  
  163. function TurnArrayToSortedAlpabetList(TermArray : TTermsArray) : PTermListEl;
  164. Var
  165.     I : Integer;
  166.     SortedList : PTermListEl;
  167.     TempArray : TTermsArray;
  168. Begin
  169.     SortedList := InitializeList();
  170.     TempArray := Copy(TermArray);
  171.     for I := 0 to High(TempArray) do
  172.         if TempArray[I] <> nil then
  173.         Repeat
  174.             InsertElementInAlphabet(SortedList, TempArray[I]^.Term, TempArray[I]^.SubTermList,TempArray[I]^.PagesList);
  175.             TempArray[I] := TempArray[I].NextTerm;
  176.         Until TempArray[I] = Nil;
  177.     Result := SortedList;
  178. End;
  179.  
  180. procedure OutputSubterm(Subterm: PTermListEl; Padding: String);
  181. var
  182.     PageList: PPage;
  183. begin
  184.     if Subterm = nil then
  185.         Exit
  186.     else
  187.     begin
  188.         Write(Padding + Subterm^.Term + '| ');
  189.         PageList := Subterm^.PagesList^.NextPage;
  190.         while PageList <> nil do
  191.         begin
  192.             Write(PageList^.Page, ' ');
  193.             PageList := PageList^.NextPage;
  194.         end;
  195.         Writeln;
  196.         OutputSubterm(Subterm^.SubTermList^.NextTerm, Padding + '    ');
  197.     end;
  198. end;
  199.  
  200. procedure OutputList(Header: PTermListEl);
  201. var
  202.     Term, Subterm: PTermListEl;
  203.     PageList: PPage;
  204. begin
  205.     if Header^.NextTerm = nil then
  206.         Writeln('Предметный указатель не заполнен!')
  207.     else
  208.     begin
  209.         Writeln('ПРЕДМЕТНЫЙ УКАЗАТЕЛЬ');
  210.         Term := Header^.NextTerm;
  211.         repeat
  212.             Writeln('----------------------------');
  213.             Write(Term^.Term + '| ');
  214.             PageList := Term^.PagesList^.NextPage;
  215.             while PageList <> nil do
  216.             begin
  217.                 Write(PageList^.Page, ' ');
  218.                 PageList := PageList^.NextPage;
  219.             end;
  220.             if (Term^.SubtermList <> nil) then
  221.             begin
  222.                 Writeln;
  223.                 Subterm := Term^.SubtermList^.NextTerm;
  224.                 while Subterm <> nil do
  225.                 begin
  226.                     OutputSubterm(Subterm, '    ');
  227.                     Subterm := Subterm^.NextTerm;
  228.                 end;
  229.             end
  230.             else
  231.                 Writeln;
  232.             Writeln('----------------------------');
  233.             Term := Term^.NextTerm;
  234.         until Term = nil;
  235.     end;
  236. end;
  237.  
  238. procedure OutputListInAlphabet(TermArray : TTermsArray);
  239. Var
  240.     SortedList : PTermListEl;
  241. Begin
  242.     SortedList := TurnArrayToSortedAlpabetList(TermArray);
  243.     OutputList(SortedList);
  244. End;
  245.  
  246. function IsInTermsArray(var TermArray: TTermsArray; CheckedTerm: String): Boolean;
  247. var
  248.     IsInArray: Boolean;
  249.     I: Integer;
  250.     CheckedTermPointer: PTermListEl;
  251. begin
  252.     I := 0;
  253.     IsInArray := False;
  254.     while not IsInArray and (I <= High(TermArray)) do
  255.     begin
  256.         CheckedTermPointer := TermArray[makeHash(CheckedTerm, Length(TermArray))];
  257.         while not IsInArray and (CheckedTermPointer <> nil) do
  258.         begin
  259.             IsInArray := CheckedTerm = CheckedTermPointer.Term;
  260.             CheckedTermPointer := CheckedTermPointer.NextTerm;
  261.         end;
  262.         Inc(I);
  263.     end;
  264.     Result := IsInArray;
  265. end;
  266.  
  267. procedure InsertElementByPage(Header: PTermListEl; NewTermin : String; NewSubTermInList : PTermListEl; NewPageList : PPage);
  268. var
  269.     Curr, Temp: PTermListEl;
  270. begin
  271.     Curr := Header;
  272.     while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.PagesList^.Page <= NewPageList^.NextPage^.Page) do
  273.         Curr := Curr^.NextTerm;
  274.  
  275.     New(Temp);
  276.     Temp^.NextTerm := Curr^.NextTerm;
  277.     Curr^.NextTerm := Temp;
  278.     Temp^.Term := NewTermin;
  279.     Temp^.SubTermList := NewSubTermInList;
  280.     Temp^.PagesList := NewPageList;
  281. end;
  282.  
  283. function TurnArrayToSorteByPageList(TermArray : TTermsArray) : PTermListEl;
  284. Var
  285.     I : Integer;
  286.     SortedList : PTermListEl;
  287.     TempArray : TTermsArray;
  288. Begin
  289.     SortedList := InitializeList();
  290.     TempArray := Copy(TermArray);
  291.     for I := 0 to High(TempArray) do
  292.         if TempArray[I] <> nil then
  293.             Repeat
  294.                 InsertElementByPage(SortedList, TempArray[I]^.Term, TempArray[I]^.SubTermList, TempArray[I]^.PagesList);
  295.                 TempArray[I] := TempArray[I]^.NextTerm;
  296.             Until TempArray[I] = Nil ;
  297.     Result := SortedList;
  298. End;
  299.  
  300. procedure OutputListByPages(TermArray : TTermsArray);
  301. Var
  302.     SortedList : PTermListEl;
  303. Begin
  304.     SortedList := TurnArrayToSorteByPageList(TermArray);
  305.     OutputList(SortedList);
  306. End;
  307.  
  308. {procedure AddSubterm(var TermListElPointer: PTermListEl);
  309. var
  310.     Term: PTermListEl;
  311. begin
  312.     Writeln('Введите подтермин: ');
  313.     Readln(Term);
  314. end;}
  315.  
  316. procedure SearchTermBySubTerm(TermArray : TTermsArray; SubTermin : String);
  317. Var
  318.     I, Count : Integer;
  319.     TempArray : TTermsArray;
  320.     Curr : PTermListEL;
  321.     CurrSub : PTermListEl;
  322. Begin
  323.     Count := 0;
  324.     Writeln('Термины, связанные с данным подтермином :');
  325.     TempArray := Copy(TermArray);
  326.     for I := 0 to High(TempArray) do
  327.         if TempArray[I] <> Nil then
  328.             Repeat
  329.                 Curr := TempArray[I]^.SubtermList;
  330.                 while Curr^.NextTerm <> Nil do
  331.                 Begin
  332.                     If Curr^.NextTerm^.Term = SubTermin then
  333.                     Begin
  334.                         Inc(Count);
  335.                         Writeln(TempArray[I]^.Term);
  336.                         Break;
  337.                     End;
  338.                     CurrSub := Curr^.NextTerm^.SubtermList;
  339.                     while CurrSub^.NextTerm <> Nil do
  340.                     Begin
  341.                         if CurrSub^.NextTerm^.Term = SubTermin then
  342.                         Begin
  343.                             Inc(Count);
  344.                             Writeln(TempArray[I]^.Term);
  345.                             break;
  346.                         End;
  347.                         CurrSub := CurrSub^.NextTerm;
  348.                     End;
  349.                     Curr := Curr^.NextTerm;
  350.                 End;
  351.                 TempArray[I] := TempArray[I]^.NextTerm;
  352.             Until TempArray[I] = Nil;
  353.         if Count = 0 then
  354.             Writeln('Нет терминов, связанных с даннымм подтермином!');
  355. End;
  356.  
  357. procedure SearhSubTermByTerm(TermArray : TTermsArray; Termin : String);
  358. Var
  359.     Hash : Integer;
  360.     TempArray : TTermsArray;
  361.     Curr, CurrSub : PTermListEl;
  362. Begin
  363.     Hash := MakeHash(Termin, Length(TermArray));
  364.     TempArray := Copy(TermArray);
  365.     if TempArray[Hash] = Nil then
  366.         Writeln('Данного термина не существует')
  367.     Else
  368.     Begin
  369.         Writeln('Подтермины ', Termin,':');
  370.         Repeat
  371.             Curr := TempArray[Hash]^.SubtermList;
  372.             if Curr^.NextTerm = Nil then
  373.             Begin
  374.                 Writeln('У термина нет подтерминов');
  375.                 break;
  376.             End;
  377.             while (Curr^.NextTerm <> Nil) do
  378.             Begin
  379.                 Writeln('  ' + Curr^.NextTerm^.Term);
  380.                 CurrSub := Curr^.NextTerm^.SubtermList;
  381.                 while (CurrSub^.NextTerm <> Nil)  do
  382.                 Begin
  383.                     Writeln('    ' + CurrSub^.NextTerm^.Term);
  384.                     CurrSub := CurrSub^.NextTerm;
  385.                 End;
  386.                 Curr := Curr^.NextTerm;
  387.             End;
  388.             TempArray[Hash] := TempArray[Hash]^.NextTerm;
  389.         Until TempArray[Hash] = Nil ;
  390.     End;
  391. End;
  392.  
  393. function FindPointerToTerm(TermArray : TTermsArray; Term : String) : PTermListEl;
  394. Var
  395.     Hash : Integer;
  396.     TempArray : TTermsArray;
  397.     IsFinded : Boolean;
  398.     Res : PTermListEl;
  399. Begin
  400.     IsFinded := False;
  401.     Res := Nil;
  402.     TempArray := Copy(TermArray);
  403.     Hash := MakeHash(Term, Length(TempArray));
  404.     if TempArray[Hash] = nil then
  405.     Begin
  406.         Writeln('Данного термина не существует');
  407.         FindPointerToTerm := Res;
  408.         Exit;
  409.     End;
  410.     Repeat
  411.         if TempArray[Hash]^.Term = Term then
  412.             Begin
  413.                 Res := TempArray[Hash];
  414.                 IsFinded := True;
  415.             End;
  416.         TempArray[Hash] := TempArray[Hash]^.NextTerm;
  417.     Until (TempArray[Hash] = Nil) And (IsFinded);
  418.     if Res = Nil then
  419.         Writeln('Данного термина не существует');
  420.     FindPointerToTerm := Res;
  421. End;
  422.  
  423. function FindPointerToSubTerm(SubTermList : PTermListEl; Subterm : String) : PTermListEl;
  424. Var
  425.     Curr, Res : PTermListEl;
  426.     IsFinded : Boolean;
  427. Begin
  428.     Curr := SubTermList;
  429.     IsFinded := False;
  430.     Res := Nil;
  431.     while (Curr^.NextTerm <> Nil) And (Not IsFinded) do
  432.     Begin
  433.         if Curr^.NextTerm^.Term = Subterm then
  434.         Begin
  435.             IsFinded := True;
  436.             Res := Curr^.NextTerm;
  437.         End;
  438.         Curr := Curr^.NextTerm;
  439.     End;
  440.     if Not IsFinded then
  441.     Begin
  442.         Writeln('Данного подтермина не существует');
  443.     End;
  444.     FindPointerToSubTerm := Res;
  445. End;
  446.  
  447. procedure AddInPageList(var PagesList: PPage; NewPage: Integer);
  448. var
  449.     Temp, LnkablePointer: PPage;
  450. begin
  451.     if PagesList <> nil then
  452.     begin
  453.         Temp := PagesList;
  454.         while (Temp^.NextPage <> nil) and (Temp^.NextPage^.Page < NewPage) do
  455.             Temp := Temp^.NextPage;
  456.         LnkablePointer := Temp^.NextPage;
  457.         New(Temp^.NextPage);
  458.         Temp := Temp^.NextPage;
  459.         Temp^.Page := NewPage;
  460.         Temp^.NextPage := LnkablePointer;
  461.     end
  462.     else
  463.     begin
  464.         New(PagesList);
  465.         PagesList^.Page := NewPage;
  466.         PagesList^.NextPage := nil;
  467.     end;
  468. end;
  469.  
  470. function IsPageInList(PagesList: PPage; CheckedPage: Integer): Boolean;
  471. var
  472.     IsInList: Boolean;
  473. begin
  474.     IsInList := False;
  475.     PagesList := PagesList^.NextPage;
  476.     while PagesList <> nil do
  477.     begin
  478.         IsInList := PagesList^.Page = CheckedPage;
  479.         PagesList := PagesList^.NextPage;
  480.     end;
  481.     Result := IsInList;
  482. end;
  483.  
  484. procedure AddPage(var TermArray: TTermsArray; Term: String);
  485. var
  486.     Temp: PTermListEl;
  487.     NewPage: Integer;
  488. begin
  489.     Writeln('Введите страницу: ');
  490.     NewPage := InputNum(MIN_PAGE_COUNT, MAX_PAGE_COUNT);
  491.     Temp := TermArray[makeHash(Term, Length(TermArray))];
  492.     while Temp^.Term <> Term do
  493.         Temp := Temp^.NextTerm;
  494.     if not IsPageInList(Temp^.PagesList, NewPage) then
  495.         AddInPageList(Temp^.PagesList, NewPage)
  496.     else
  497.         Writeln('Страница уже есть в списке, добавление невозможно.');
  498. end;
  499.  
  500. function IsPage(TermArray: TTermsArray; Term: String): Boolean;
  501. var
  502.     IsPageInTerm: Boolean;
  503.     Temp: PTermListEl;
  504. begin
  505.     Temp := TermArray[makeHash(Term, Length(TermArray))];
  506.     while Temp^.Term <> Term do
  507.         Temp := Temp^.NextTerm;
  508.     IsPageInTerm := not (Temp^.PagesList^.NextPage = nil);
  509.     IsPage := IsPageInTerm;
  510. end;
  511.  
  512. function IsInSubtermList(TermListPointer : PTermListEl; Subterm : String) : Boolean;
  513. Var
  514.     Verdict : Boolean;
  515.     Temp: PTermListEl;
  516. Begin
  517.     Verdict := False;
  518.     Temp := TermListPointer^.SubtermList;
  519.     While ((Temp^.NextTerm <> Nil) And (Not Verdict)) do
  520.     Begin
  521.         if (Temp^.NextTerm^.Term = Subterm) then
  522.             Verdict := True;
  523.         Temp := Temp^.NextTerm;
  524.     End;
  525.     IsInSubtermList := Verdict;
  526. End;
  527.  
  528. procedure AddSubtermPage(PagesListPointer: PPage);
  529. var
  530.     NewPage: Integer;
  531. begin
  532.     Writeln('Введите страницу: ');
  533.     NewPage := InputNum(MIN_PAGE_COUNT, MAX_PAGE_COUNT);
  534.     if not IsPageInList(PagesListPointer, NewPage) then
  535.         AddInPageList(PagesListPointer, NewPage)
  536.     else
  537.         Writeln('Страница уже есть в списке, добавление невозможно.');
  538. end;
  539.  
  540. function IsSubtermPage(PagesListPointer: PPage; Term: String): Boolean;
  541. var
  542.     IsPageInTerm: Boolean;
  543. begin
  544.     IsPageInTerm := not (PagesListPointer^.NextPage = nil);
  545.     IsSubtermPage := IsPageInTerm;
  546. end;
  547.  
  548. function AddInList(TermListPointer : PTermListEl; Subterm : String) : PTermListEl;
  549. Var
  550.     Curr, Temp: PTermListEl;
  551. Begin
  552.     Curr := TermListPointer^.SubtermList;
  553.     while (Curr^.NextTerm <> Nil) And (Curr^.NextTerm^.Term <= Subterm) do
  554.         Curr := Curr^.NextTerm;
  555.     New(Temp);
  556.     Temp^.NextTerm := Curr^.NextTerm;
  557.     Curr^.NextTerm := Temp;
  558.     Temp^.Term := Subterm;
  559.     New(Temp^.SubtermList);
  560.     Temp^.SubtermList^.NextTerm := nil;
  561.     New(Temp^.PagesList);
  562.     Temp^.PagesList^.NextPage := nil;
  563.     AddInList := Temp;
  564.  
  565. End;
  566.  
  567. procedure AddSubterm(TermListPointer: PTermListEl; Term: String);
  568. var
  569.     Subterm: String;
  570.     Choice: Integer;
  571.     NewListElPointer: PTermListel;
  572.     IsPageBeenAdded : Boolean;
  573. begin
  574.     while TermListPointer^.Term <> Term do
  575.         TermListPointer := TermListPointer^.NextTerm;
  576.     Writeln('Введите подтермин: ');
  577.     Readln(Subterm);
  578.     if not IsInSubtermList(TermListPointer, Term) then
  579.     begin
  580.         NewListElPointer := AddInList(TermListPointer, Subterm);
  581.         ProcessSubterm(Subterm, NewListElPointer);
  582.         {repeat
  583.             Writeln('--------------------------------------------------------');
  584.             Writeln('РЕДАКТОР ПОДТЕРМИНА ' + Subterm);
  585.             OutputEditTermMenu;
  586.             Choice := InputNum(1, 6);
  587.             case Choice of
  588.                 1: AddSubterm(NewListElPointer, Subterm);
  589.                 //2: EditSubterm(NewTerm);
  590.                 //3: DeleteSubterm(NewTerm);
  591.                 4: AddSubtermPage(NewListElPointer^.PagesList);
  592.  
  593.                 5:; //DeletePage(NewTerm);
  594.                 //6: AddTerm(Header, NewTerm);
  595.             end;
  596.             IsPageBeenAdded := IsSubtermPage(NewListElPointer^.PagesList, Term);
  597.             if not IsPageBeenAdded then
  598.                 Writeln('Ошибка! Подтермин не может быть добавлен без страниц.');
  599.         until (IsPageBeenAdded) And (Choice = 6);}
  600.     end
  601.     else
  602.         Writeln ('Ошибка добавления! Такой термин уже есть в алфавитном указателе.')
  603. end;
  604.  
  605. procedure EditSubterm(SubTermPointer: PTermListEl; Subterm: String);
  606. var
  607.     TermPointer: PTermListEl;
  608. begin
  609.     Writeln('Введите подтермин, который хотите изменить:');
  610.     Readln(Subterm);
  611.     TermPointer := FindPointerToSubTerm(SubTermPointer, Subterm);
  612.     if TermPointer <> nil then
  613.         ProcessSubterm(Subterm, SubTermPointer);
  614. end;
  615.  
  616. procedure DelSubterm(SubtermList: PTermListEl; Subterm: String);
  617. var
  618.     Temp, Temp2: PTermListEl;
  619. begin
  620.     Temp := FindpointerToSubterm(SubtermList, Subterm);
  621.     if Temp <> nil then
  622.     begin
  623.         Temp2 := SubtermList;
  624.         while Temp2^.NextTerm <> Temp do
  625.             Temp2 := Temp2^.NextTerm;
  626.         Temp2^.NextTerm := Temp2^.NextTerm^.NextTerm;
  627.         Dispose(Temp);
  628.     end
  629. end;
  630.  
  631. procedure DeleteSubterm(SubtermList: PTermListEl);
  632. var
  633.     Subterm: String;
  634.     SubtermPointer: PTermListEl;
  635. begin
  636.     Writeln('Введите термин, который хотите удалить:');
  637.     Readln(Subterm);
  638.     DelSubterm(SubtermPointer, Subterm);
  639. end;
  640.  
  641. procedure ProcessSubterm(Subterm: String; SubtermListElPointer: PTermListEl);
  642. var
  643.     Choice: Integer;
  644.     IsPageBeenAdded : Boolean;
  645. begin
  646.     repeat
  647.         Writeln('--------------------------------------------------------');
  648.         Writeln('РЕДАКТОР ПОДТЕРМИНА ' + Subterm);
  649.         OutputEditTermMenu;
  650.         Choice := InputNum(1, 5);
  651.         case Choice of
  652.             1: AddSubterm(SubtermListElPointer, Subterm);
  653.             2: EditSubterm(SubtermListElPointer^.NextTerm^.SubtermList, Subterm);
  654.             3: DeleteSubterm(SubtermListElPointer^.NextTerm^.SubtermList);
  655.             4: AddSubtermPage(SubtermListElPointer^.PagesList);
  656.             //5: AddTerm(Header, NewTerm);
  657.         end;
  658.         IsPageBeenAdded := IsSubtermPage(SubtermListElPointer^.PagesList, Subterm);
  659.         if (not IsPageBeenAdded) And (Choice = 5) then
  660.             Writeln('Ошибка! Подтермин не может быть добавлен без страниц.');
  661.     until (IsPageBeenAdded) And (Choice = 5);
  662. end;
  663.  
  664. procedure ProcessTerm(Term: String; TermArray: TTermsArray);
  665. var
  666.     Choice: Integer;
  667. begin
  668.     repeat
  669.         Writeln('--------------------------------------------------------');
  670.         Writeln('РЕДАКТОР ТЕРМИНА ' + Term);
  671.         OutputEditTermMenu;
  672.         Choice := InputNum(1, 5);
  673.         case Choice of
  674.             1: AddSubterm(TermArray[MakeHash(Term, Length(TermArray))], Term);
  675.             2: EditSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList, Term);
  676.             3: DeleteSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList);
  677.             4: AddPage(TermArray, Term);
  678.  
  679.             5:; //DeletePage(NewTerm);
  680.             //6: AddTerm(Header, NewTerm); }
  681.         end;
  682.     until (Choice = 5);
  683. end;
  684.  
  685. procedure AddTerm(var TermArray: TTermsArray);
  686. var
  687.     Term: String;
  688.     IsPageBeenAdded : Boolean;
  689.     NewTerm : PTermListEl;
  690.     Choice: Integer;
  691. begin
  692.     IsPageBeenAdded := False;
  693.     Writeln('Введите термин: ');
  694.     Readln(Term);
  695.     if not IsInTermsArray(TermArray, Term) then
  696.     begin
  697.         HashTerm(TermArray, Term);
  698.         repeat
  699.             Writeln('--------------------------------------------------------');
  700.             Writeln('РЕДАКТОР ТЕРМИНА ' + Term);
  701.             OutputEditTermMenu;
  702.             Choice := InputNum(1, 6);
  703.             case Choice of
  704.                 1: AddSubterm(TermArray[MakeHash(Term, Length(TermArray))], Term);
  705.                 2: EditSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList, Term);
  706.                 3: DeleteSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList);
  707.                 4: AddPage(TermArray, Term);
  708.  
  709.                 5:;
  710.                 //DeletePage(NewTerm);
  711.                 //6: AddTerm(Header, NewTerm); }
  712.             end;
  713.             IsPageBeenAdded := IsPage(TermArray, Term);
  714.             if (not IsPageBeenAdded) And (Choice = 5) then
  715.                 Writeln('Ошибка! Термин не может быть добавлен без страниц.');
  716.         until (IsPageBeenAdded) And (Choice = 5);
  717.     end
  718.     else
  719.         Writeln ('Ошибка добавления! Такой термин уже есть в алфавитном указателе.')
  720. end;
  721.  
  722. procedure DeleteTerm(TermArray: TTermsArray; Term: String);
  723. var
  724.     Temp, Temp2: PTermListEl;
  725.     Hash: Integer;
  726. begin
  727.     Temp := FindpointerToTerm(TermArray, Term);
  728.     if Temp <> nil then
  729.     begin
  730.         Hash := makeHash(Term, Length(TermArray));
  731.         if TermArray[Hash]^.Term = Term then
  732.         begin
  733.             Temp := TermArray[Hash];
  734.             TermArray[Hash] := TermArray[Hash]^.NextTerm;
  735.             Dispose(Temp);
  736.         end
  737.         else
  738.         begin
  739.             Temp := TermArray[Hash];
  740.             while Temp^.NextTerm^.Term <> Term do
  741.                 Temp := Temp^.NextTerm;
  742.             Temp2 := Temp^.NextTerm^.NextTerm;
  743.             Dispose(Temp^.NextTerm);
  744.             Temp^.NextTerm := Temp2;
  745.         end;
  746.     end
  747. end;
  748.  
  749. procedure EditTerm(TermArray: TTermsArray);
  750. var
  751.     Term: String;
  752.     TermPointer: PTermListEl;
  753. begin
  754.     Writeln('Введите термин, который хотите изменить:');
  755.     Readln(Term);
  756.     TermPointer := FindpointerToTerm(TermArray, Term);
  757.     if TermPointer <> nil then
  758.         ProcessTerm(Term, TermArray);
  759. end;
  760.  
  761. procedure SearchByTerm(TermArray: TTermsArray);
  762. var
  763.     Term: String;
  764. begin
  765.     Writeln('Введите подтермин, по которому хотите производить поиск:');
  766.     Readln(Term);
  767.     SearchTermBySubTerm(TermArray, Term);
  768. end;
  769.  
  770. procedure SearchBySuberm(TermArray: TTermsArray);
  771. var
  772.     Subterm: String;
  773. begin
  774.     Writeln('Введите термин, по которому хотите производить поиск:');
  775.     Readln(Subterm);
  776.     SearhSubTermByTerm(TermArray, Subterm);
  777. end;
  778.  
  779. procedure DeleteTermAction(TermArray: TTermsArray);
  780. var
  781.     Term: String;
  782.     TermPointer: PTermListEl;
  783. begin
  784.     Writeln('Введите термин, который хотите удалить:');
  785.     Readln(Term);
  786.     TermPointer := FindPointerToTerm(TermArray, Term);
  787.     if TermPointer <> nil then
  788.         DeleteTerm(TermArray, Term);
  789. end;
  790.  
  791. var
  792.     TermArray: TTermsArray;
  793.     I, Choice: Integer;
  794.     TermName: String;
  795. begin
  796.     MakeTermArray(TermArray);
  797.     Writeln('Данная программа - предметный указатель');
  798.     //Header := CreateSubjectIndex;
  799.     repeat
  800.         OutputMainMenu;
  801.         Choice := InputNum(1, 8);
  802.         case Choice of
  803.             1: OutputListInAlphabet(TermArray);
  804.             2: OutputListByPages(TermArray);
  805.             3: AddTerm(TermArray);
  806.             4: EditTerm(TermArray);
  807.             5: DeleteTermAction(TermArray);
  808.             6: SearchByTerm(TermArray);
  809.             7: SearchBySuberm(TermArray);
  810.             8:;
  811.         end;
  812.     until Choice = 8;
  813.     {HashTerm(TermArray, 'Олег');
  814.     HashTerm(TermArray, 'Никита');
  815.     HashTerm(TermArray, 'Данилова');
  816.     HashTerm(TermArray, 'A');
  817.     for I := 0 to High(TermArray) do
  818.         if TermArray[I] <> nil then
  819.             Writeln(TermArray[I].Termin);
  820.     Readln;}
  821. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement