Power-Programmierung/CD1.mdf/pascal/library/dos/netz/actigram.pas

Pascal/Delphi Source File | 1989-03-19 | 26.8 KB | 835 lines

PROGRAM ACTIGRAM;
{$V-}
{ Program to manage an activity network }
{ Copyright (c) by Namir C. Shammas, 1984 }

CONST Max_Tasks = 50; { Maximum number of tasks }
      Max_Gen_Func_List = 5; { Maximum number of generic Functions }

TYPE

    STRING50 = STRING[50];

    { Record defining the structre of a task }
    Job = RECORD
                Task_Name : STRING[10];
                Func_Name : STRING50;
                Gen_Func, Level : INTEGER;
                N_Calls, N_Responses : INTEGER;
                Calls, Responses : ARRAY [1..Max_Tasks] OF INTEGER;
          END;

    { Record defining the entire data base }
    Job_array = RECORD
                    Title : STRING[80];
                    N_Tasks : INTEGER;
                    Tasks : ARRAY [1..Max_Tasks] OF Job;
                END;

    Filed_Data = FILE OF Job_array; { Data type to enable file I/O }



VAR
    Task_array : Job_array;
    Gen_Func_List : ARRAY [0..Max_Gen_Func_List] OF STRING50;
    Name : STRING50;
    Data_File : Filed_Data;
    Lock_on_Task : BOOLEAN;
    Choice, Copy_Task, Insert_Loc, Task_Num, Line,
    Level, Max_Line, Page_Num : INTEGER;
    Dev_Num : 1..3 ;
    Filename : STRING[12];
    Dev_Out :  TEXT;

{---------------------------------------------------------------------}
PROCEDURE INC(VAR I : INTEGER);

BEGIN
    I := I + 1
END;
{---------------------------------------------------------------------}
PROCEDURE DINC(VAR I : INTEGER; J : INTEGER);

BEGIN
    I := I + J
END;
{---------------------------------------------------------------------}
PROCEDURE DEC(VAR I : INTEGER);

BEGIN
    I := I - 1
END;
{---------------------------------------------------------------------}
PROCEDURE DDEC(VAR I : INTEGER; J : INTEGER);

BEGIN
    I := I - J
END;
{---------------------------------------------------------------------}
PROCEDURE Message( S : STRING50);
{ Procedure to display a message then wait for the user to press any }
{ before resuming execution.                                         }
BEGIN
     WRITELN;
     WRITELN(S);
     WRITELN; WRITELN('Press any key to continue');
     WHILE NOT Keypressed DO;
END; { Message }
{---------------------------------------------------------------------}
PROCEDURE Load_Gen_Func;
{ Procedure to load the generic Functions array }
BEGIN
    Gen_Func_List[1] := 'MAIN';
    Gen_Func_List[2] := 'I/O';
    Gen_Func_List[3] := 'CALCULATIONS';
    Gen_Func_List[4] := 'DATA MANAGEMENT';
    Gen_Func_List[5] := 'MENU';
END; { Load_Gen_Func }
{---------------------------------------------------------------------}
PROCEDURE OUTWRITELN(S : STRING50);
{ Procedure to send output text, followed by a CR }
BEGIN
    CASE Dev_Num OF
        1 : WRITELN(S);
        2 : WRITELN(Lst,S);
        3 : WRITELN(Dev_Out,S);
    END; { CASE }
END; { OUTWRITELN }
{---------------------------------------------------------------------}
PROCEDURE OUTWRITE(S : STRING50);
{ Procedure to to send output text }
BEGIN
    CASE Dev_Num OF
        1 : WRITE(S);
        2 : WRITE(Lst,S);
        3 : WRITE(Dev_Out,S);
    END; { CASE }
END; { OUTWRITE }
{---------------------------------------------------------------------}
PROCEDURE Load(VAR Filename : Filed_Data; VAR Task_array : Job_array);
{ Procedure to load an actigram save on file }
VAR Name : STRING[12];

BEGIN
    WRITE('Enter filename '); READLN(Name);
    Assign(Filename,Name);
    Reset(Filename);
    READ(Filename,Task_array);
    Close(Filename);
    WRITELN;
    WRITELN('Loaded actigram : ',Task_array.Title);
    Message('  ');
END;{ Load }
{---------------------------------------------------------------------}
PROCEDURE Save(VAR Filename : Filed_Data; VAR Task_array : Job_array);
{ Procedure to save an actigram on file }
VAR Name : STRING[12];

BEGIN
    WRITE('Enter filename '); READLN(Name);
    Assign(Filename,Name);
    Rewrite(Filename);
    WRITE(Filename,Task_array);
    Close(Filename);
    WRITELN;
END;{ Save }

{---------------------------------------------------------------------}
PROCEDURE New_File;
{ Procedure to initialize a new actigram }
BEGIN
    WITH Task_array DO
      BEGIN
        N_Tasks  := 1;
        Tasks[1].Task_Name := 'M A I N';
        Tasks[1].Func_Name  := 'ROOT';
        Tasks[1].Level := 0;
        Tasks[1].Gen_Func := 0;
        Tasks[1].N_Calls := 0;
        Tasks[1].N_Responses := 0;
        WRITE('Enter Title for new actigram ');
        READLN(Title);
    END;
END;{ New_File }
{---------------------------------------------------------------------}
PROCEDURE Center_Text(S : STRING50; Line_No : INTEGER);
{ Procedure to center text }
VAR i : INTEGER;

BEGIN
    i := 40 - Length(S) DIV 2;
    GotoXY(1,Line_No); ClrEol;
    GotoXY(i,Line_No);
    WRITELN(S);
END;{ Center_Text }
{---------------------------------------------------------------------}
PROCEDURE List_Links(Index : INTEGER);
{ Procedure to list all links to a particular task }

CONST Remark = 'Press return to continue, or q<cr> to exit';

VAR i, j, N, First, Last : INTEGER;
    Answer : CHAR;

BEGIN
    WITH Task_array DO
      BEGIN
        ClrScr;
        N := Tasks[Index].N_Calls;
        IF N > 0 THEN
        BEGIN
           WRITELN('  ',Tasks[Index].Task_Name); WRITELN;
           First := 1;
           IF  N > 22 THEN Last := 22 ELSE Last := N;
           REPEAT
             FOR i := First TO Last DO
             BEGIN
               j := Tasks[Index].Calls[i];
               WRITELN(i,' |--->  ',Tasks[j].Task_Name,' : ',
                                                Tasks[j].Func_Name);
               DINC(First,22);
               DINC(Last,22);
               IF Last <= N
                    THEN
                        BEGIN { Ask user to continue or quit }
                           WRITELN;
                           WRITELN(Remark);
                           READLN(Answer);
                           IF Answer IN ['Q','q'] THEN Last := N;
                        END; { IF }
             END; { FOR }
           UNTIL Last > N;
           Message('  ');
      END; { IF N > 0 }
    END;{ WITH }
END; {List_Links }
{---------------------------------------------------------------------}
PROCEDURE List_Atoms;
{ Procedure to list all tasks and allow the user to choose a particular }
{ task for a desired action.                                            }

CONST Remark = 'Press return to continue, or q<cr> to exit';

VAR i, First, Last, Lines_in_Page : INTEGER;
    Answer : CHAR;
BEGIN
    Lines_in_Page  := 22;

    WITH Task_array DO
      BEGIN
    First := 1;
        IF N_Tasks > Lines_in_Page THEN Last := Lines_in_Page
                                   ELSE Last := N_Tasks;
    REPEAT { Loop to display tasks }
            ClrScr;
            WRITELN('###         Task Name');
            FOR i := First TO Last DO
                WRITELN(i,'   ',Tasks[i].Task_Name);
            DINC(First,Lines_in_Page);
            DINC(Last,Lines_in_Page);
            IF Last <= N_Tasks
                    THEN
                        BEGIN { Ask user to continue or quit }
                           WRITELN;
                           WRITELN(Remark);
                           READLN(Answer);
                           IF Answer IN ['Q','q'] THEN Last := N_Tasks;
                        END; { IF }
        UNTIL Last > N_Tasks;
        REPEAT
            WRITELN;
            WRITE('Enter selected task number  '); READLN(Task_Num);
        UNTIL Task_Num IN [1..N_Tasks];
        List_Links(Task_Num);
    END; { WITH }
END;{ List_Atoms }
{------------------------------------------------------------}
FUNCTION Search(T : STRING50; VAR Index : INTEGER): BOOLEAN;
{ Procedure to search for a task name }
VAR i : INTEGER;
    Found : BOOLEAN;
BEGIN
    Found := FALSE;
    WITH Task_array DO
      BEGIN
        i := 1; Index := 0;
        WHILE (i <= N_Tasks) AND (Found = FALSE) DO
         BEGIN
            IF T = Tasks[i].Task_Name { Task already exists }
                THEN
                   BEGIN
                     Found := TRUE;
                     Index := i;
                    END
             ELSE IF T <  Tasks[i].Task_Name { New task is to be inserted }
                THEN
                   BEGIN
                    Index := i;
                    i := N_Tasks;
                    END; { IF }
            INC(i);
        END; { WHILE }
    END; { WITH }
    Search := Found;
END; { Search }
{---------------------------------------------------------------------}
PROCEDURE Input_Task(Index : INTEGER);
{ Procedure to input a task }
VAR i : INTEGER;

BEGIN
    WITH Task_array DO
      BEGIN
        WRITELN;
        WRITE('Enter  Function of task  ');
        READLN(Tasks[Index].Func_Name); WRITELN;
        WRITELN('Generic Function list');
        FOR i := 1 TO Max_Gen_Func_List DO
            WRITELN('# ',i,' ::= ',Gen_Func_List[i]);
        WRITELN;
        REPEAT
            WRITE('Enter generic Function number ');
            READLN(Tasks[Index].Gen_Func);
        UNTIL Tasks[Index].Gen_Func IN [1..Max_Gen_Func_List];
        WRITELN;
    END; { WITH }
END;{ Input_Task }
{---------------------------------------------------------------------}
PROCEDURE Append_Task(T_Name : STRING50; Index : INTEGER);
{ Procedure to append an existsing task to the call/response lists }
VAR i : INTEGER;

BEGIN
    WITH Task_array DO
      BEGIN
        IF (Tasks[Task_Num].N_Calls = Max_Tasks) OR
           (Tasks[Index].N_Responses = Max_Tasks)
        THEN
          Message('Overloading in call/response list')

        ELSE
         BEGIN
            INC(Tasks[Task_Num].N_Calls);
            i := Tasks[Task_Num].N_Calls;
            Tasks[Task_Num].Calls[i] := Index;
            INC(Tasks[Index].N_Responses);
            i := Tasks[Index].N_Responses;
            Tasks[Index].Responses[i] := Task_Num;
            IF Tasks[Index].Level <= Tasks[Task_Num].Level
                THEN
                    Tasks[Index].Level  := Tasks[Task_Num].Level + 1;
        END; { IF }
    END; { WITH }
END;{ Append_Task }
{---------------------------------------------------------------------}
PROCEDURE Add_New_Task(T_Name : STRING50; Index : INTEGER);
{ Procedure to add a new task }
VAR i,j : INTEGER;

BEGIN
    WITH Task_array DO
      BEGIN
        IF Index > 0
            THEN { Insert new task  }
                BEGIN
                    IF Task_Num >= Index THEN INC(Task_Num);
                    FOR i := 1 TO N_Tasks DO
                    BEGIN
                        IF Tasks[i].N_Calls > 0 THEN
                        BEGIN
                            FOR j := 1 TO Tasks[i].N_Calls DO
                                IF Tasks[i].Calls[j] >= Index THEN
                                        INC(Tasks[i].Calls[j]);
                        END; { IF }
                        IF Tasks[i].N_Responses > 0 THEN
                        BEGIN
                            FOR j := 1 TO Tasks[i].N_Responses DO
                                IF Tasks[i].Responses[j] >= Index THEN
                                        INC(Tasks[i].Responses[j]);
                        END; { IF }
                    END; { FOR }

                    FOR i := N_Tasks DOWNTO Index DO
                        Tasks[i+1] := Tasks[i];
                    INC(N_Tasks);
                END
            ELSE  { Append new task }
                BEGIN
                    INC(N_Tasks);
                    Index := N_Tasks;
                END; { IF }
        Tasks[Index].N_Calls := 0;
        Tasks[Index].N_Responses := 0;
        Tasks[Index].Task_Name := T_Name;
        Input_Task(Index);
        Tasks[Index].Level := Tasks[Task_Num].Level + 1;
        Append_Task(T_Name,Index);
    END; { WITH }
END;{ Add_New_Task }
{---------------------------------------------------------------------}
PROCEDURE Add_Task;
{ Procedure to add a task.  AT this stage it is not known if the task }
{ is a new one.                                                       }
BEGIN
    IF NOT Lock_on_Task THEN List_Atoms;
    ClrScr;
    Center_Text('-------- A  D  D  I  N  G      T  A  S  K --------',2);
    WRITELN; WRITELN; WRITELN;
    WITH Task_array DO
      BEGIN
        WRITELN('Linking a task to ',Tasks[Task_Num].Task_Name); WRITELN;
        WRITE('Enter task name  '); READLN(Name);
        IF NOT Search(Name,Insert_Loc)
            THEN
             BEGIN
                IF Task_array.N_Tasks = Max_Tasks
                  THEN
                    Message('Cannot add new tasks')
                  ELSE
                    Add_New_Task(Name,Insert_Loc);
             END
            ELSE
              Append_Task(Name,Insert_Loc); { END IF }
    END; { WITH }
END;{ Add_Task }
{---------------------------------------------------------------------}
PROCEDURE Delete_Task;
{ Procedure to delete a task, remove its pointers from the call/response }
{ lists and "renumber" all other pointers.                               }
VAR i,j,k,m : INTEGER;
    Found : BOOLEAN;

BEGIN
  IF NOT Lock_on_Task THEN List_Atoms;
  IF Task_array.Tasks[Task_Num].Task_Name ='M A I N'
  THEN
        Message('You cannot delete the MAIN activity ')
  ELSE
   BEGIN { Proceed with deletion }
    Lock_on_Task := FALSE;
    ClrScr;
    Center_Text('-------- D  E  L  E  T  I  N  G      T  A  S  K --------',2);
    GOTOXY(1,5);
    WITH Task_array DO
      BEGIN
        WRITELN('Deleting task ',Tasks[Task_Num].Task_Name);

        FOR i := 1 TO N_Tasks DO
        BEGIN
            IF Tasks[i].N_Calls > 0 THEN
                FOR j := 1 TO Tasks[i].N_Calls DO
                  IF Tasks[i].Calls[j] >= Task_Num THEN DEC(Tasks[i].Calls[j]);

            IF Tasks[i].N_Responses > 0 THEN
                FOR j := 1 TO Tasks[i].N_Responses DO
                  IF Tasks[i].Responses[j] >= Task_Num THEN
                                                   DEC(Tasks[i].Responses[j]);
        END; { FOR }

            IF Tasks[Task_Num].N_Calls > 0 THEN
            BEGIN
                FOR i := 1 TO Tasks[Task_Num].N_Calls DO
                BEGIN
                       m := Tasks[Task_Num].Calls[i] + 1;
                       Found := FALSE; j := 1;
                       WHILE (j <= Tasks[m].N_Responses) AND (NOT Found) DO
                            IF (Task_Num-1) = Tasks[m].Responses[j]
                                THEN Found := TRUE
                                ELSE INC(j);
                       k := j;

                       FOR j := k TO Tasks[m].N_Responses-1 DO
                              Tasks[m].Responses[j] := Tasks[m].Responses[j+1];

                       DEC(Tasks[m].N_Responses)
                    END; { FOR }
              END; { IF }
        { Remove the task number from calling tasks' lists }
        IF Tasks[Task_Num].N_Responses > 0
            THEN
              BEGIN
                FOR i := 1 TO Tasks[Task_Num].N_Responses DO
                   BEGIN
                       m := Tasks[Task_Num].Responses[i] + 1;
                       Found := FALSE; j := 1;
                       WHILE (j <= Tasks[m].N_Calls) AND (NOT Found) DO
                            IF (Task_Num-1) = Tasks[m].Calls[j]
                                THEN Found := TRUE
                                ELSE INC(j);
                       k := j;

                       FOR j := k TO Tasks[m].N_Calls - 1 DO
                            Tasks[m].Calls[j] := Tasks[m].Calls[j+1];

                        DEC(Tasks[m].N_Calls)
                  END; { FOR }
              END; { IF }
        IF Task_Num < N_Tasks
             THEN
                FOR i := Task_Num TO N_Tasks-1 DO
                    Tasks[i] := Tasks[i+1];
        DEC(N_Tasks);
        Message('  ');
    END; { WITH }
  END; { IF statement to check for valid deletion }
END; {Delete_Tasks }
{---------------------------------------------------------------------}
PROCEDURE Change_Task;
{ Procedure to change task description and generic Function number }
VAR i : INTEGER;

BEGIN
    IF NOT Lock_on_Task THEN List_Atoms;
    ClrScr;
    Center_Text('-------- C  H  A  N  G  I  N  G      T  A  S  K --------',2);
    WRITELN;
    WITH Task_array DO
      BEGIN
        WRITELN('Changing task ',Tasks[Task_Num].Task_Name); WRITELN;
        Input_Task(Task_Num);
    END; { WITH }
END;{ Change_Task }
{---------------------------------------------------------------------}
PROCEDURE Page;
{ Monitors the page/screen limits.                    }
{   Variables :                                       }
{               Line, Max_Line for line control       }
{               Dev_Out : for output device.          }


VAR C : CHAR;

BEGIN
    INC(Line);
    IF Line > Max_Line THEN
      BEGIN
        Line := 1;
        CASE Dev_Num OF
              1  : Message('  ');
              2  : BEGIN
                        WRITELN(Lst,^L);
                        INC(Page_Num);
                        WRITE(Lst,'Page ',Page_Num);
                        WRITELN(Lst,'   '); INC(Line)
                   END;
             ELSE  ;
        END; { CASE }
      END; { IF }

END; { Page }
{---------------------------------------------------------------------}
PROCEDURE List_Gen_Func(Index : INTEGER);
{ Procedure to list tasks according to their generic Functions }
VAR i,j : INTEGER;
    Strr : STRING50;
BEGIN
 WITH Task_array DO
 BEGIN
  Line := 2;
  OUTWRITE('List of tasks with generic Function : ');
  OUTWRITELN(Gen_Func_List[Index]);
  OUTWRITELN('    ');
        FOR i := 1 to N_Tasks DO
            IF Tasks[i].Gen_Func = Index THEN
               BEGIN
                  OUTWRITE(Tasks[i].Task_Name);
                  OUTWRITE(' : '); OUTWRITELN(Tasks[i].Func_Name);
                  Page
                END; { IF }
 END; { WITH }
END; { List_Gen_Func }
{---------------------------------------------------------------------}
PROCEDURE List_Level;
{ Procedure to produce a histogram showing the tasks and thier levels }
VAR i,j : INTEGER;
    Strr : STRING50;

PROCEDURE Histogram(X : INTEGER);

VAR Skip : INTEGER;

BEGIN
    Skip := 30 - Length(Task_array.Tasks[i].Task_Name);
    WHILE (Skip > 0) DO
    BEGIN { Fill in the blanks }
        OUTWRITE(' ');
        DEC(Skip);
    END; { WHILE }
    WHILE X > 0 DO
    BEGIN
        OUTWRITE('*');
        DEC(X);
    END; { WHILE }
    OUTWRITELN('  ');
END; {Histogram }

BEGIN { List_Level }
 WITH Task_array DO
  BEGIN
   Line := 2;
   OUTWRITELN('  ');
   FOR i := 1 TO N_Tasks DO
     BEGIN
         OUTWRITE(Tasks[i].Task_Name); OUTWRITE(' : ');
         Histogram(Tasks[i].Level); Page
     END; { FOR }
  END; { WITH }
END; { List_Level }
{---------------------------------------------------------------------}
PROCEDURE List_Task(Index : INTEGER);
{ Procedure to list the connection with a particular task }
VAR i,j : INTEGER;

BEGIN
 WITH Task_array DO
 BEGIN
  Line := 2;
  OUTWRITE('List all links with task  ');
  OUTWRITELN(Tasks[Index].Task_Name);
  OUTWRITELN('  ');
  IF Tasks[Index].N_Calls > 0
    THEN
      BEGIN
        OUTWRITELN('  '); Page;
        OUTWRITELN('The following are the responding tasks'); Page;
        FOR i := 1 TO Tasks[Index].N_Calls DO
          BEGIN
            j := Tasks[Index].Calls[i];
            OUTWRITELN(Tasks[j].Task_Name); Page;
          END; { FOR }
      END; { IF }
   OUTWRITELN('  '); Page;
   IF Tasks[Index].N_Responses > 0
     THEN
       BEGIN
         OUTWRITELN('  '); Page;
         OUTWRITELN('The following are the calling tasks'); Page;
         FOR i := 1 TO Tasks[Index].N_Responses DO
           BEGIN
             j := Tasks[Index].Responses[i];
             OUTWRITELN(Tasks[j].Task_Name); Page;
           END; { FOR }
       END; { IF }
    END; { WITH }
END; { List_Tasks }
{---------------------------------------------------------------------}
PROCEDURE List_All;
{ Procedure to list all tasks }
VAR i,j,k : INTEGER;
    Strr : STRING50;
BEGIN
 WITH Task_array DO
  BEGIN
  Line := 2;
  OUTWRITE('List of all tasks for actigram ');
  OUTWRITELN(Title);
  OUTWRITELN('  ');
  FOR i := 1 TO N_Tasks DO
    BEGIN
        OUTWRITE('# ');
        Str(i,Strr);  OUTWRITE(Strr);
        OUTWRITE('  '); OUTWRITE(Tasks[i].Task_Name);
        OUTWRITE(' : '); OUTWRITELN(Tasks[i].Func_Name);
        Page;
    END; { FOR }
  OUTWRITELN('  '); Page;
  FOR i := 1 TO N_Tasks DO
  BEGIN
    IF Tasks[i].N_Calls > 0
      THEN
        BEGIN
          OUTWRITELN('  '); Page;
          OUTWRITE('The following are the tasks responding to ');
          OUTWRITELN(Tasks[i].Task_Name); Page;
          FOR k := 1 TO Tasks[i].N_Calls DO
            BEGIN
              j := Tasks[i].Calls[k];
              OUTWRITELN(Tasks[j].Task_Name); Page;
            END; { FOR }
        END; { IF }
    OUTWRITELN('  '); Page;
    IF Tasks[i].N_Responses > 0
      THEN
        BEGIN
           OUTWRITELN('  '); Page;
           OUTWRITE('The following are the tasks calling ');
           OUTWRITELN(Tasks[i].Task_Name); Page;

           FOR k := 1 TO Tasks[i].N_Responses DO
             BEGIN
               j := Tasks[i].Responses[k];
               OUTWRITELN(Tasks[j].Task_Name); Page;
             END; { FOR }
         END; { IF }
    END; { FOR }
  END; { WITH }
END; { List_all }
{-------------------------------------------------------------------}
PROCEDURE List_Menu;
{ Procedure to list the output menu }
VAR IsFile : BOOLEAN;
    Select, i : INTEGER;
    OutFile : STRING50;

BEGIN
    ClrScr;
    Center_Text('------------ LIST / VIEW MENU ------------',1);
    Center_Text('***** OUTPUT OPTIONS *****',2);
    WRITELN; WRITELN;
    WRITELN('0) Exit');                WRITELN;
    WRITELN('1) Send to screen');      WRITELN;
    WRITELN('2) Send to printer');     WRITELN;
    WRITELN('3) Send to file');        WRITELN;
    WRITELN;
    REPEAT
        WRITELN;
        WRITE('Enter choice by number ');
        READLN(Select);
    UNTIL Select IN [0..3];

    IsFile := FALSE;

    CASE Select OF

        1 : BEGIN { Set screen parameters }
                Dev_Num := 1;
                Max_Line := 20;
            END;
        2 : BEGIN { Set printer paramters }
                Dev_Num := 2;
                Max_Line := 60;
                WRITELN(Lst,'Page 1');
                Page_Num := 1;
            END;
        3 : BEGIN
                Dev_Num := 3;
                Max_Line := 32000;
                WRITELN;
                WRITE('Enter filename ');
                READLN(OutFile);
                Assign(Dev_Out,OutFile);
                Rewrite(Dev_Out);
            END;
        ELSE  ;
     END; { CASE }

    IF Select > 0 THEN
    BEGIN
        ClrScr;
        Center_Text('------------ LIST / VIEW MENU ------------',1);
        WRITELN; WRITELN;
        WRITELN('0) Exit');                       WRITELN;
        WRITELN('1) List All');                   WRITELN;
        WRITELN('2) List a particular task');     WRITELN;
        WRITELN('3) List by level ');             WRITELN;
        WRITELN('4) List by generic Function');   WRITELN;
        WRITELN;
        REPEAT
            WRITELN;
            WRITE('Enter choice by number ');
            READLN(Select);
        UNTIL Select IN [0..4];

        IF Dev_Num = 1 THEN
        BEGIN
            ClrScr;
            GOTOXY(1,1);
        END;

        CASE Select OF

            1 : List_All;
            2 : BEGIN
                    IF Lock_on_Task THEN Copy_Task := Task_Num;
                    List_Atoms;
                    List_Task(Task_Num);
                    IF Lock_on_Task THEN Task_Num := Copy_Task;
                END;

            3 : List_Level;
            4 : BEGIN
                    WRITELN('Generic Function list');
                    FOR i := 1 TO Max_Gen_Func_List DO
                        WRITELN('# ',i,' ::= ',Gen_Func_List[i]);
                    WRITELN;
                    WRITE('Enter generic Function number ');
                    READLN(Level);
                    List_Gen_Func(Level);
                END;
            ELSE  ;
        END; { CASE }

        CASE Dev_Num OF
           1 : Message('  ');
           2 : WRITELN(Lst,^L);
           3 : Close(Dev_Out);
        END; { CASE }
    END;

END; { List_Menu }

{---------------------------------------------------------------------}
{         M   M        AAA       IIIII      N   N                     }
{         MM MM       A   A        I        NN  N                     }
{         M M M       AAAAA        I        N N N                     }
{         M   M       A   A        I        N N N                     }
{         M   M       A   A      IIIII      N  NN                     }
{---------------------------------------------------------------------}

BEGIN { M A I N }
    ClrScr;
    Lock_on_Task := FALSE;
    Center_Text('<<<<<<<<<< A C T I G R A M >>>>>>>>>>',1); WRITELN; WRITELN;
    WRITELN('1) Start a new actigram'); WRITELN;
    WRITELN('2) Load an actigram from file'); WRITELN;
    REPEAT
        WRITELN;
        WRITE('Enter your choice by number ');
        READLN(Choice);
    UNTIL Choice IN [1..2];
    WRITELN;
    IF Choice = 1 THEN New_File
                  ELSE Load(Data_File,Task_Array);

    REPEAT
        Load_Gen_Func;
        ClrScr;
        Center_Text('----------<<< M A I N   M E N U >>>----------',1);
        WRITELN;
        IF Lock_on_Task THEN
             WRITELN('Locked on task : ',Task_array.Tasks[Task_Num].Task_Name);
        WRITELN;
        WRITELN('0) Quit');                   WRITELN;
        WRITELN('1) Add Task');               WRITELN;
        WRITELN('2) Change Task');            WRITELN;
        WRITELN('3) Delete Task');            WRITELN;
        WRITELN('4) Access List/View Menu');  WRITELN;
        WRITELN('5) Lock on a task');         WRITELN;
        WRITELN('6) Unlock task');            WRITELN;
        WRITELN;
        REPEAT
            WRITELN;
            WRITE('Enter choice by number ');
            READLN(Choice);
        UNTIL Choice IN [0..6];

        WRITELN;

        CASE Choice OF

            0 : Save(Data_File,Task_Array);
            1 : Add_Task;
            2 : Change_Task;
            3 : Delete_Task;
            4 : List_Menu;
            5 : BEGIN
                    List_Atoms;
                    Lock_on_Task := TRUE;
                END;
            6 : Lock_on_Task := FALSE;
        END; { CASE }

        UNTIL Choice = 0;

END. { ACTIGRAM }