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