home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PASDEMO2.ZIP / P571.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-09-29  |  4.4 KB  |  139 lines
  1. program TaskList;
  2. {This program maintains a list of tasks}
  3. const Max = 20;  { Length of task names }
  4. type ListData  = array [1..Max] of char;
  5.      ListPointer = ^Item;
  6.      Item = record Data: ListData;
  7.                    Nest: ListPointer
  8.             end;
  9. var NullChar: char;  { the null character, ch(0) }
  10.  
  11. procedure Initialization( var First: ListPointer );
  12. {This procedure initializes all appropriate variables }
  13.    begin
  14.       First := Nil;
  15.       NullChar := char(0)
  16.    end;
  17.  
  18. procedure ReadData( var Name: ListData );
  19. {This procedure reads a name from the terminal }
  20.    var Index: integer;
  21.    begin
  22.       Index := 1;
  23.       while (Index <= Max ) and Not Eoln
  24.          do begin
  25.             read( Name[Index] );
  26.             Index := Index + 1;
  27.          end;
  28.       readln;
  29.       while (Index <= Max )
  30.          do begin
  31.             Name[Index] := NullChar;
  32.             Index := Index + 1;
  33.          end;
  34.    end;
  35.  
  36. procedure FindPrevious( Name: ListData; var PrevElt: ListPointer;
  37.                         First: LIstPointer );
  38. {This procedure locates the task that comes before given name on the list.
  39.  If the name is not found, PreElt^.Next will be Nil.
  40.  The procedure assumes the Name is not the first list element. }
  41.     var ListElt: ListPointer;  {This pointer gives the list item
  42.                                      where the Name is checked }
  43.    function Done: boolean;
  44.    {This function determines if more items must be searched on the list }
  45.       begin
  46.          if ListElt = Nil
  47.             then Done := true
  48.             else Done := ( Name = ListElt^.Data );
  49.          end;
  50.  
  51.    begin
  52.       PrevElt := First;
  53.       ListElt := PrevElt^.Data;
  54.       while not Done
  55.          do begin
  56.             PrevElt := ListElt;
  57.             ListElt := PrevElt^.Next
  58.          end;
  59.    end;
  60.  
  61. procedure AddName( var First: ListPointer );
  62. {this procedure reads a task name and inserts it into the list}
  63.    var NewItem: ListPointer;
  64.        OldItem: ListData;
  65.  
  66.    procedure InsertFirst( NewItem: ListPointer; var First: ListPointer );
  67.    {this procedure inserts the new item at the beginning of the list}
  68.       begin
  69.          NewItem^.Next := First;
  70.          First := NewItem
  71.       end;
  72.  
  73.    procedure InsertAfterFirst( NewItem, First: ListPointer );
  74.    {this procedure inserts the new item after the start of the list }
  75.       var PrevElt: ListPointer;
  76.       begin
  77.          FindPrevious( OldName, PreElt, First );
  78.          NewItem^.Next := PrevElt^.Next;
  79.          PrevElt^.Next := NewItem
  80.       end;
  81.  
  82.    begin
  83.       New( NewItem );
  84.       write( 'Enter new task' );
  85.       readData( NewItem^.Data );
  86.       if First = Nil
  87.          then InsertFirst( NewItem, First )
  88.          else begin
  89.             writeln( 'Enter old task which new task should preceed, ' );
  90.             write( 'or enter a blank if new task should be ',
  91.                    'placed "last": ' );
  92.             readData( OldName );
  93.             if OldName = First^.Data
  94.                then InsertFirst( NewItem, First )
  95.                else InsertAfterFirst( NewItem, First );
  96.          end
  97.    end;
  98.  
  99. procedure DeletionName( var First: Listpointer );
  100. {this procedure reads a task name and deletes the name from the list }
  101.    var Name: ListData;
  102.  
  103.    procedure DeleteName( Name: ListData; var First: ListPointer );
  104.       var PrevElt, ListElt: ListPointer;
  105.       begin
  106.          if First^.Data = Name
  107.             then begin {delete first element on list }
  108.                ListElt := First;
  109.                First := ListElt^.Next;
  110.                Dispose( ListElt );
  111.                  end
  112.             else begin
  113.                FindPrevious( Name, PrevElt, First );
  114.                if ListElt = Nil
  115.                   then writeln( 'Task not found on list' );
  116.                   else begin
  117.                      PrevElt^.Next := ListElt^.Next;
  118.                      Dispose( ListElt )
  119.                        end
  120.                 end
  121.       end;
  122.  
  123.    begin
  124.       if First = Nil
  125.          then weiteln( 'List in empty - no deletions are possible' )
  126.          else begin
  127.             write( 'Enter task name to be deleted: ' );
  128.             ReadData( Name );
  129.             DeleteName( Name, First );;
  130.               endl
  131.   end;
  132.  
  133. procedure Print( First: ListPointer );;
  134. {this procedure prints the current data items on the list }
  135.    var ListElt: ListPointer;
  136.    begin
  137.       writeln( 'The list of tasks are: ' );
  138.       writeln;
  139.       ListElt