home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol229 / apc-caln.lbr / CALEND6.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  2007-07-21  |  6.6 KB  |  262 lines
  1. { *************************************************************************
  2.  
  3.      Prints an unlimited number of calendar pages on Epson MX printers.
  4.      Prompts for starting month/year, and the number of months to print.
  5.  
  6.                 by Charlie Godet-Ceraolo
  7.                    2610 Glenwood Road
  8.                    Brooklyn, NY 11210
  9.  
  10.   *************************************************************************}
  11.  
  12. PROGRAM CALEND6;
  13. CONST
  14.     Esc      = #27;
  15.     FormFeed = #12;
  16.  
  17. TYPE
  18.     MonthType = (JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC);
  19.     DOWType   = (SUN,MON,TUE,WED,THU,FRI,SAT);
  20.     YearType  = 1583..9999;
  21.     MonArray  = ARRAY[0..11] OF STRING[9];
  22.     MonthDays = SET OF MonthType;
  23.  
  24. CONST
  25.     Days31     : MonthDays = [JAN,MAR,MAY,JUL,AUG,OCT,DEC];
  26.     Days30     : MonthDays = [APR,JUN,SEP,NOV];
  27.     MonthNames : MonArray = ( 'JANUARY','FEBRUARY','MARCH',
  28.                               'APRIL','MAY','JUNE','JULY',
  29.                               'AUGUST','SEPTEMBER','OCTOBER',
  30.                               'NOVEMBER','DECEMBER');
  31.  
  32.  
  33. VAR
  34.     Count,L     : INTEGER;
  35.     Day_Of_Week : DOWType;
  36.     Month       : MonthType;
  37.     New_Month   : BOOLEAN;
  38.     Pr          : TEXT;
  39.     Year        : YearType;
  40.  
  41. PROCEDURE Print_Month(Month : MonthType;
  42.                       Year  : YearType;
  43.                       VAR Day_Of_Week : DOWType);
  44.  
  45. CONST
  46.     Bar      = #156;
  47.     MaxLines =    8;
  48.     Tab      =   #9;
  49.  
  50. VAR
  51.     Day_Of_Month,
  52.     Days_In_Month : 1..32;
  53.     J             : INTEGER;
  54.     X             : DOWType;
  55.  
  56. PROCEDURE Init_Month;
  57. BEGIN
  58.     IF Month IN Days31 THEN Days_In_Month := 31
  59.     ELSE IF Month IN Days30 THEN Days_In_Month := 30
  60.     ELSE BEGIN  { February }
  61.         Days_In_Month := 28;
  62.         IF Year MOD 4 = 0 THEN
  63.             IF Year MOD 100 <> 0 THEN Days_In_Month := 29
  64.             ELSE IF Year MOD 400 = 0 THEN Days_In_Month := 29;
  65.     END;
  66. END; { Init_Month }
  67.  
  68. PROCEDURE Print_Margin;
  69. BEGIN
  70.     WRITE(Pr,Tab);
  71. END; { Print_Margin }
  72.  
  73. PROCEDURE Print_Dashes;
  74. CONST
  75.     DASH10 = '----------';
  76.  
  77. BEGIN
  78.     Print_Margin;
  79.     FOR X := SUN TO SAT DO WRITE(Pr,Bar,DASH10);
  80.     WRITELN(Pr,Bar);
  81. END; { Print_Dashes }
  82.  
  83. PROCEDURE Start_Line2;
  84. BEGIN
  85.     Print_Margin;
  86.     Day_Of_Month := 1;
  87.     FOR X := SUN TO SAT DO
  88.         IF X < Day_Of_Week THEN WRITE(Pr,Bar,Tab)
  89.     ELSE BEGIN
  90.         WRITE(Pr,Bar,Day_Of_Month:3,Tab);
  91.         Day_Of_Month := Day_Of_Month + 1;
  92.     END;
  93.     WRITELN(Pr,Bar);
  94. END; { Start_Line2 }
  95.  
  96. PROCEDURE Print_Middle;
  97. BEGIN
  98.     Print_Margin;
  99.     FOR X := SUN TO SAT DO
  100.         IF Day_Of_Month > Days_In_Month THEN WRITE(Pr,Bar,Tab)
  101.         ELSE BEGIN
  102.            WRITE(Pr,Bar,Day_Of_Month:3,Tab);
  103.            Day_Of_Month := Day_Of_Month + 1;
  104.            Day_Of_Week := X;
  105.         END;
  106.     WRITELN(Pr,Bar);
  107. END; { Print_Middle }
  108.  
  109. PROCEDURE Print_Rest;
  110. VAR
  111.    Y : INTEGER;
  112.  
  113. BEGIN
  114.     FOR Y := 1 TO MaxLines DO BEGIN
  115.         Print_Margin;
  116.         FOR X := SUN TO SAT DO WRITE(Pr,Bar,Tab);
  117.         WRITELN(Pr,Bar);
  118.     END;
  119. END; { Print_Rest }
  120.  
  121. PROCEDURE Print_Header;
  122. BEGIN
  123.     Print_Margin; WRITE(Pr,Esc,'W',CHR(1));    { Wide Print }
  124.     WRITE(Pr,MonthNames[ORD(Month)] : 35);
  125.     WRITELN(Pr,Year:5); WRITE(Pr,Esc,'W',CHR(0)); WRITELN(Pr);
  126.     WRITE(Pr,'   ');
  127.     WRITE(Pr,'SUN':6,Tab);
  128.     WRITE(Pr,'MON':6,Tab);
  129.     WRITE(Pr,'TUE':6,Tab);
  130.     WRITE(Pr,'WED':6,Tab);
  131.     WRITE(Pr,'THU':6,Tab);
  132.     WRITE(Pr,'FRI':6,Tab);
  133.     WRITE(Pr,'SAT':6,Tab);
  134.     WRITELN(Pr);
  135. END; { Print_Header }
  136.  
  137. BEGIN { Print_Month }
  138.     New_Month := TRUE;
  139.     Init_Month;
  140.     Print_Header;
  141.     FOR J := 1 TO 6 DO BEGIN
  142.         Print_Dashes;
  143.         IF New_Month THEN Start_Line2 ELSE Print_Middle;
  144.         New_Month := FALSE;
  145.         Print_Rest;
  146.     END;
  147.     Print_Dashes;
  148. END; { Print_Month }
  149.  
  150. PROCEDURE Reset_Printer;
  151. BEGIN
  152.     WRITE(Pr,Esc,'@');
  153.     CLOSE(Pr);
  154. END; { Reset_Printer }
  155.  
  156. PROCEDURE Get_Month;
  157. TYPE
  158.     MonListType = STRING[36];
  159.  
  160. CONST
  161.     MonList : MonListType = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
  162.  
  163. VAR
  164.     M : STRING[3];
  165.     X : BYTE;
  166.  
  167. BEGIN
  168.     WRITELN;
  169.     WRITELN('[Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec]');
  170.     WRITE('Starting Month: ');
  171.     READLN(M);
  172.     IF M = '' THEN BEGIN
  173.         LowVideo;
  174.         HALT;
  175.     END;
  176.     FOR X := 1 TO LENGTH(M) DO M[X] := UPCASE(M[X]);
  177.     X := POS(M,MonList);
  178.     IF X = 0 THEN Get_Month
  179.     ELSE Month := MonthType((X - 1) DIV 3);
  180. END; { Get_Month }
  181.  
  182. PROCEDURE Get_Year;
  183. BEGIN
  184.     WRITELN;
  185.     WRITELN('[Four digit Year between 1593 and 9999]');
  186.     WRITE('Starting Year: '); READLN(Year);
  187.     IF (Year < 1583) OR (Year > 9999) THEN Get_Year;
  188. END; { Get_Year }
  189.  
  190. PROCEDURE Get_Count;
  191. BEGIN
  192.     WRITELN;
  193.     WRITE('Number of months to print [greater than zero]: ');
  194.     READLN(Count);
  195.     IF Count < 1 THEN Get_Count;
  196. END; { Get_Count }
  197.  
  198. PROCEDURE Get_DOW(Y : YearType; M : MonthType);
  199. VAR
  200.     X,Century,Year,Month,Day : INTEGER;
  201.  
  202. BEGIN
  203.     Year  := Y;
  204.     Month := ORD(M) + 1;
  205.     Day   := 1;
  206.     Month := Month - 2;
  207.     IF Month < 1 THEN BEGIN
  208.         Month := Month + 12;
  209.         Year  := Year - 1;
  210.     END;
  211.     Century := Year DIV 100;
  212.     Year    := Year MOD 100;
  213.     X       := ((26*Month-2) DIV 10 + Day + Year + Year DIV 4
  214.                  + Century DIV 4 - (Century * 2)) MOD 7;
  215.     Day_Of_Week := DOWType(X);
  216. END; { Get_DOW }
  217.  
  218. PROCEDURE Init_Printer;
  219. VAR
  220.     X,Y : INTEGER;
  221.  
  222. BEGIN
  223.     ASSIGN(Pr,'LST:');
  224.     REWRITE(Pr);
  225.     WRITE(Pr,Esc,'O');           { SKIP Off }
  226.  
  227.     { Set up tabstops for doing the spacing }
  228.  
  229.     Y := 3;
  230.     WRITE(Pr,Esc,'D'); WRITE(Pr,CHR(Y));
  231.     FOR X := 0 TO 7 DO WRITE(Pr,CHR(Y+(11*X)));
  232.     WRITE(Pr,CHR(0));
  233.     WRITE(Pr,Esc,'G');           { Double Strike }
  234. END; { Init_Printer }
  235.  
  236.  
  237. BEGIN { MAIN }
  238.     ClrScr;
  239.     WRITELN('Calendar Version 2.1');
  240.     WRITELN('Prints a calendar from a given starting Month');
  241.     WRITELN('for as many months as desired');
  242.     WRITELN;
  243.     REPEAT
  244.         Get_Month; Get_Year; Get_Count;
  245.         Get_DOW(Year,Month);
  246.         Init_Printer;
  247.         FOR L := 1 TO Count DO BEGIN
  248.             Print_Month(Month,Year,Day_Of_Week);
  249.             IF Month = DEC THEN BEGIN
  250.                 Month := JAN;
  251.                 Year  := Year + 1;
  252.             END
  253.             ELSE Month := SUCC(Month);
  254.             IF Day_Of_Week = SAT THEN Day_Of_Week := SUN
  255.             ELSE Day_Of_Week := SUCC(Day_Of_Week);
  256.             WRITE(Pr,FormFeed);
  257.         END;
  258.         WRITELN;
  259.         Reset_Printer;
  260.     UNTIL FALSE;          { Exit in Get_Month on Null }
  261. END.
  262.