Реализация списков - Pascal ABC

unit Lab1_mod;
 
 
{------- interface -------}
interface
 
uses
  crt;
 
const
  n = 1000;
  zn = [1..0];
 
type
  StudList = record
    name, surname, patronymic: string[20];
    couse: 1..5;
    group: 1..10;
    cathedra: string[25];
  end;
  indextype = 1..n;
  caftype = 1..10;
 
var
  druc: string;
  count: indextype; //індекс студентів
  caf: caftype; //індекс кафедр
  yn, choice: char; //змінні вибору
  tf, menutf, second: boolean;
  a: array[1..n, 1..10] of StudList; //матриця студентів
 
procedure typography(a: string);//друкарська машинка
 
procedure menu();//головне меню програми
 
procedure addstudent(var count: indextype; caf: caftype);//додавання нового студента
 
procedure delstudent(var count: indextype; caf: caftype);
 
procedure newcathedra(var caf: caftype);//створення нової кафедри
 
procedure listcathedra(var caf: caftype);//список кафедр
 
procedure deletecathedra(var caf: caftype);//видалення кафедри
 
 
{------- implementation -------}
implementation
 
//друкарська машинка
procedure typography(a: string);
var
  i: integer;
begin
  for i := 1 to Length(a) do
  begin
    write(a[i]);delay(50);
  end;
end;
 
//головне меню програми
procedure menu();
begin
  while menutf = true do
  begin
    write('Ви бажаєте продовжувати (y/n)? >> '); // меню користувача
    readln(yn);
    if (yn = 'y') or (yn = 'Y') then
    begin
      ClrScr();
      writeln('..:: Меню користувача ::..'); Delay(1000);
      write(':: Додати студента (a)  |'); Delay(500); write(' :: Видалити студента (b) |'); Delay(500); writeln(' :: Змінити інформацію (c)'); Delay(500);
      write(':: Створити кафедру (d) |'); Delay(500); write(' :: Видалити кафедру (e)  |'); Delay(500); writeln(' :: Список кафедр (f)'); Delay(500);
      writeln(':: Вивести всіх студентів факультета впорядкованих за алфавітом (g)'); Delay(500); readln();
      write('Уведіть необхідну літеру >> ');
      readln(choice);
      ClrScr();Delay(500);
      case choice of
        'a': addstudent(count, caf);
        'd': begin caf := caf + 1; second := true; newcathedra(caf); end;
        'e': begin second := false; deletecathedra(caf); end;
        'f': listcathedra(caf);
      //        'g': listallalph();
      end;
    end;    
    if (yn = 'n') or (yn = 'N') then
    begin
      menutf := false;
    end;
    if (yn <> 'n') and (yn <> 'N') and (yn <> 'y') and (yn <> 'Y') then
    begin
      writeln('Невірно уведені дані.');
      menutf := true;
    end;
  end;
end;
 
//додавання нового студента
procedure addstudent(var count: indextype; caf: caftype);
var
  c: caftype;
  cc: string[25];
label goback;
begin
  druc := '| Ви обрали додавання студета |'; typography(druc);writeln();
  goback:
  write('До якої кафедри будуть додаватись студенти? >> ');
  readln(cc);
  tf := true;
  for c := 1 to caf do
  begin
    if cc <> a[1, c].cathedra then tf := false;
    if cc = a[1, c].cathedra then
    begin
      tf := true;
      break
    end;
  end;
  if tf = false then
  begin
    writeln('Такої кафедри не існує.Уведіть дані ще раз.'); Delay(500);
    goto goback;
  end
    else
  begin
    writeln('count: ', count);
    while (tf = true) and (count <= 1000) do
    begin
      write('Додати новий обліковий запис студента (y/n)? >> '); readln(yn);
      if (yn = 'y') or (yn = 'Y') then
      begin
        write('Прізвище >> '); readln(a[count, caf].surname);
        write('Ім"я >> '); readln(a[count, caf].name);
        write('По-батькові >> '); readln(a[count, caf].patronymic);
        goback:
        write('Курс >> '); readln(a[count, caf].couse);
        if not a[count, caf].couse in zn then
        begin
          writeln('Невірно уведені дані.');
          goto goback;
        end;
        goback:
        write('Група >> '); readln(a[count, caf].group);
        if not a[count, caf].couse in zn then
        begin
          writeln('Невірно уведені дані.');
          goto goback;
        end;
        count := count + 1;
        tf := true;
      end;
      if (yn = 'n') or (yn = 'N') then tf := false;
      if (yn <> 'n') and (yn <> 'N') and (yn <> 'y') and (yn <> 'Y') then
      begin
        writeln('Невірно уведені дані.');
        tf := true;
      end;
    end;
  end;
  menutf := true;
end;
 
//створення нової кафедри
procedure newcathedra(var caf: caftype);
var
  ttf: boolean;
  c: caftype;
begin
  tf := true;
  if second = false then count := 1;
  if second = true then
  begin
    druc := '| Ви обрали створення нової кафедри |';
    typography(druc);
  end;
  while (caf <= 10) and (tf = true) do //додавання нової кафедри
  begin
    writeln();
    write('Ви бажаєте додати кафедру (y/n)? >> ');
    readln(yn);
    if (yn = 'y') or (yn = 'Y') then
    begin
      tf := true;
      ttf := false;
      write('Уведіть назву кафедри >> ');
      readln(a[1, caf].cathedra);
      if caf >= 2 then for c := 1 to caf - 1  do //перевірка чи не додається така ж кафедра
        begin
          if a[1, caf].cathedra = a[1, c].cathedra then
          begin
            writeln('Така кафедра вже існує');
            a[1, caf].cathedra := '';
            caf := caf - 1;
            ttf := true;
            break
          end;
        end; //кінець перевірки
      if ttf = false then writeln('Кафедру "', a[1, caf].cathedra, '" додано');
      caf := caf + 1;
    end;
    if (yn = 'n') or (yn = 'N') then tf := false;
    if (yn <> 'n') and (yn <> 'N') and (yn <> 'y') and (yn <> 'Y') then
    begin
      writeln('Невірно уведені дані.');
      tf := true;
    end;
  end;
  writeln('усього у базі ', caf - 1, ' елем.:');
  for c := 1 to caf - 1 do
  begin
    writeln('Кафедра ', a[1, c].cathedra);
  end;
  readln();
  caf := caf - 1; //реальна к-ть кафедр
  menutf := true;
  menu();
end;
 
  //список кафедр
procedure listcathedra(var caf: caftype);
var
  c: caftype;
begin
  druc := '| Ви обрали список кафедр |'; typography(druc);writeln();
  if a[1, 1].cathedra = '' then
  begin
    writeln('У списку немає жодної кафедри');
  end
  else
    for c := 1 to caf do
    begin
      writeln(c, '. ', a[1, c].cathedra); Delay(250);
    end;
  menutf := true;
end;
 
  //видалення кафедри
procedure deletecathedra(var caf: caftype);
var
  cc: string[25]; //назва кафедри для видалення
  c: caftype;
begin
  if second = false then
  begin
    druc := '| Ви обрали видалення кафедри |';
    typography(druc);
    Delay(500);
    writeln();
    second := true;
  end;
  tf := true;
  if a[1, 1].cathedra = '' then
  begin
    writeln('У списку немає жодної кафедри');
  end
    else
  begin
    while tf = true do
    begin
      write('Чи варто вивести список кафедр на екран (y/n) >> ');
      readln(yn);
      if (yn = 'y') or (yn = 'Y') then
      begin
        for c := 1 to caf do
        begin
          writeln(c, '. ', a[1, c].cathedra); Delay(250);
        end;
        tf := false;
      end;
      if (yn = 'n') or (yn = 'N') then tf := false;
      if (yn <> 'n') and (yn <> 'N') and (yn <> 'y') and (yn <> 'Y') then
      begin
        writeln('Невірно уведені дані.');
        tf := true;
      end;
    end;
    Delay(500);
    write('Уведіть назву кафедри для видалення >> '); //власне саме видалення обраної кафедри
    readln(cc);
    tf := false;
    c := 1;
    repeat //пошук необхідного елемента
      if cc = a[1, c].cathedra then tf := true;
      if cc <> a[1, c].cathedra then
      begin
        c := c + 1;
        tf := false;
      end;
    until (c > caf) or (tf = true);
    if tf = false then //якщо елемент не знайдений то починаємо роботу процедури з початку
    begin
      writeln('Елемент ', cc, ' не знайдений');
      while tf = false do
      begin
        write('Почати з початку (y/n)? >> ');
        readln(yn);
        if (yn = 'y') or (yn = 'Y') then 
        begin
          ClrScr();
          tf := true;
          deletecathedra(caf);
        end;
        if (yn = 'n') or (yn = 'N') then tf := true;
        if (yn <> 'n') and (yn <> 'N') and (yn <> 'y') and (yn <> 'Y') then
        begin
          writeln('Невірно уведені дані.');
          tf := false;
        end;
      end;
    end
    else //власне саме видалення елементу
    begin
      writeln('Ви збираєтесь видалити ел-т "', a[1, c].cathedra, '".'); Delay(500); readln();
      a[1, c].cathedra := a[1, caf].cathedra;
      a[1, caf].cathedra := '';
      caf := caf - 1;    
    end;
  end;
  menu();
end;
 
 
{------- begin -------}
begin
end.