lalrpop/doc/pascal/sched.pas

PROGRAM a1 (input,output);
    CONST 
	NotScheduled = '        ';

	EmployeeMaxLen = 8;

	
	FirstHour = 8;
	LastHour = 17;		
	PastLastHour = 18;	

	
	TableDayWidth = 9;
    TYPE 
	
	EmployeeType = ARRAY [EmployeeMaxLen] OF string;

	
	
	HourType = 8..17;
	ScheduleType = ARRAY [HourType, DayType] OF EmployeeType;
	
	HourScanType = 8..18;

    VAR
	
	Schedule: ScheduleType;

	
	KeepRunning: boolean;

        
        Command: string;

    
    PROCEDURE ReadString(VAR Str: string);
	VAR
	    Ch: char;
	BEGIN
	    Ch := ' ';
	    WHILE (Ch = ' ') AND NOT eoln DO 
		read(Ch);

	    IF Ch = ' ' THEN
		
		Str := ''
	    ELSE
		BEGIN 
		    
		    Str := '';
		    WHILE (Ch <> ' ') AND NOT eoln DO
			BEGIN
			    Str := Str + Ch;
			    read(Ch)
			END;

		    IF Ch <> ' ' THEN
			
			Str := Str + Ch
		END
	END; 

    
    PROCEDURE ReadSchedClrArgs(
	    VAR StartDay, EndDay: DayType;	
	    VAR StartHour, EndHour: HourType;	
	    VAR Error: boolean);		
	VAR
	    InputHour: integer;			

	
	FUNCTION MapTo24(Hour: integer): HourType;
	    CONST
		
		LastPM = 5;
	    BEGIN
		IF Hour <= LastPM THEN
		    MapTo24 := Hour + 12
		ELSE
		    MapTo24 := Hour
	    END;

	BEGIN 
	    
	    ReadDay(input, StartDay);
	    ReadDay(input, EndDay);

	    
	    IF (StartDay <> BadDay) AND (EndDay <> BadDay) THEN 
		BEGIN
		    
		    read(InputHour);
		    StartHour := MapTo24(InputHour);
		    read(InputHour);
		    EndHour := MapTo24(InputHour);

		    
		    Error := FALSE 
		END
	    ELSE
		
		Error := TRUE;

	    
	    readln
	END; 

    
    PROCEDURE WriteDaysHeader;
	CONST

	    
	    DaysHeadMoveOver = 6;

	    
	    AllowForDay = 3;
	VAR
	    Day: DayType;
	BEGIN
	    write(' ': DaysHeadMoveOver);

	    FOR Day := Sun TO Sat DO
		BEGIN
		    write('[ ');
		    WriteDay(output, Day);
		    write(' ]', ' ': TableDayWidth - AllowForDay - 4)
		END;
	    writeln
	END; 

    
    FUNCTION SchedLegal(
	    VAR Schedule: ScheduleType;	    
		StartDay, EndDay: DayType;  
		FirstHour, LastHour: 	    
			HourType): boolean;
	VAR
	    ConflictFound: boolean;	    
	    DayScan: DayType;		    
	    HourScan: HourScanType;	    
	BEGIN
	    
	    DayScan := StartDay;
	    ConflictFound := FALSE;
	    REPEAT
		
		HourScan := FirstHour;
		WHILE NOT ConflictFound AND
				(HourScan <= LastHour) DO BEGIN
		    
		    ConflictFound :=
			    Schedule[HourScan, DayScan] <> NotScheduled;

		    
		    HourScan := HourScan + 1
		END;

		
		DayScan := succ(DayScan)
	    UNTIL ConflictFound OR (DayScan > EndDay);

	    
	    SchedLegal := NOT ConflictFound
	END; 

    
    PROCEDURE SetSchedPart(
	    VAR Schedule: ScheduleType;	    
		Employee: EmployeeType;	    
		StartDay, EndDay: DayType;  
		FirstHour, LastHour:	    
				HourType);
	VAR
	    DayScan: DayType;		    
	    HourScan: HourType;		    
	BEGIN
	    FOR DayScan := StartDay TO EndDay DO
		FOR HourScan := FirstHour TO LastHour DO
		    Schedule[HourScan, DayScan] := Employee
	END; 

    
    PROCEDURE DoSched(
	    VAR Schedule: ScheduleType);    
	VAR
	    Employee: EmployeeType;	    
	    StartDay, EndDay: DayType;	    
	    StartHour, EndHour: HourType;   
	    Error: boolean;		    
	BEGIN
	    
	    ReadString(Employee);

	    
	    ReadSchedClrArgs(StartDay, EndDay, StartHour, EndHour, Error);

	    
	    IF Error THEN
		writeln('*** Un-recognized day code.  ',
		    'Command not performed. ***')
	    ELSE 
		
		IF SchedLegal(Schedule, StartDay, EndDay,
					StartHour, EndHour) THEN
		    BEGIN
			
			SetSchedPart(Schedule, Employee,
				StartDay, EndDay, StartHour, EndHour);
			writeln('>>> ', Employee, ' scheduled. <<<')
		    END
		ELSE 
		    
		    writeln('*** Conflicts with existing schedule.  ',
			'Command not performed. ***')
	END; 

    
    PROCEDURE DoClear(
	    VAR Schedule: ScheduleType);    
	VAR
	    StartDay, EndDay: DayType;	    
	    StartHour, EndHour: HourType;   
	    Error: boolean;		    
	BEGIN
	    
	    ReadSchedClrArgs(StartDay, EndDay, StartHour, EndHour, Error);

	    
	    IF Error THEN
		writeln('*** Un-recognized day code.  ',
		    'Command not performed. ***')
	    ELSE 
		BEGIN
		    SetSchedPart(Schedule, NotScheduled, StartDay, EndDay,
			StartHour, EndHour);
		    writeln('>>> Clear performed. <<<');
		END 
	END;

    
    PROCEDURE DoUnsched(
	    VAR Schedule: ScheduleType);	
	VAR
	    Employee: EmployeeType;		
	    Day: DayType;			
	    Hour: integer;			
	    Found: boolean;			
	BEGIN
	    
	    readln(Employee);

	    
	    Found := FALSE;
	    FOR Day := Sun TO Sat DO
		FOR Hour := FirstHour TO LastHour DO
		    IF Schedule[Hour, Day] = Employee THEN 
			BEGIN
			    
			    Schedule[Hour, Day] := NotScheduled;

			    
			    Found := TRUE 
			END;

	    
	    IF Found THEN 
		write('>>> ', Employee, ' removed from schedule. <<<')
	    ELSE
		write('>>> ', Employee, 
				    ' was not on the schedule. <<<')
	END; 

    
    PROCEDURE DoPrint(
	    VAR Schedule: ScheduleType);	
	VAR
	    Hour: HourType;			
	    Day: DayType;			

	
	FUNCTION Map24to12(HourType: HourType): integer;
	    BEGIN
		IF Hour < 13 THEN
		    Map24to12 := Hour
		ELSE
		    Map24to12 := Hour - 12
	    END;
	BEGIN
	    readln;
	    WriteDaysHeader;

	    FOR Hour := FirstHour TO LastHour DO
		BEGIN
		    write(Map24to12(Hour):2, ':00 ');
		    FOR Day := Sun TO Sat DO
			write(Schedule[Hour, Day], 
			    ' ': TableDayWidth - length(Schedule[Hour, Day]));
		    writeln
		END
	END;

    
    PROCEDURE DoTotal(
	    VAR Schedule: ScheduleType);	
	VAR
	    Employee: EmployeeType;		
	    Day: DayType;			
	    Hour: integer;			
	    Total: integer;			
	BEGIN
	    
	    readln(Employee);

	    
	    Total := 0;
	    FOR Day := Sun TO Sat DO
		FOR Hour := FirstHour TO LastHour DO
		    IF Schedule[Hour, Day] = Employee THEN
			Total := Total + 1;

	    
	    writeln('>>> ', Employee,
		' is scheduled for ', Total:1, ' hours. <<<<')
	END; 

    

    BEGIN
        
        SetSchedPart(Schedule, NotScheduled, Sun, Sat, FirstHour, LastHour);
 
        
	write('==> ');
    	ReadString(Command);
	KeepRunning := TRUE;
        WHILE KeepRunning DO
	    BEGIN
		IF Command = 'sched' THEN 
            	    DoSched(Schedule)
		ELSE IF Command = 'clear' THEN
		    DoClear(Schedule)
		ELSE IF Command = 'unsched' THEN
		    DoUnsched(Schedule)
		ELSE IF Command = 'print' THEN
         	    DoPrint(Schedule)
		ELSE IF Command = 'total' THEN
		    DoTotal(Schedule)
		ELSE IF Command = 'quit' THEN 
		    BEGIN
			writeln;
			writeln('>>> Program terminating. <<<');
			KeepRunning := FALSE
		    END
		ELSE
		    
		    BEGIN
			readln;
			writeln;
			writeln('*** Command ', Command, 
						    ' not recognized. ***');
		    END;

		
		write('==> ');
		ReadString(Command)
	    END
    END.