home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol023 / confer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  6.0 KB  |  235 lines
  1. PROGRAM CONFERENCE;
  2. (*********************************************************
  3.  *                             *
  4.  *             CHAIRING A CONFERENCE         *
  5.  *                             *
  6.  *    VERSION                         *
  7.  *     1.0     8 Nov 78                 *
  8.  *         ELECTRONIC DESIGN # 23             *
  9.  *     1.1    October 1979                 *
  10.  *         Entered by R.E. Penley             *
  11.  *         PASCAL/Z by ITHACA INTERSYSTEMS     *
  12.  *         Modifications were made to the         *
  13.  *         following procedures:             *
  14.  *          INPUT, CHECK, CONVERT, & CORRECT     *
  15.  *     1.2    9 Oct 79                 *
  16.  *         Added Instructions             *
  17.  *     1.3    13 Oct 79                 *
  18.  *         Modified CHECK to invalidate illegal     *
  19.  *         entries by Negating the current entry     *
  20.  *                             *
  21.  *********************************************************)
  22. CONST
  23.   TTYWIDTH = 80;
  24.   PAPERLINES = 24;
  25.  
  26. TYPE
  27.   DAYTYPE = (MONDAY, TUESDAY, WEDNESDAY);
  28.   WORD    = ARRAY [1..10]  OF CHAR;
  29.  
  30. VAR
  31.   TOPIC : ARRAY [MONDAY..WEDNESDAY, 1..4]  OF INTEGER;
  32.   SUBJ    : ARRAY [MONDAY..WEDNESDAY, 1..4]  OF WORD;
  33.   DAY        : DAYTYPE;
  34.   CH        : CHAR;
  35.   J        : INTEGER;
  36.   ERROR, DONE    : BOOLEAN;
  37. (*********************************************************)
  38. PROCEDURE INIT;
  39. BEGIN
  40.   FOR DAY:=MONDAY TO WEDNESDAY DO
  41.     FOR J:=1 TO 4 DO TOPIC [DAY, J] := 0
  42. END;
  43.  
  44. PROCEDURE INPUT;
  45. VAR
  46.    A1,B1,C1,D1 : INTEGER;
  47.  
  48.     PROCEDURE PUT( DAY0 : DAYTYPE);
  49.     (* Read Values into A1,B1,C1 & D1.
  50.        Data must be in the range 1..6  *)
  51.     BEGIN
  52.       READLN(A1, B1, C1, D1);
  53.       WRITELN;
  54.       IF (A1<1) OR (A1>6) OR (B1<1) OR (B1>6) OR
  55.          (C1<1) OR (C1>6) OR (D1<1) OR (D1>6)
  56.          THEN    DONE := FALSE
  57.          ELSE    BEGIN
  58.             DONE := TRUE;
  59.             TOPIC [DAY0, 1] := A1;
  60.             TOPIC [DAY0, 2] := B1;
  61.             TOPIC [DAY0, 3] := C1;
  62.             TOPIC [DAY0, 4] := D1
  63.                END(* IF *)
  64.     END(* PUT *);
  65.  
  66. BEGIN (*** Input ***)
  67.   WRITELN;
  68.   REPEAT
  69.     WRITE('Enter Topics for Monday    >');
  70.     PUT(MONDAY)
  71.   UNTIL DONE;
  72.    REPEAT
  73.      WRITE('Enter Topics for Tuesday   >');
  74.      PUT(TUESDAY)
  75.    UNTIL DONE;
  76.      REPEAT
  77.        WRITE('Enter Topics for Wednesday >');
  78.        PUT(WEDNESDAY)
  79.      UNTIL DONE
  80. END(* INPUT *);
  81.  
  82. PROCEDURE CLEAR;
  83. BEGIN WRITE( CHR(26) ) END;
  84.  
  85. PROCEDURE SPACE(WIDTH : INTEGER);
  86. BEGIN WRITE(' ':WIDTH) END;
  87.  
  88. PROCEDURE INSTRUCT;
  89. BEGIN
  90. CLEAR;
  91. WRITELN;WRITELN;
  92. SPACE(15);WRITELN('Conference Scheduling Program');
  93. WRITELN;WRITELN;
  94. WRITELN('   This program will prepare a schedule for a three');
  95. WRITELN('day conference. You may list four topics for each');
  96. WRITELN('day of the conference. There will be a total of six');
  97. WRITELN('topics. Each topic should be scheduled twice.');
  98. WRITELN('   Any entry scheduled more than twice will be rejected.');
  99. WRITELN('A program will be printed out leaving blanks where');
  100. WRITELN('entries were rejected. You may then input your corrections.');
  101. WRITELN('   Once you''ve made all corrections, the final schedule');
  102. WRITELN('will be printed out and your conference is ready.');
  103. WRITELN;
  104. WRITELN('   When prompted enter four numbers for the day''s topics');
  105. SPACE(12);WRITELN( '1..Software');
  106. SPACE(12);WRITELN( '2..Hardware');
  107. SPACE(12);WRITELN( '3..Systems');
  108. SPACE(12);WRITELN( '4..Production');
  109. SPACE(12);WRITELN( '5..Sales');
  110. SPACE(12);WRITELN( '6..Repairs');
  111. WRITELN;WRITELN
  112. END;
  113.  
  114. PROCEDURE CONVERT;
  115. (*    CONVERTS TOPIC # TO ASCII SUBJECT
  116.     INVALID ENTRIES ARE BLANKED OUT
  117. *)
  118. VAR    DAYSTOPICS : INTEGER;
  119. BEGIN
  120.   FOR DAY:=MONDAY TO WEDNESDAY DO
  121.     FOR J:=1 TO 4 DO
  122.      BEGIN
  123.     DAYSTOPICS := TOPIC [DAY,J] ;
  124.       CASE DAYSTOPICS OF
  125.        1:    SUBJ [ DAY,J ] :='SOFTWARE  ';
  126.        2:    SUBJ [ DAY,J ] :='HARDWARE  ';
  127.        3:    SUBJ [ DAY,J ] :='SYSTEMS   ';
  128.        4:    SUBJ [ DAY,J ] :='PRODUCTION';
  129.        5:    SUBJ [ DAY,J ] :='SALES     ';
  130.        6:    SUBJ [ DAY,J ] :='REPAIRS   ';
  131.     ELSE:    (* All other cases are invalid *)
  132.         SUBJ [ DAY,J ] :='          '
  133.     END(* CASE *)
  134.      END(* FOR DAY,J *)
  135. END(* CONVERT *);
  136.  
  137. PROCEDURE CORRECT;
  138. VAR    LINE    : WORD;
  139.  
  140.     PROCEDURE CORRECTONE( DAY1 : DAYTYPE);
  141.     (* Read Values into B & C.
  142.        Data must be in the range 1..6  *)
  143.     VAR    B, C : INTEGER;
  144.     BEGIN
  145.       WRITE('       Session #   >');
  146.       READLN(B);
  147.       WRITE('       Topic       >');
  148.       READLN(C);
  149.       TOPIC [DAY1, B] := C
  150.     END;
  151.  
  152. BEGIN
  153.   WRITELN;
  154.   WRITELN('Blanks indicate illegal entries.');
  155.   WRITELN('Enter Carriage return when done.');
  156.   DONE := FALSE;
  157.   REPEAT
  158.     LINE := '          ';
  159.     WRITELN;
  160.     WRITE('Enter:  Day        >');
  161.     READLN(LINE);
  162.      IF LINE[1] = ' '  (* CARRIAGE RETURN WILL RETURN A NULL *)
  163.     THEN DONE := TRUE
  164.     ELSE CASE LINE[1] OF
  165.           'M':    CORRECTONE(MONDAY);
  166.           'T':    CORRECTONE(TUESDAY);
  167.           'W':    CORRECTONE(WEDNESDAY);
  168.           ELSE:    (* CHECK THAT THE TURKEY
  169.                DIDN'T ENTER SOMETHING ELSE *)
  170.             DONE := TRUE
  171.                END(* CASE CH *)
  172.   UNTIL DONE;
  173. WRITELN
  174. END(* CORRECT *);
  175.  
  176. PROCEDURE CHECK;
  177. CONST
  178.     VALID = 2; (* MAX NUMBER OF VALID TOPICS ALLOWED *)
  179. VAR
  180.     NUM : ARRAY [1..6]  OF INTEGER;
  181.     INDEX : INTEGER;
  182. BEGIN
  183.   ERROR:=FALSE;
  184.   FOR J:=1 TO 6 DO   (* INITIALIZE TOPIC COUNTER *)
  185.      NUM [J] :=0;
  186.   FOR DAY:=MONDAY TO WEDNESDAY DO
  187.     FOR J:=1 TO 4 DO
  188.       BEGIN
  189.     INDEX := ABS( TOPIC[DAY,J] );
  190.     NUM [ INDEX ] := NUM [ INDEX ] +1;
  191.     IF NUM [ INDEX ] > VALID
  192.       THEN  BEGIN
  193.           ERROR:=TRUE;
  194.           (* INVALIDATE ILLEGAL ENTRIES BY NEGATION *)
  195.           TOPIC [DAY, J] := -TOPIC [DAY, J];
  196.         END(*IF*)
  197.       END(*FOR DAY,J*);
  198.   IF ERROR THEN  CONVERT
  199. END(* CHECK *);
  200.  
  201. PROCEDURE LIST;
  202. BEGIN
  203.   WRITELN;WRITELN;
  204.   SPACE(8);WRITELN('Monday':15, 'Tuesday':14, 'Wednesday' );
  205.   WRITELN;WRITELN;
  206.   FOR J:=1 TO 4 DO
  207.     BEGIN
  208.       WRITE(J:2, '     ');
  209.       FOR DAY:=MONDAY TO WEDNESDAY DO
  210.        WRITE(SUBJ [DAY, J] :15);
  211.       WRITELN
  212.       END(* FOR J *);
  213.     (* SCROLL UP THE PROGRAM PRINTOUT *)
  214.   IF NOT ERROR THEN
  215.     FOR J:=(PAPERLINES-10) DOWNTO 0 DO WRITELN
  216. END(* LIST *);
  217. (*********************************************************)
  218. BEGIN    (*** Main program ***)
  219.   INIT;
  220.   INSTRUCT;
  221.   INPUT;
  222.   CONVERT;
  223.   CHECK;
  224.   IF ERROR THEN
  225.     REPEAT
  226.       LIST;
  227.       CORRECT;
  228.       CONVERT;
  229.       CHECK
  230.     UNTIL NOT ERROR;
  231.   WRITELN(' Schedule is good');
  232.   FOR J:=1 TO 2500 DO; (* SHORT DELAY *)
  233.   LIST
  234. END(*** CONFERENCE ***).
  235.