home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / misc / volume3 / rrcount.pas < prev    next >
Pascal/Delphi Source File  |  1989-02-03  |  3KB  |  108 lines
  1. Path: xanth!mcnc!gatech!ukma!husc6!necntc!ncoast!allbery
  2. From: fulton@cookie.dec.com (Roger Fulton CXO1-2/N22 x2146)
  3. Newsgroups: comp.sources.misc
  4. Subject: v03i065: Reagan countdown program for VAX/VMS Pascal
  5. Message-ID: <8806290257.AA08043@decwrl.dec.com>
  6. Date: 29 Jun 88 03:25:00 GMT
  7. Sender: allbery@ncoast.UUCP
  8. Reply-To: fulton@cookie.dec.com (Roger Fulton CXO1-2/N22 x2146)
  9. Organization: Digital Equipment Corporation
  10. Lines: 95
  11. Approved: allbery@ncoast.UUCP
  12.  
  13. Posting-number: Volume 3, Issue 65
  14. Submitted-by: "Roger Fulton CXO1-2/N22 x2146" <fulton@cookie.dec.com>
  15. Archive-name: rrcount.pas
  16.  
  17. (* rrcount.pas: Reagan Countdown program
  18.  * 
  19.  * for VAX/VMS Pascal
  20.  *
  21.  * run from your login.com to see each day how many days the gip has left
  22.  *
  23.  * Roger Fulton,     uucp: ...decwrl!cookie.dec.com!fulton
  24.  *               Internet: fulton@cookie.dec.com
  25.  *
  26.  * inspired by the program rrcount.c by Paul Heckbert
  27.  *
  28.  *)
  29.  
  30. program rrcount( output );
  31.  
  32. const
  33.   num_msgs = 11;
  34.  
  35. var
  36.   messages : array[1..num_msgs] of varying[30] of char;
  37.  
  38. value
  39.   messages[1]  := 'President Reagan';
  40.   messages[2]  := 'Ronald Wilson Reagan';
  41.   messages[3]  := 'the Insane Anglo War-Lord';
  42.   messages[4]  := 'Ronnie-boy';
  43.   messages[5]  := 'Ronnie Ray-gun';
  44.   messages[6]  := 'the gipper';
  45.   messages[7]  := 'the geezer';
  46.   messages[8]  := 'Bedtime for Bonzo';
  47.   messages[9]  := 'The Great Communicator';
  48.   messages[10] := 'the jelly bean king';
  49.   messages[11] := 'mr. 3x5 card';
  50.  
  51.  
  52.   function mth$random ( %ref $P1 : integer ) : real; extern;
  53.   
  54.   function msg_index : integer;
  55.   
  56.   var
  57.     time_str : packed array [1..11] of char; 
  58.     seed     : integer;            
  59.  
  60.   begin
  61.     time( time_str );                     
  62.     seed := ( ord( time_str[11] ) - ord( '0' )) +
  63.             (( ord( time_str[10] ) - ord( '0' )) * 10  );
  64.     msg_index := trunc( mth$random( seed ) * 1000000 ) mod num_msgs + 1;
  65.   end (* msg_index *);
  66.   
  67.  
  68.   function days_to_go : integer;
  69.   
  70.   var
  71.     date_str  : packed array [1..11] of char;
  72.     cur_month : packed array [1..3] of char;
  73.     day_str   : packed array [1..2] of char;
  74.     day       : integer;
  75.     
  76.   begin
  77.     date( date_str );
  78.     day_str[1] := date_str[1];
  79.     day_str[2] := date_str[2];
  80.     cur_month[1] := date_str[4];
  81.     cur_month[2] := date_str[5];
  82.     cur_month[3] := date_str[6];
  83.     readv( day_str, day );
  84.     if cur_month = 'JUN' then
  85.       days_to_go := 234 - day           (* 204 + 30 - day *)
  86.     else if cur_month = 'JUL' then
  87.       days_to_go := 204 - day           (* 173 + 31 - day *)
  88.     else if cur_month = 'AUG' then
  89.       days_to_go := 173 - day           (* 142 + 31 - day *)
  90.     else if cur_month = 'SEP' then
  91.       days_to_go := 142 - day           (* 112 + 30 - day *)
  92.     else if cur_month = 'OCT' then
  93.       days_to_go := 112 - day           (*  81 + 31 - day *)
  94.     else if cur_month = 'NOV' then
  95.       days_to_go := 81 - day            (*  51 + 30 - day *)
  96.     else if cur_month = 'DEC' then
  97.       days_to_go := 51 - day            (*  20 + 31 - day *)
  98.     else if cur_month = 'JAN' then
  99.       days_to_go := 20 - day;           (*  20      - day *)
  100.   end (* days_to_go *);
  101.     
  102.  
  103. begin (* rrcount *)
  104.   writeln;
  105.   writeln( days_to_go:1, ' more days of ', messages[msg_index] );
  106.   writeln;
  107. end.
  108.