home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / educ / sched24.zip / SCHED.PAS < prev   
Pascal/Delphi Source File  |  1988-02-19  |  24KB  |  689 lines
  1.  
  2. {****************************************************************************}
  3. {*                                                                          *}
  4. {*                      Class Scheduling Program                            *}
  5. {*                      ========================                            *}
  6. {*                                                                          *}
  7. {*     From a list of classes and sections, this program will generate all  *}
  8. {*  possible options                                                        *}
  9. {*                                                                          *}
  10. {*                                                                          *}
  11. {*                                                                          *}
  12. {****************************************************************************}
  13.  
  14.  
  15.  
  16. PROGRAM Schedule (INPUT, OUTPUT);
  17.   CONST
  18.       HOURS = 0;
  19.         MINUTES = 1;
  20.     { the gaps must be at least that large to be usefull }
  21.     MinFree  = 120;            { 2 hours (in minutes) }
  22.     { when the sum of the gaps reach that value the schedule is 'bad' }
  23.     MaxGap   = 240;            { 4 hours (in minutes) }
  24.     FF       = 12;             { form feed character }
  25.     Stars    =                 { used for the printout procedure }
  26. '**********************************************************************';
  27.  
  28.   TYPE
  29.     String4  = STRING[4];
  30.     String6  = STRING[6];
  31.     String7  = STRING[7];
  32.     String8  = STRING[8];
  33.     String11 = STRING[11];
  34.     String12 = STRING[12];
  35.     String40 = STRING[40];
  36.     String80 = STRING[80];
  37.     String255= STRING[255];
  38.     TimeList = ^TimeRec;
  39.     TimeRec  = RECORD
  40.                  Day : INTEGER;
  41.                  T1  : INTEGER;
  42.                  T2  : INTEGER;
  43.                  Next: TimeList;
  44.                END;
  45.     DataList = ^DataRec;
  46.     DataRec  = RECORD
  47.                  Name    : String8;
  48.                  Section : String4;
  49.                  Extra   : String80;
  50.                  InSched : BOOLEAN;
  51.                  Times   : TimeList;
  52.                  Next    : DataList
  53.                END;
  54.     ClasList = ^ClasRec;
  55.     ClasRec  = RECORD
  56.                  Info    : DataList;
  57.                  Used    : BOOLEAN;
  58.                  T1      : INTEGER;
  59.                  T2      : INTEGER;
  60.                  Prev    : ClasList;
  61.                  Next    : ClasList
  62.                END;
  63.     ClasArr  = ARRAY[0..4] OF ClasList;
  64.     DataArr  = ARRAY[0..19] OF DataList;
  65.  
  66.   VAR
  67.     Last_line: String255;
  68.     Earliest, Latest : String255;
  69.     First, Last, I, SchedNum, OptNum, Max, Code : INTEGER;
  70.     NoOutput, Normal, Ok : BOOLEAN;
  71.     Sched : ClasArr;
  72.     Data  : DataArr;
  73.     Ptr   : DataList;
  74.     Time  : TimeList;
  75.     Ch    : CHAR;
  76.     MaxStr, EarlyDef, LateDef : String6;
  77.     FileIn, FileOut : String12;
  78.     InFile, OutFile : TEXT;
  79. { -------------------------------------------------------- }
  80. PROCEDURE Error(S : String255; Msg : String255);
  81. VAR
  82.    x, i : INTEGER;
  83. BEGIN
  84.     i := LENGTH(S) - 2;
  85.     WRITELN('Error on line:');
  86.     WRITELN(Last_line);
  87.     WRITE('at: ');
  88.     FOR x := 4 TO (LENGTH(Last_line) - i) DO
  89.         WRITE(' ');
  90.         WRITELN(Copy(S, 1, i));
  91.         WRITELN('Error type: ', Msg);
  92.         HALT;
  93. END;
  94.  
  95. { get rid of tabs }
  96. FUNCTION FIX_TABS(S : String255) : String255;
  97. VAR
  98.    i, len : INTEGER;    
  99. BEGIN
  100.    i := 1;
  101.    len := LENGTH(S);
  102.    WHILE (i <= len) DO BEGIN
  103.          IF S[i] = ^I THEN
  104.             S[i] := ' ';
  105.          i := i + 1;
  106.    END;
  107.    FIX_TABS := S;
  108. END;
  109. { -------------------------------------------------------- }
  110.  
  111.   FUNCTION Ltrim(S : String255) : String255;
  112.     VAR
  113.       I : INTEGER;
  114.   BEGIN { Ltrim }
  115.     I := 1;
  116.     WHILE S[I] = ' ' DO I := I + 1;
  117.     Ltrim := Copy (S, I, 255)
  118.   END;  { Ltrim }
  119.  
  120. {============================================================================}
  121. {=  This procedure converts the head of the string S into a the a number    =}
  122. {=  The head of the string must have the format:                            =}
  123. {=      HH:MMxx  for example  9:30am  or 12:00pm                            =}
  124. {=  The integer value returned is the time in minutes.                      =} 
  125. {============================================================================} 
  126.   PROCEDURE ConvertTime(S : String255; VAR T : INTEGER);
  127.     VAR
  128.       Hours, Minutes, i : INTEGER;
  129.       AmPm, Dummy : CHAR;
  130.         { ---------------------------------------------------}
  131.         PROCEDURE Check_Time(S : STring255; Kind : INTEGER);
  132.         VAR
  133.                 i, error_code : INTEGER;
  134.         BEGIN
  135.         IF Kind = HOURS THEN BEGIN
  136.                 Val(Copy(S, 1, Pos(':', S) - 1), i, error_code);
  137.                 IF error_code <> 0 THEN
  138.                         Error(S, 'not a number');
  139.                 IF i IN [1..12] THEN
  140.                         EXIT;
  141.                 Error(S, 'Hours must be 1 to 12.');
  142.         END
  143.         ELSE BEGIN
  144.                 { check if second digit is a number.  users can type
  145.                   1:0, and it will be ok. }
  146.                 Val(Copy(S, 2, 2), i, error_code);
  147.                 IF error_code = 0 THEN
  148.                         Val(Copy(S, 1, 2), i, error_code)
  149.                 ELSE
  150.                         Val(Copy(S, 1, 1), i, error_code);
  151.                 IF error_code <> 0 THEN
  152.                         Error(S, 'not a number');
  153.                 IF i IN [0..59] THEN
  154.                         EXIT;
  155.                 Error(S, 'Minutes must be 0 to 59.');
  156.         END;
  157.         END;
  158.         { ---------------------------------------------------}
  159.  
  160.   BEGIN { ConvertTime }
  161.  
  162.     Check_Time(S, HOURS);
  163.     Val(Copy(S, 1, Pos(':', S) - 1), Hours, I);
  164.     S := Copy(S, Pos(':', S) + 1, 255);
  165.     Check_Time(S, MINUTES);
  166.         { check for ambiguous input }
  167.         Val(Copy(S, 1, 2), Minutes, I);
  168.         IF I = 0 THEN BEGIN         { both character are digits }
  169.                 Val(Copy(S, 1, 2), Minutes, I);
  170.                 S := Copy(S, 3, 255);
  171.         END
  172.         ELSE BEGIN                  { only the first is. }
  173.                 Val(Copy(S, 1, 1), Minutes, I);
  174.                 S := Copy(S, 2, 255);
  175.         END;
  176.     AmPm := S[1];
  177.     { check what this really was... }
  178.     IF NOT (AmPm IN ['a', 'A', 'p', 'P', ' ', '-']) THEN
  179.         Error(S, 'You need an `am'' or a `pm'', or space ` '' or dash `-''.');
  180.     IF (AmPm IN ['p','P']) AND (Hours <> 12) THEN Hours := Hours + 12;
  181.     T := Hours * 60 + Minutes;
  182.   END;  { ConvertTime }
  183.  
  184. {============================================================================}
  185. {=  This procedure reads all the days and times of a section and stores the =}
  186. {=  information in a TimeList.                                              =}
  187. {============================================================================}
  188.   PROCEDURE GetHours(S : String255; DataPtr : DataList);
  189.     VAR
  190.       Day, T1, T2, Count : INTEGER;
  191.       Time,Ptr,Ptr1: TimeList;
  192.       Day_error : BOOLEAN;
  193.  
  194.   BEGIN { GetHours }
  195.     Time :=  NIL;
  196.     S := LTRIM(S);
  197.     Day_error := TRUE;
  198.  
  199.     WHILE S[1] IN ['M','T','W','F'] DO BEGIN { Loop as long it is a day code }
  200.       Day_error := FALSE;
  201.       Ptr1 := Time;
  202.       { Start by getting all the days of a section with the same hours }
  203.       { and store the day code into the list. }
  204.       WHILE S[1] IN ['M','T','W','F'] DO BEGIN
  205.         NEW(Ptr); { make a new entry for that day }
  206.         Ptr^.Next := Time;
  207.         Count := 1; { dirty trick that tells me if the day is 1 or 2 char long }
  208.         { Convert the day into an integer code stored in the list }
  209.         CASE S[1] OF
  210.           'M' : Ptr^.Day := 0;
  211.           'W' : Ptr^.Day := 2;
  212.           'F' : Ptr^.Day := 4;
  213.           'T' : BEGIN
  214.                   Count := 2; { Here we are, those are 2 character long days }
  215.                   IF S[2] IN ['u','U'] THEN Ptr^.Day := 1
  216.                   ELSE IF S[2] IN ['h','H'] THEN Ptr^.Day := 3
  217.                   ELSE
  218.                        ERROR(S, 'The day isn''t Tu or Th');
  219.                 END
  220.         END;
  221.         Time := Ptr; { add the new entry to the list }
  222.         { scan the rest of the string }
  223.         S := LTRIM(COPY(S, Count + 1, 255));
  224.       END;
  225.  
  226.       { Now, we read all the days for a given time. We have to read the times }
  227.       ConvertTime(S,T1);
  228.       { skip up to next time info }
  229.  
  230.       S := LTRIM(COPY(S, POS('-', S) + 1, 255));
  231.       ConvertTime(S, T2);
  232.       { skip up to field deliminator }
  233.       S := LTRIM(COPY(S, POS(' ', S), 255));
  234.       { determine the extreme values for all the data }
  235.       IF T1 < First THEN First := T1;
  236.       IF T2 > Last THEN Last := T2;
  237.       { traverse the whole list to store the time }
  238.       {!!! this information is disgustingly redundant !!!}
  239.       Ptr := Time;
  240.       WHILE Ptr <> Ptr1 DO BEGIN
  241.         Ptr^.T1 := T1;
  242.         Ptr^.T2 := T2;
  243.         Ptr := Ptr^.Next
  244.       END;
  245.     END;
  246.     IF Day_error THEN
  247.         Error(S, 'Did not find any days of the week.');
  248.     DataPtr^.Extra := COPY(S, 1, LENGTH(S)-1);
  249.     DataPtr^.Times := Time
  250.   END;  { GetHours }
  251.  
  252.   {============================================================================}
  253.   {============================================================================}
  254.   PROCEDURE ReadData;
  255.     VAR
  256.       I : INTEGER;
  257.       S : String255;
  258.       Ptr, Ptr2 : DataList;
  259.   BEGIN { ReadData }
  260.     FOR I := 0 TO 19 DO Data[I] := NIL;
  261.     First := 1440;
  262.     Last := 0;
  263.     I := 0;
  264.     WHILE NOT EOF(InFile) DO BEGIN
  265.       NEW(Ptr);
  266.       READLN(InFile, S);
  267.       S := FIX_TABS(S);            { get rid of tabs }
  268.       S := LTRIM(S);
  269.       Last_line := Copy(S, 1, 255);    { error msg line }
  270.       S := S + '  X';
  271.       Ptr^.Name := COPY(S, 1, POS(' ', S));
  272.       S := LTRIM(COPY(S, POS(' ', S), 255));
  273.       Ptr^.Section := COPY(S, 1, POS(' ', S));
  274.       S := LTRIM(COPY(S, POS(' ', S), 255));
  275.       GetHours(S, Ptr);
  276.       Ptr^.Next := NIL;
  277.       IF Data[I] = NIL THEN
  278.         Data[I] := Ptr
  279.       ELSE IF Data[I]^.Name <> Ptr^.Name THEN BEGIN
  280.         I := I + 1;
  281.         Data[I] := Ptr
  282.       END
  283.       ELSE BEGIN
  284.         Ptr2 := Data[I];
  285.         WHILE Ptr2^.Next <> NIL DO Ptr2 := Ptr2^.Next;
  286.         Ptr2^.Next := Ptr
  287.       END
  288.     END;
  289.     CLOSE(InFile)
  290.   END;  { ReadData }
  291.  
  292. {============================================================================}
  293. {=  When processing is finished with one person, this procedure erases      =}
  294. {=  all the data structures used to keep information.                       =}
  295. {============================================================================}
  296.   PROCEDURE EraseInfo;
  297.     VAR
  298.       I : INTEGER;
  299.       Ptr1, Temp1 : DataList;
  300.       Ptr2, Temp2 : TimeList;
  301.   BEGIN { EraseInfo }
  302.     I := 0;
  303.     WHILE Data[I] <> NIL DO BEGIN
  304.       Ptr1 := Data[I];
  305.       WHILE Ptr1 <> NIL DO BEGIN
  306.         Ptr2 := Ptr1^.Times;
  307.         WHILE Ptr2 <> NIL DO BEGIN
  308.           Temp2 := Ptr2;
  309.           Ptr2 := Ptr2^.Next;
  310.           DISPOSE(Temp2)
  311.         END;
  312.         Temp1 := Ptr1;
  313.         Ptr1 := Ptr1^.Next;
  314.         DISPOSE(Temp1)
  315.       END;
  316.       I := I + 1
  317.     END;
  318.     FOR I := 0 TO 4 DO DISPOSE(Sched[I])
  319.   END;  { EraseInfo }
  320.  
  321.  
  322. {***********************************************************************}
  323. {*                                                                     *}
  324. {*                       Results printing                              *}
  325. {*                                                                     *}
  326. {***********************************************************************}
  327.  
  328. {============================================================================}
  329. {=  This function determines how 'good' a schedule is.                      =}
  330. {=  The way this is done is by summing up all the inter-class gaps that are =}
  331. {=  shorter than the constant MinFree.  Then, if that sum is larger or      =}
  332. {=  equal to the constant MaxGap, the schedule is 'bad'.                    =}
  333. {============================================================================}
  334.   FUNCTION Optimized : BOOLEAN;
  335.     VAR
  336.       Gap, I : INTEGER;
  337.       Ptr : ClasList;
  338.   BEGIN { Optimized }
  339.     Gap := 0;
  340.     FOR I := 0 TO 4 DO BEGIN
  341.       Ptr := Sched[I];
  342.       Ptr := Ptr^.Next;
  343.       IF Ptr <> NIL THEN
  344.         WHILE Ptr^.Next <> NIL DO BEGIN
  345.           IF NOT Ptr^.Used THEN
  346.             IF(Ptr^.T2-Ptr^.T1) < MinFree THEN Gap := Gap + Ptr^.T2-Ptr^.T1;
  347.           Ptr := Ptr^.Next
  348.         END
  349.     END;
  350.     IF Gap < MaxGap THEN OptNum := OptNum + 1;
  351.     Optimized := (Gap < MaxGap) OR Normal
  352.   END;  { Optimized }
  353.  
  354. {============================================================================}
  355. {=  Converts an integer representing a time in minutes into a string        =}
  356. {============================================================================}
  357.   FUNCTION TimeStr(T : INTEGER): String7;
  358.     VAR
  359.       S : String7;
  360.       S1  : String7;
  361.       AmPm : CHAR;
  362.   BEGIN { TimeStr }
  363.     IF (T DIV 60) >= 12 THEN BEGIN
  364.       IF (T DIV 60) <> 12 THEN T := T - 60 * 12;
  365.       AmPm := 'p'
  366.     END ELSE AmPm := 'a';
  367.     Str(T DIV 60:2,S);
  368.     Str(T MOD 60:2,S1);
  369.     S := S + ':' + S1 + AmPm + 'm';
  370.     IF (T MOD 60) = 0 THEN S[4] := '0';
  371.     TimeStr := S
  372.   END;  { TimeStr }
  373.  
  374. {============================================================================}
  375. {=  Counts the number of schedules and prints them out if NoOutput is false =}
  376. {=  Will print out only optimized schedules if Normal is false              =}
  377. {=  NoOutput and Normal are global boolean variables                        =}
  378. {============================================================================}
  379.   PROCEDURE PrintOut(VAR  OutFile : TEXT);
  380.     VAR
  381.       Ch  : CHAR;
  382.       Ptr1: DataList;
  383.       Ptr : ClasList;
  384.       DatOut : ARRAY[0..4,0..95] OF String11;
  385.       Time, T, I, J : INTEGER;
  386.   BEGIN { PrintOut }
  387.     IF Optimized THEN BEGIN
  388.       SchedNum := SchedNum + 1;
  389.       IF NOT NoOutput THEN BEGIN
  390.         FOR I := 0 TO 4 DO
  391.           FOR J := 0 TO (Last-First) DIV 15 DO
  392.             DatOut[I,J] := '           ';
  393.         FOR I := 0 TO 4 DO BEGIN
  394.           Ptr := Sched[I];
  395.           WHILE Ptr <> NIL DO BEGIN
  396.             IF Ptr^.Used THEN BEGIN
  397.               DatOut[I,(Ptr^.T1-First) DIV 15] := '───────────';
  398.               DatOut[I,(Ptr^.T1-First) DIV 15+1] :=
  399.                  Ptr^.Info^.Name + ' ';
  400.               DatOut[I,(Ptr^.T1-First) DIV 15+2] :=
  401.                  Ptr^.Info^.Section + '   ';
  402.               DatOut[I,(Ptr^.T2-First) DIV 15] := '───────────';
  403.             END;
  404.             Ptr := Ptr^.Next
  405.           END
  406.         END;
  407.         IF FileOut = '' THEN Clrscr
  408.         ELSE WRITELN(OutFile, CHR(FF));
  409.         WRITELN(OutFile);
  410.         WRITELN(OutFile, 'Attempt schedule ', SchedNum : 2);
  411.         WRITELN(OutFile, '═══════════════════');
  412.         WRITELN(OutFile);
  413.         WRITELN(OutFile);
  414.         WRITELN(OutFile, ' ╔':9,
  415.                 '═══════════╤═══════════╤═══════════╤═══════════╤═══════════╗');
  416.         WRITELN(OutFile, ' ║':9, '│':12, '│':12, '│':12, '│':12, '║':12);
  417.         WRITELN(OutFile, ' ║' : 9, '  MONDAY   │  TUESDAY  │ WEDNESDAY ',
  418.                                '│ THURSDAY  │  FRIDAY   ║');
  419.         WRITELN(OutFile, ' ║':9, '│':12, '│':12, '│':12, '│':12, '║':12);
  420.         WRITELN(OutFile, ' ╠':9,
  421.                 '═══════════╪═══════════╪═══════════╪═══════════╪═══════════╣');
  422.         FOR J := 0 TO (Last-First) DIV 15 DO BEGIN
  423.           IF (J MOD 2) = 0 THEN
  424.             WRITE(OutFile, TimeStr((J + First DIV 15 ) * 15), ' ║')
  425.           ELSE WRITE(OutFile, '║' : 9);
  426.           FOR I:= 0 TO 4 DO BEGIN
  427.             WRITE(OutFile, DatOut[I, J] : 11);
  428.             IF I = 4 THEN WRITELN(OutFile, '║')
  429.             ELSE WRITE(OutFile, '│')
  430.           END
  431.         END;
  432.         WRITELN(OutFile, ' ╚':9,
  433.                 '═══════════╧═══════════╧═══════════╧═══════════╧═══════════╝');
  434.         WRITELN(OutFile);
  435.         WRITELN(OutFile, 'Classes selected :');
  436.         WRITELN(OutFile, '==================');
  437.         I := 0;
  438.         WHILE Data[I] <> NIL DO BEGIN
  439.           Ptr1 := Data[I];
  440.           WHILE Ptr1 <> NIL DO BEGIN
  441.             IF Ptr1^.InSched THEN
  442.               WRITELN(OutFile, Ptr1^.Name, ' ', Ptr1^.Section, ' ', Ptr1^.Extra);
  443.               Ptr1 := Ptr1^.Next
  444.           END;
  445.           I := I + 1
  446.         END;
  447.         IF FileOut = ''  THEN BEGIN
  448.           REPEAT UNTIL KeyPressed;
  449.           READ(Ch)
  450.         END
  451.       END
  452.     END
  453.   END;  { PrintOut }
  454.  
  455.  
  456.  
  457. {***********************************************************************}
  458. {*                                                                     *}
  459. {*                       Data manipulation                             *}
  460. {*                                                                     *}
  461. {***********************************************************************}
  462. {============================================================================}
  463. {=  Main procedure that will find every possible and imaginable schedule   =}
  464. {=  formed from an original list of classes and sections.                   =}
  465. {============================================================================}
  466.   PROCEDURE MakeSched(Index,Cnt : INTEGER);
  467.     VAR
  468.       Ptr : DataList;
  469.       I : INTEGER;
  470.  
  471. {============================================================================}
  472. {=  Returns the value true if the section times pointed to by Ptr can fit   =}
  473. {=  in our current schedule.                                                =}
  474. {============================================================================}
  475.     FUNCTION Fit(Ptr : TimeList) : BOOLEAN;
  476.       VAR
  477.         Ptr2 : ClasList;
  478.         Ok : BOOLEAN;
  479.     BEGIN { Fit }
  480.       Ok := TRUE;
  481.       WHILE (Ptr <> NIL) AND Ok DO BEGIN
  482.         Ptr2 := Sched[Ptr^.Day];
  483.         Ok := FALSE;
  484.         WHILE (Ptr2 <> NIL) AND NOT Ok DO BEGIN
  485.           Ok := Ptr2^.T2 >= Ptr^.T2;
  486.           IF NOT Ok THEN Ptr2 := Ptr2^.Next
  487.         END;
  488.         IF Ok THEN Ok := (Ptr2^.T1 <= Ptr^.T1) AND NOT Ptr2^.Used;
  489.         Ptr := Ptr^.Next
  490.       END;
  491.       Fit := Ok
  492.     END;  { Fit }
  493.  
  494. {============================================================================}
  495. {=
  496. {============================================================================}
  497.     PROCEDURE Coalesce;
  498.       VAR
  499.         Temp,Ptr : ClasList;
  500.         I : INTEGER;
  501.     BEGIN { Coalesce }
  502.       FOR I := 0 TO 4 DO BEGIN
  503.         Ptr := Sched[I];
  504.         WHILE Ptr^.Next <> NIL DO BEGIN
  505.           Temp := Ptr^.Next;
  506.           IF (NOT Ptr^.Used) AND (NOT Temp^.Used) THEN BEGIN
  507.             Ptr^.T2 := Temp^.T2;
  508.             Ptr^.Next := Temp^.Next;
  509.             IF Temp^.Next <> NIL THEN
  510.               Temp^.Next^.Prev := Ptr;
  511.           END ELSE Ptr := Ptr^.Next
  512.         END
  513.       END
  514.     END;  { Coalesce }
  515.  
  516. {============================================================================}
  517. {============================================================================}
  518.     PROCEDURE Insert(Ptr : DataList);
  519.       VAR
  520.         Temp,Ptr2 : ClasList;
  521.         Ptr1 : TimeList;
  522.     BEGIN { Insert }
  523.       Ptr1 := Ptr^.Times;
  524.       WHILE Ptr1<> NIL DO BEGIN
  525.         Ptr2 := Sched[Ptr1^.Day];
  526.         WHILE Ptr2^.T2 < Ptr1^.T2 DO Ptr2 := Ptr2^.Next;
  527.         { split current free block }
  528.         IF Ptr2^.T1 < Ptr1^.T1 THEN BEGIN
  529.           NEW(Temp);
  530.           Temp^.T1 := Ptr2^.T1;
  531.           Temp^.T2 := Ptr1^.T1 - 1;
  532.           IF Ptr2^.Prev <> NIL THEN Ptr2^.Prev^.Next := Temp
  533.           ELSE Sched[Ptr1^.Day] := Temp;
  534.           Temp^.Prev := Ptr2^.Prev;
  535.           Temp^.Next := Ptr2;
  536.           Ptr2^.Prev := Temp;
  537.           Temp^.Used := FALSE
  538.         END;
  539.         IF Ptr2^.T2 > Ptr1^.T2 THEN BEGIN
  540.           NEW(Temp);
  541.           Temp^.T1 := Ptr1^.T2+1;
  542.           Temp^.T2 := Ptr2^.T2;
  543.           IF Ptr2^.Next <> NIL THEN
  544.             Ptr2^.Next^.Prev := Temp;
  545.           Temp^.Prev := Ptr2;
  546.           Temp^.Next := Ptr2^.Next;
  547.           Ptr2^.Next := Temp;
  548.           Temp^.Used := FALSE
  549.         END;
  550.         Ptr2^.T1 := Ptr1^.T1;
  551.         Ptr2^.T2 := Ptr1^.T2;
  552.         Ptr2^.Info := Ptr;
  553.         Ptr2^.Used := TRUE;
  554.         Ptr1 := Ptr1^.Next;
  555.       END;
  556.       Coalesce;
  557.     END;  { Insert }
  558.  
  559. {============================================================================}
  560. {============================================================================}
  561.     PROCEDURE Remove(Ptr : TimeList);
  562.       VAR
  563.         Temp,Ptr2 : ClasList;
  564.     BEGIN { Remove }
  565.       WHILE Ptr <> NIL DO BEGIN
  566.         Ptr2 := Sched[Ptr^.Day];
  567.         WHILE Ptr2^.T1 <> Ptr^.T1 DO Ptr2 := Ptr2^.Next;
  568.         Ptr2^.Used := FALSE;
  569.         Ptr := Ptr^.Next
  570.       END;
  571.       Coalesce;
  572.     END;  { Remove }
  573.  
  574.   BEGIN { MakeSched }
  575.     IF (Data[Index] <> NIL) AND (Cnt < Max) THEN BEGIN
  576.       Ptr := Data[Index];
  577.       WHILE Ptr <> NIL DO BEGIN
  578.         IF Fit(Ptr^.Times) THEN BEGIN
  579.           Ptr^.InSched := TRUE;
  580.           Insert(Ptr);
  581.           MakeSched(Index + 1, Cnt + 1);
  582.           Ptr^.InSched := FALSE;
  583.           Remove(Ptr^.Times)
  584.         END;
  585.         Ptr := Ptr^.Next
  586.       END;
  587.       MakeSched(Index + 1,Cnt)
  588.     END ELSE
  589.     IF Cnt = Max THEN IF FileOut = '' THEN PrintOut(OUTPUT)
  590.              ELSE PrintOut(OutFile)
  591.   END;  { MakeSched }
  592.  
  593.  
  594. {============================================================================}
  595. {============================================================================}
  596.   FUNCTION Yes(X, Y : INTEGER; Default : CHAR) : BOOLEAN;
  597.     VAR
  598.       Ch : CHAR;
  599.   BEGIN { Yes }
  600.     REPEAT
  601.       GOTOXY(X,Y); WRITE(Default);
  602.       GOTOXY(X,Y); READ(KBD,Ch);
  603.       GOTOXY(X,Y); WRITE(Ch)
  604.     UNTIL Ch IN ['y','Y','n','N',CHR(13)];
  605.     IF Ch = CHR(13) THEN Ch := Default;
  606.     Yes := (Ch = 'Y') OR (Ch = 'y')
  607.   END;  { Yes }
  608.  
  609.  
  610.  
  611. BEGIN { Schedule }
  612.   ClrScr;
  613.   GOTOXY(0,0);
  614.   WRITELN(Stars);
  615.   WRITELN('*','Schedule Maker 2.2  -  by Mallku Caballero':55,'*':14);
  616.   WRITELN(Stars);
  617.   GOTOXY(5,6); WRITE('Enter schedule file : ');
  618.   REPEAT
  619.     GOTOXY(27,6);
  620.     READLN(FileIn);
  621.     ASSIGN(InFile, FileIn);
  622.     {$I-} RESET(Infile) {$I+};
  623.     Ok := IOResult = 0;
  624.     IF NOT Ok THEN BEGIN
  625.       GOTOXY(45, 6); WRITE('Can not find file -- hit any key',CHR(7));
  626.       READ(KBD, Ch);
  627.       GOTOXY(27, 6); WRITE('                                                           ')
  628.     END
  629.   UNTIL Ok;
  630.   ASSIGN(InFile,FileIn);
  631.   RESET(Infile);
  632.   ReadData;
  633.   GOTOXY(5,7); WRITE('How many classes ?');
  634.   Max := 0;
  635.   REPEAT
  636.     GOTOXY(27,7);
  637.     READLN(MaxStr);
  638.     VAL(MaxStr,Max,Code);
  639.   UNTIL (Code = 0) AND (Max > 0);
  640.   EarlyDef := LTRIM(TimeStr(First));
  641.   LateDef  := LTRIM(TimeStr(Last));
  642.   GOTOXY(5,8); WRITE('Earliest time :       ',EarlyDef);
  643.   GOTOXY(27,8); READLN(Earliest);
  644.   Earliest := Copy(Earliest + Copy(EarlyDef,LENGTH(Earliest)+1,7),1,8);
  645.   GOTOXY(5,9); WRITE('Latest time :         ',LateDef);
  646.   GOTOXY(27,9); READLN(Latest);
  647.   Latest := COPY(Latest + COPY(LateDef,LENGTH(Latest)+1,7),1,8);
  648.   ConvertTime(Earliest,First);
  649.   ConvertTime(Latest,Last);
  650.   FOR I := 0 TO 4 DO BEGIN
  651.     NEW(Sched[I]);
  652.     Sched[I]^.Used := FALSE;
  653.     Sched[I]^.T1 := First;
  654.     Sched[I]^.T2 := Last;
  655.     Sched[I]^.Prev := NIL;
  656.     Sched[I]^.Next := NIL
  657.   END;
  658.   SchedNum := 0;
  659.   OptNum := 0;
  660.   NoOutput := TRUE;
  661.   Normal := TRUE;
  662.   MakeSched(0,0);
  663.   GOTOXY(5,13);
  664.   IF SchedNum > 0 THEN BEGIN
  665.     WRITE(SchedNum:3,' schedules have been generated.');
  666.     GOTOXY(5,14); WRITE(OptNum:3,' optimized schedules generated.');
  667.     GOTOXY(5,16); WRITE('Display   (Y/N) ? ');
  668.     IF Yes(36,16,'Y') THEN BEGIN
  669.       GOTOXY(5,17); WRITE('Optimized (Y/N) ?');
  670.       IF optNum > 0 THEN
  671.          Normal := NOT Yes(36,17,'Y')
  672.       else
  673.          Normal := NOT Yes(36,17,'N');
  674.       GOTOXY(5,18); WRITE('Output file (CR for display) : ');
  675.       READLN(FileOut);
  676.       IF FileOut <> '' THEN BEGIN
  677.         ASSIGN(OutFile, FileOut);
  678.         REWRITE(OutFile)
  679.       END;
  680.       NoOutput := FALSE;
  681.       SchedNum := 0;
  682.       MakeSched(0,0);
  683.       IF FileOut <> '' THEN CLOSE(OutFile)
  684.     END
  685.   END
  686.   ELSE WRITE('Unable to generate any schedules.');
  687.   EraseInfo;
  688. END.  { Schedule }
  689.