[comp.sources.misc] v03i065: Reagan countdown program for VAX/VMS Pascal

fulton@cookie.dec.com (Roger Fulton CXO1-2/N22 x2146) (06/29/88)

Posting-number: Volume 3, Issue 65
Submitted-by: "Roger Fulton CXO1-2/N22 x2146" <fulton@cookie.dec.com>
Archive-name: rrcount.pas

(* rrcount.pas: Reagan Countdown program
 * 
 * for VAX/VMS Pascal
 *
 * run from your login.com to see each day how many days the gip has left
 *
 * Roger Fulton,     uucp: ...decwrl!cookie.dec.com!fulton
 *               Internet: fulton@cookie.dec.com
 *
 * inspired by the program rrcount.c by Paul Heckbert
 *
 *)
 
program rrcount( output );

const
  num_msgs = 11;

var
  messages : array[1..num_msgs] of varying[30] of char;

value
  messages[1]  := 'President Reagan';
  messages[2]  := 'Ronald Wilson Reagan';
  messages[3]  := 'the Insane Anglo War-Lord';
  messages[4]  := 'Ronnie-boy';
  messages[5]  := 'Ronnie Ray-gun';
  messages[6]  := 'the gipper';
  messages[7]  := 'the geezer';
  messages[8]  := 'Bedtime for Bonzo';
  messages[9]  := 'The Great Communicator';
  messages[10] := 'the jelly bean king';
  messages[11] := 'mr. 3x5 card';


  function mth$random ( %ref $P1 : integer ) : real; extern;
  
  function msg_index : integer;
  
  var
    time_str : packed array [1..11] of char; 
    seed     : integer;			

  begin
    time( time_str ); 					
    seed := ( ord( time_str[11] ) - ord( '0' )) +
            (( ord( time_str[10] ) - ord( '0' )) * 10  );
    msg_index := trunc( mth$random( seed ) * 1000000 ) mod num_msgs + 1;
  end (* msg_index *);
  

  function days_to_go : integer;
  
  var
    date_str  : packed array [1..11] of char;
    cur_month : packed array [1..3] of char;
    day_str   : packed array [1..2] of char;
    day       : integer;
    
  begin
    date( date_str );
    day_str[1] := date_str[1];
    day_str[2] := date_str[2];
    cur_month[1] := date_str[4];
    cur_month[2] := date_str[5];
    cur_month[3] := date_str[6];
    readv( day_str, day );
    if cur_month = 'JUN' then
      days_to_go := 234 - day           (* 204 + 30 - day *)
    else if cur_month = 'JUL' then
      days_to_go := 204 - day           (* 173 + 31 - day *)
    else if cur_month = 'AUG' then
      days_to_go := 173 - day           (* 142 + 31 - day *)
    else if cur_month = 'SEP' then
      days_to_go := 142 - day           (* 112 + 30 - day *)
    else if cur_month = 'OCT' then
      days_to_go := 112 - day           (*  81 + 31 - day *)
    else if cur_month = 'NOV' then
      days_to_go := 81 - day            (*  51 + 30 - day *)
    else if cur_month = 'DEC' then
      days_to_go := 51 - day            (*  20 + 31 - day *)
    else if cur_month = 'JAN' then
      days_to_go := 20 - day;           (*  20      - day *)
  end (* days_to_go *);
    

begin (* rrcount *)
  writeln;
  writeln( days_to_go:1, ' more days of ', messages[msg_index] );
  writeln;
end.