home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB15.ZIP / CALENDAR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1986-02-09  |  8.9 KB  |  365 lines
  1. program calendar (input, output);
  2.      const
  3.  
  4.     len = 30;
  5.     lines = 1;
  6.  
  7. type
  8.     months = ( JAN, FEB, MAR, APR, MAY, JUN, JUL, AUG, SEPT, OCT, NOV, DEC);
  9.  
  10.     apptmnt = record
  11.  
  12.          detail : array [1..lines] of string[ len ];
  13.          state  : (in_use, empty);
  14.  
  15.     end;
  16.     strng3 =  string[3];
  17.     strng4 =  string[4];
  18. var
  19.     clndr     : file of apptmnt;
  20.     continue  : boolean;
  21.     days      : array [ months ] of 0..365;
  22.     file_name : string[30];
  23.     menu      : char;
  24.     month     : array [ months ] of string[3];
  25.     year      : string[4];
  26.  
  27. procedure clrscrn;
  28.  
  29. var
  30.     i    : integer;
  31. begin
  32.     for i := 1 to 35 do writeln;
  33. end;
  34.  
  35. procedure init;
  36. begin
  37.     days [ JAN ] := 0  ;
  38.     days [ FEB ] := 31 ;
  39.     days [ MAR ] := 59 ;
  40.     days [ APR ] := 90 ;
  41.     days [ MAY ] := 120;
  42.     days [ JUN ] := 151;
  43.     days [ JUL ] := 181;
  44.     days [ AUG ] := 212;
  45.     days [ SEPT] := 243;
  46.     days [ OCT ] := 273;
  47.     days [ NOV ] := 304;
  48.     days [ DEC ] := 334;
  49.     month [ JAN ] := 'JAN';
  50.     month [ FEB ] := 'FEB';
  51.     month [ MAR ] := 'MAR';
  52.     month [ APR ] := 'APR';
  53.     month [ MAY ] := 'MAY';
  54.     month [ JUN ] := 'JUN';
  55.     month [ JUL ] := 'JUL';
  56.     month [ AUG ] := 'AUG';
  57.     month [ SEPT] := 'SEP';
  58.     month [ OCT ] := 'OCT';
  59.     month [ NOV ] := 'NOV';
  60.     month [ DEC ] := 'DEC';
  61. end;
  62.  
  63. function getkey( month_name : strng3; day : integer ; time : integer; meri : strng4 ) : integer;
  64.  
  65. var
  66.     diff      : 0..12;
  67.     found     : boolean;
  68.     index     : months;
  69.     key       : integer;
  70.  
  71. begin
  72.     index := JAN;
  73.     found := false;
  74.     while ( not found) do
  75.     begin
  76.          if month[ index ] =copy(month_name,1,3)
  77.               then found := true
  78.               else index := succ(index);
  79.     end;
  80.     key := days [index];
  81.     if meri = 'AM'
  82.          then diff :=0
  83.          else diff :=12;
  84.     getkey := key + diff + time;
  85. end;
  86.  
  87. procedure setup;
  88. begin
  89.     file_name := concat('#5:appt',year);
  90.     Assign(clndr, file_name);
  91.     if menu = 'l'
  92.          then rewrite( clndr)
  93.          else reset (clndr);
  94. end;
  95.  
  96. procedure prompt;
  97. begin
  98.     clrscrn;
  99.     gotoxy(10,10); write('Enter Month : ');
  100.     gotoxy(10,11); write('Day         : ');
  101.     gotoxy(10,12); write('Year        : ');
  102.     if menu = '3'
  103.          then exit{(prompt)};
  104.     gotoxy(10,13); write('Time        : ');
  105.     gotoxy(10,14); write('AM or PM    : ');
  106. end;
  107.  
  108. procedure create;
  109.  
  110.   var
  111.    i,j   : integer;
  112.  
  113.  begin
  114.    clrscrn;
  115.    gotoxy( 10, 7);
  116.    write('Enter year : ');
  117.    readln(year);
  118.    for i := 1 to 365 do
  119.      for j := 1 to 24 do
  120.         begin
  121.           clndr^.state := empty;
  122.           put (clndr);
  123.         end;
  124.      gotoxy(10, 7); write('Calendar created.');
  125.      close ( clndr,lock);
  126.    end; {create}
  127.  
  128. procedure remove;
  129. var
  130.     answer      : string[1];
  131.     day         : 1..31;
  132.     i           : integer;
  133.     key         : integer;
  134.     l           : integer;
  135.     meri        : string[2];
  136.     month_name  : string;
  137.     time        : 1..12;
  138. begin
  139.    prompt;
  140.    gotoxy(24,10); readln(month_name);
  141.    gotoxy(24,11); readln(day);
  142.    gotoxy(24,12); readln(year);
  143.    setup;
  144.    gotoxy(24,13); readln(time);
  145.    gotoxy(24,14); readln(meri);
  146.    key := getkey( month_name, day, time, meri);
  147.    seek(clndr, key );
  148.    get(clndr, key );
  149.    get(clndr);
  150.    with clndr^ do
  151.       begin
  152.         if state = in_use
  153.            then
  154.              begin
  155.                 l := 16;
  156.                 for i := 1 to lines do
  157.                   begin
  158.                     gotoxy(1,1);
  159.                     write(detail[i]);
  160.                     l := l+1;
  161.                   end;
  162.                 gotoxy(1, 1+1);
  163.                 write('Are you sure you want to delete (Y/N) : ');
  164.                 readln(answer);
  165.                 if ( answer = 'Y' ) or ( answer = 'y' )
  166.                   then
  167.                     begin
  168.                       seek(clndr,key);
  169.                       state := empty;
  170.                       put(clndr);
  171.                     end;
  172.              end
  173.              else
  174.                begin
  175.                  gotoxy(1,16);
  176.                  write('There is no appointment for that time.');
  177.                  for l := l to 22000 do;   {wait for a while}
  178.                end;  {else}
  179.          end;  {with}
  180.      end;  {remove}
  181. procedure display;
  182.   var
  183.     answer      : string[1];
  184.     day         : 1..31;
  185.     i           : integer;
  186.     key         : integer;
  187.     l           : integer;
  188.     meri        : string;
  189.     month_name  : string;
  190.     outfile     : text;
  191.     time        : 1..12;
  192.  
  193. procedure print;
  194. begin
  195.   rewrite(outfile,'console:');
  196.   for i := 1 to 24 do
  197.   begin
  198.     seek(clndr,key);
  199.     get(clndr);
  200.     if i<= 12
  201.       then
  202.         begin
  203.           time :=i;
  204.           if i = 12
  205.             then
  206.               meri :='noon'
  207.             else
  208.               meri := 'AM';
  209.           end
  210.         else
  211.           begin
  212.             time := i - 12;
  213.             if i = 24
  214.               then
  215.                 meri :='Mid night'
  216.               else
  217.                 meri := 'PM';
  218.             end;
  219.         writeln(outfile,time:2,' ',meri);
  220.         case clndr^.state of
  221.           in_use : for l :=l to lines do
  222.                         writeln(outfile,clndr^.detail[1]);
  223.           empty  : writeln(outfile,'No activity scheduled.');
  224.         end;  {case}
  225.         key := key+1;
  226.       end;
  227.       close(outfile);
  228.     end;  {print}
  229. procedure console;
  230. begin
  231.   clrscrn;
  232.   gotoxy(1,1);
  233.   for i := 1 to 24 do
  234.   begin
  235.     seek(clndr,key);
  236.     get(clndr);
  237.     if clndr^.state = in_use
  238.       then
  239.         begin
  240.           if i > 1
  241.             then
  242.               begin
  243.                 writeln('Press enter key whenever you are ready...');
  244.                 readln(answer);
  245.               end;
  246.           if i <=12
  247.             then
  248.               begin
  249.                 time := i;
  250.                 if time = 12
  251.                   then meri :='noon'
  252.                   else meri :='AM';
  253.               end
  254.             else
  255.               begin
  256.                 time := i- 12;
  257.                 if time = 12
  258.                   then meri :='Mid night'
  259.                   else meri :="PM';
  260.                 end;
  261.             writeln(time:2,' ',meri);
  262.             for l:= 1 to lines do
  263.               writeln(clndr^.detail[1]);
  264.             writeln;
  265.           end;
  266.       key := key+1;
  267.     end;
  268.     writeln;
  269.     writeln('That was it, press enter key any time you are done..');
  270.     readln(answer);
  271.   end;  {console}
  272. begin
  273.   prompt;
  274.   gotoxy(24,10); readln(month_name);
  275.   gotoxy(24,11); readln(day);
  276.   gotoxy(24,12); readln(year);
  277.   setup;
  278.   time :=1;
  279.   meri := 'AM';
  280.   key := getkey( month_name, day, time, meri);
  281.   gotoxy(10,13);
  282.   write('Do you want on the printer (Y/N) ? ');
  283.   readln(answer);
  284.   if (answer = 'y') or (answer='Y')
  285.   then
  286.     print
  287.   else console;
  288. end;  {display}
  289.  
  290. procedure enter;
  291.   var
  292.     answer      : string[1];
  293.     day         : 1..31;
  294.     i           : integer;
  295.     key         : integer;
  296.     meri        : string[2];
  297.     month_name  : string;
  298.     time        : 1..12;
  299. begin
  300.   prompt;
  301.   gotoxy(24,10); readln(month_name);
  302.   gotoxy(24,11); readln(day);
  303.   gotoxy(24,12); readln(year);
  304.   setup;
  305.   gotoxy(24,13); readln(time);
  306.   gotoxy(24,14); readln(meri);
  307.   key := getkey(month_name, day, time, meri);
  308.   clrscrn;
  309.   seek(clndr,key);
  310.   get(clndr);
  311.   if clndr^.state = in_use
  312.     then
  313.       begin
  314.         gotoxy(10,16);
  315.         write('*** WARNING : Press Y to Remove Old Appointment: ');
  316.         if ( answer = 'Y' ) or ( answer = 'y' )
  317.           then exit(enter);
  318.       end;
  319.       seek(clndr,key);
  320.       gotoxy(1,1);
  321.       writeln('Enter up to ',lines:2,' lines of text not more than ',
  322.               'of ',len:2,' characters in each line:');
  323.       i := 1;
  324.       while (i <= lines) do
  325.         begin
  326.           write('> ');
  327.           readln(clndr^.detail[i]);
  328.           i := i+1;
  329.         end;
  330.       clndr^.state := in_use;
  331.       put(clndr);
  332.     end;  {enter}
  333.     
  334.     begin
  335.       init;
  336.       repeat
  337.         if file_name <> ''
  338.         then
  339.           begin
  340.             close (clndr, lock);
  341.             file_name := '';
  342.           end;
  343.         clrscrn;
  344.         gotoxy(15,7); write('CALENDAR MENU');
  345.         gotoxy(11,9); write(' 1) Create a calendar for the year');
  346.         gotoxy(11,10); write(' 2) Enter an appointment');
  347.         gotoxy(11,11); write(' 3) Print daily schedule');
  348.         gotoxy(11,12); write(' 4) Remove an appointment');
  349.         gotoxy(11,13); write(' 5) Stop');
  350.         gotoxy(11,14); write('Enter choice : ');
  351.         gotoxy( 26,14); readln( menu);
  352.         continue := true;
  353.         case menu of
  354.           '1' : create;
  355.           '2' : enter;
  356.           '3' : display;
  357.           '4' : remove;
  358.           '5' : begin
  359.                   continue := false;
  360.                   close( clndr,lock);
  361.                 end
  362.       end;
  363.     until not continue;
  364.   end.
  365.