{NEWYEAR written by 

                HORWOOD COMPUTING SERVICES LTD. 
                      77 Capri Ave. N.W.
                       Calgary, Alberta
                       Canada, T2L 0G9
                       (403) 284 -2086
                    on December 31st/1983

 and placed in the Public Domain on March 3 / 1984}

{$include:'pastool1.int'}
{$include:'pastool2.int'}

program newyear (input,output);
  uses pastool1,pastool2;

var
  old_seconds,no_seconds,yearitis,row,col : integer;
  seed : word;
  goodlooking : set of 0..129;
  acolour : integer;

procedure time (var src: string);external;
procedure date (var src: string);external;
          ! TIME and DATE are found in the pascal library but are
          ! not normally linked with programs so they must be 
          ! declared as externals

function rnd : integer;
var temp : integer;
begin
  temp :=  (trunc(random(seed) * 128)) + 1; 
            ! TRUNC is found in the pascal library
                  ! RANDOM is found in pastool2
  if (temp in goodlooking)
  then temp := rnd;
  rnd := temp;
  end;

procedure print_num (number,attribute,row,col:integer);
begin
 set_ibm_attributes(attribute);
          ! set_ibm_attributes is found in pastools1
 scroll_up (0,row,col,row+7,col+7);
          ! scroll_up is found in pastools1, The 0 indicates that
          ! the area should be scrolled up all the way, blanking
          ! the entire window, the first row/col is the upper
          ! left corner, the second is the lower right corner
  case number of
    0: begin  
         gotorc(row,col+2);
           ! gotorc is found in pastools1
         write ('000');
         gotorc(row+1,col);
         write ('00   00');
         gotorc(row+2,col);
         write ('00   00');
         gotorc(row+3,col);
         write ('00   00');
         gotorc(row+4,col);
         write ('00   00');
         gotorc(row+5,col);
         write ('00   00');
         gotorc(row+6,col);
         write ('00   00');
         gotorc(row+7,col+2);
         write ('000');
         end;
    9: begin
         gotorc(row,col+2);
         write ('999');
         gotorc(row+1,col);
         write ('99   99');
         gotorc(row+2,col);
         write ('99   99');
         gotorc(row+3,col+1);
         write ('99999');
         gotorc(row+4,col+5);
         write ('99');
         gotorc(row+5,col+5);
         write ('99');
         gotorc(row+6,col);
         write ('9    99');
         gotorc(row+7,col+1);
         write ('9999');
         end;
    8: begin
         gotorc(row,col+2);
         write ('888');
         gotorc(row+1,col);
         write ('88   88');
         gotorc(row+2,col);
         write ('88   88');
         gotorc(row+3,col+2);
         write ('888');
         gotorc(row+4,col);
         write ('88   88');
         gotorc(row+5,col);
         write ('88   88');
         gotorc(row+6,col);
         write ('88   88');
         gotorc(row+7,col+2);
         write ('888');
         end;
    7: begin
         gotorc(row,col);
         write ('77777777');
         gotorc(row+1,col+5);
         write ('77');
         gotorc(row+2,col+4);
         write ('77');
         gotorc(row+3,col+3);
         write ('77');
         gotorc(row+4,col+2);
         write ('77');
         gotorc(row+5,col+1);
         write ('77');
         gotorc(row+6,col+1);
         write ('77');
         gotorc(row+7,col+1);
         write ('77');
         end;
    6: begin
         gotorc(row,col+2);
         write ('666');
         gotorc(row+1,col);
         write ('66   6');
         gotorc(row+2,col);
         write ('66');
         gotorc(row+3,col);
         write ('66');
         gotorc(row+4,col);
         write ('66666');
         gotorc(row+5,col);
         write ('66   66');
         gotorc(row+6,col);
         write ('66  66');
         gotorc(row+7,col+2);
         write ('66');
         end;
    5: begin
         gotorc(row,col);
         write ('555555');
         gotorc(row+1,col);
         write ('55');
         gotorc(row+2,col);
         write ('55');
         gotorc(row+3,col);
         write ('55555');
         gotorc(row+4,col+4);
         write ('55');
         gotorc(row+5,col+5);
         write ('55');
         gotorc(row+6,col);
         write ('5   55');
         gotorc(row+7,col+1);
         write ('5555');
         end;
    4: begin
         gotorc(row,col+5);
         write ('44');
         gotorc(row+1,col+4);
         write ('444');
         gotorc(row+2,col+3);
         write ('4444');
         gotorc(row+3,col+2);
         write ('44 44');
         gotorc(row+4,col+1);
         write ('44  44');
         gotorc(row+5,col);
         write ('4444444');
         gotorc(row+6,col+5);
         write ('44');
         gotorc(row+7,col+5);
         write ('44');
         end;
    3: begin
         gotorc(row,col);
         write ('3333333');
         gotorc(row+1,col+4);
         write ('33');
         gotorc(row+2,col+3);
         write ('33');
         gotorc(row+3,col+2);
         write ('333');
         gotorc(row+4,col+4);
         write ('33');
         gotorc(row+5,col+5);
         write ('33');
         gotorc(row+6,col+4);
         write ('33');
         gotorc(row+7,col);
         write ('33333');
         end;
    2: begin
         gotorc(row,col+1);
         write ('2222');
         gotorc(row+1,col);
         write ('2    22');
         gotorc(row+2,col+4);
         write ('22');
         gotorc(row+3,col+3);
         write ('22 ');
         gotorc(row+4,col+2);
         write ('22');
         gotorc(row+5,col+1);
         write ('22');
         gotorc(row+6,col);
         write ('22');
         gotorc(row+7,col);
         write ('2222222');
         end;
    1: begin
         gotorc(row,col+2);
         write ('11');
         gotorc(row+1,col+1);
         write ('111');
         gotorc(row+2,col+2);
         write ('11');
         gotorc(row+3,col+2);
         write ('11');
         gotorc(row+4,col+2);
         write ('11');
         gotorc(row+5,col+2);
         write ('11');
         gotorc(row+6,col+2);
         write ('11');
         gotorc(row+7,col);
         write ('111111');
         end;
    otherwise write ('ERROR in printnumber',number);
    end; {case}
  end;

procedure display_count_down (no_seconds : integer);
begin
  if no_seconds > 99 then write ('ERROR in display',no_seconds)
  else
  begin
    if (no_seconds mod 10 = 9) or
       (no_seconds < 10)
    then
    begin
      set_ibm_attributes(rnd);
      scroll_up (0,11,0,18,79)
          ! scroll_up is found in pastools1, The 0 indicates that
          ! the area should be scrolled up all the way, blanking
          ! the entire window, the first row/col is the upper
          ! left corner, the second is the lower right corner
      end;
    row :=  11;
    if no_seconds > 9
    then
    begin
      if (no_seconds mod 10) = 9
      then
      begin
        col := 28;
        print_num ((no_seconds div 10),rnd,row,col);
        end;
      col := 44;
      print_num ((no_seconds mod 10),rnd, row,col);
      end
    else print_num (no_seconds,rnd,11,36);
    end;
  end; {procedure}

procedure print_old_year (yearitis : integer);

begin
  gotorc(6,5);
  write ('It is still:');
  print_num (1,1,9,16);
  print_num (9,1,9,29);
  print_num ((yearitis div 10),1,9,42);
  print_num ((yearitis mod 10),1,9,55);
  end;


procedure print_new_year (yearitis : integer);
var
  seconds, minutes, hours, days : integer;

  procedure print_year;
  var
    attricode3,attricode4 : integer;

  begin  ! note, this procedure takes just under 1 second
         ! to complete (57/60ths of a second aproximately)
    attricode4 := rnd;
    print_num (1,attricode4,9,16);
    print_num (9,attricode4,9,29);
    for attricode3 := 2 to 6 do
    begin
      attricode4 := rnd;
      if attricode3 mod 2 = 0
      then begin
        print_num ((yearitis div 10),attricode4,9,42);
        print_num ((yearitis mod 10),attricode4,9,55);
        end
      else begin
        print_num ((yearitis mod 10),attricode4+128,9,55);
        print_num ((yearitis div 10),attricode4+128,9,42);
        end;
      end;
    end;

begin
  gotorc(6,5);
  write ('HAPPY NEW YEAR');
  for days := 1 to 255 do         ! for the next 255 days
    for hours := 1 to 24 do       ! for each hour in those 255 days
      for minutes := 1 to 60 do   ! for each minute in those hours
        for seconds := 1 to 60 do ! for each second in those minutes
        begin
          if (seconds mod 20) = 0 then print_year;
             ! fudge factor to make every 60 iterations take
             ! very close to 60 seconds
          print_year
          end;
  end;

procedure gettime (var no_seconds,yearitis : integer);

var astring : string (8);
    day     : integer;
function convert (achar : char): integer;
begin
  case achar of
    '1': convert := 1;
    '2': convert := 2;
    '3': convert := 3;
    '4': convert := 4;
    '5': convert := 5;
    '6': convert := 6;
    '7': convert := 7;
    '8': convert := 8;
    '9': convert := 9;
    '0': convert := 0;
    end;
  end;

begin
  date (astring);
  yearitis := (convert (astring[7]) * 10) + convert (astring[8]);
  day := ((convert (astring[1]) * 10 + convert (astring[2])) *
          (convert (astring[4]) * 10 + convert (astring[5])));
  no_seconds := 0 - 1;
  time (astring);
  if (day > 371)  and
     (astring[1] = '2') and
     (astring[2] = '3') and
     (astring[4] = '5') and
     (astring[5] = '9')
  then
  begin
    no_seconds := convert (astring[7]) * 10 + convert (astring[8]);
    no_seconds := 60 - no_seconds;
    end;
  gotorc(24,10); write (astring);
  end; 

begin
  goodlooking := [0,8,16,17,25,34,35,38,39,42,44,46,47,50,51,54,55,58,59,
                 62,63,68,76,80,85,88,93,98,99,102,103,106,107,110,111,
                 114,115,118,119,122,123,126,127,128,129];
  seed := 0;
  acolour := rnd;
  gettime (no_seconds,yearitis);
  set_ibm_attributes  (acolour);
  clrscrn;  ! CLEAR SCREEN is found in pastool1
  print_old_year (yearitis);
  repeat
    gettime (no_seconds,yearitis);
    until (no_seconds < 60) and (no_seconds > -1);
  set_ibm_attributes(rnd);
  scroll_up (7,0,0,18,79);
          ! scroll_up is found in pastools1, The 7 indicates that
          ! the area should be scrolled up 7 lines, blanking the
          ! bottom 7 lines, the first row/col is the upper left
          ! corner, the second is the lower right corner
  if (no_seconds <59) 
  then display_count_down  ((no_seconds div 10) * 10 + 9);
  repeat
    display_count_down (no_seconds);
    old_seconds := no_seconds;
    repeat
      gettime (no_seconds,yearitis);
      until (no_seconds < old_seconds);
    until (no_seconds < 0);
  display_count_down (0);
  set_ibm_attributes  (rnd);
  clrscrn;
  gettime (no_seconds,yearitis);
  print_new_year (yearitis);
  end.