home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / TIMEZONE.ARK / TIMEZONE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-27  |  6KB  |  256 lines
  1. program timezone;
  2.  
  3. { program to display the time in cities around the world. }
  4.  
  5. const
  6.   local_city = 'Sydney Australia';
  7.   local_tz = +10;       { GMT + 10 hours }
  8.   century = 1900;       { what century is this - for date function }
  9.   debug = false;
  10.   defaultcityname = 'CITIES.TXT';
  11.   grafixname = 'WORLD.SCN';
  12.  
  13. type
  14.   TimeRec = record
  15.             hour, minute, second: integer;
  16.             weekday, day, month, year: integer;
  17.             end;
  18.   str20 = string[20];
  19.   Cptr = ^citytype;
  20.   citytype = record
  21.                name: str20;
  22.                timezone: integer;
  23.                xpos, ypos: byte;
  24.                next: Cptr;
  25.              end;
  26.   screentype = array [1..2048] of byte;
  27.  
  28. var
  29.   cities,head: cptr;
  30.   i,hours: integer;
  31.   cityfile: text;
  32.   grafixfile: file;
  33.   temp: real;
  34.   tempname: str20;
  35.   scrtemp: screentype;
  36.  
  37. procedure GetTime(var time:TimeRec);
  38.   function GetRegister(reg: byte):byte;
  39.   var
  40.     i:byte;
  41.   begin
  42.     if debug then
  43.     begin
  44.       write ('Register ',reg,' =');
  45.       readln (i);
  46.       GetRegister := i;
  47.     end
  48.     else
  49.     begin
  50.       repeat port [4] := 10 until ((port[7] and 128)=0);
  51.       port[4] := reg;
  52.       i := port[7];
  53.       GetRegister := i - (i div 16) * 6;
  54.     end;
  55.   end;
  56. begin
  57.   with time do
  58.   begin
  59.     second:=GetRegister (0);
  60.     minute:=GetRegister (2);
  61.     hour:=GetRegister (4);
  62.     weekday:=GetRegister (6);
  63.     day:=GetRegister (7);
  64.     month:=GetRegister (8);
  65.     year:=GetRegister (9) + century;
  66.   end;
  67. end;
  68.  
  69. procedure WriteTime (time: TimeRec);
  70. const
  71.   WeekdayName : array [1..7] of string[9] =
  72.                 ('Monday','Tuesday','Wednesday,','Thursday','Friday',
  73.                  'Saturday','Sunday');
  74.   function j(num: byte): byte;
  75.   begin
  76.     if num in [0..9] then write ('0');
  77.     j:=num;
  78.   end;
  79. begin
  80.   with time do
  81.   begin
  82.     write (j(hour),':',j(minute));
  83.  
  84.     { ,':',j(second),'    ');
  85.     write (WeekdayName[weekday],' ',j(day),'/',j(month),'/',year);
  86. }
  87.    end;
  88. end;
  89.  
  90. procedure Regularize (var time:TimeRec);
  91. const
  92.   month_count: array[1..12] of byte = (31,28,31,30,31,30,
  93.                                        31,31,30,31,30,31);
  94. begin
  95.   with time do
  96.   begin
  97.     if (hour > 23) then
  98.     begin
  99.            hour := hour - 24;
  100.            weekday := weekday + 1;
  101.            if (weekday > 7) then weekday := weekday - 7;
  102.            day := day + 1;
  103.  
  104.            if not ( (month = 2) and
  105.                     ((year mod 4) = 0) and ((year mod 400) <> 0) and
  106.                     (day = 29) ) then
  107.            if (day > month_count[month]) then
  108.            begin
  109.              month := month + 1;
  110.              if (month > 12) then
  111.              begin
  112.                month := month - 12;
  113.                year := year + 1;
  114.              end;
  115.              day := 1;
  116.            end;
  117.     end
  118.     else if (hour < 0) then
  119.          begin
  120.            hour := hour + 24;
  121.            weekday := weekday - 1;
  122.            if (weekday < 1) then weekday := weekday + 7;
  123.            day := day - 1;
  124.            if (day < 1) then
  125.            begin
  126.              month := month - 1;
  127.              if (month < 1) then
  128.              begin
  129.                month := month + 12;
  130.                year := year - 1;
  131.              end;
  132.              day := day + month_count [month];
  133.              if (month = 2) then
  134.              begin
  135.                {is year divisible by four?}
  136.                if ((year mod 4) = 0) and ((year mod 400) <> 0) then
  137.                  day := day + 1;
  138.              end;
  139.            end;
  140.          end;
  141.   end; {with}
  142. end;
  143.  
  144. procedure fix_long(var Long: real);
  145. begin
  146.   if (Long < -180) then Long:=Long + 360.0
  147.   else if (Long > 180) then Long:=Long - 360.0
  148. end;
  149.  
  150. procedure print_time (TimeZone: integer;
  151.                       TargetCity: str20;
  152.                       time: TimeRec);
  153. { this procedure will print the time/date at a target city }
  154. begin
  155.  
  156. {  write (TargetCity,' is in timezone GMT');
  157.   if (TimeZone >= 0) then write ('+');
  158.   write (TimeZone,' hours    ');
  159. }
  160.   time.hour := time.hour - local_tz + TimeZone;
  161.   Regularize (time);
  162.  
  163. {  write ('Target time is '); }
  164.  
  165.   WriteTime (time);
  166.   writeln;
  167. end;
  168.  
  169. procedure DisplayTimes (head2: Cptr);
  170. var
  171.   time: TimeRec;
  172.   workptr: Cptr;
  173. begin
  174. {  write ('Local city is ',local_city,', in timezone GMT');
  175.   if (local_tz>=0) then write ('+');
  176.   writeln (local_tz,' hours');
  177.   write ('Current time is ');
  178.   WriteTime (time);
  179.   writeln;
  180. }  workptr:=head2;
  181.   GetTime (time);
  182.   while (workptr <> nil) do
  183.   begin
  184.     gotoxy (workptr^.xpos,workptr^.ypos);
  185.     print_time (workptr^.timezone,workptr^.name,time);
  186.     workptr:=workptr^.next;
  187.   end; {while}
  188.   gotoxy (1,25);
  189.   repeat GetTime(time) until (time.second <> 0);
  190. end;
  191.  
  192. procedure PrintContinuous(head2: Cptr);
  193. var
  194.   time: TimeRec;
  195.   j: byte;
  196. begin
  197.   repeat
  198.   begin
  199.     GetTime (time);
  200.     if (time.second = 0) then DisplayTimes(head2);
  201.     j:=bdos (6,255);
  202.   end {repeat}
  203.   until j=27;
  204. end;
  205.  
  206. begin
  207.   writeln ('Attempting to read city declarations from file');
  208.   assign(cityfile,defaultcityname);
  209.   {$I-}
  210.   reset (cityfile);
  211.   {$I+}
  212.   If IOresult = 0 then
  213.   begin
  214.     cities := nil;
  215.     while not eof (cityfile) do
  216.     begin
  217.       new (head);
  218.       head^.next := cities;
  219.       read (cityfile,temp);
  220.       fix_long(temp);
  221.       head^.timezone:=round (temp / 15.0);
  222.       read (cityfile, head^.xpos, head^.ypos);
  223.       readln (cityfile,tempname);
  224.       head^.name := copy(tempname,2,length(tempname));
  225.       cities := head;
  226.     end;
  227.     close (cityfile);
  228.     assign (grafixfile,grafixname);
  229.     reset (grafixfile);
  230.     blockread (grafixfile,scrtemp,15);
  231.     close (grafixfile);
  232.     for i:=$f810 to $f81f do mem[i]:=$ff;
  233.     for i:=$f820 to $f82f do mem[i]:=$10;
  234.     gotoxy (1,25); {get rid of cursor}
  235.     for i:=1 to 1920 do mem[$0f000+i-1]:=scrtemp[i];
  236.     port [8]:=$40;
  237.     for i:=1 to 1920 do
  238.     begin
  239.       if (scrtemp[i]=$81) then mem[$f800-1+i]:=8+3 else mem[$f800-1+i]:=6;
  240.     end;
  241.     port [8]:=0;
  242.     gotoxy (1,24); write ('World Clock by krd 1991');
  243.     DisplayTimes(head);
  244.     PrintContinuous(head);
  245.     port [8]:=$40;
  246.     for i:=1 to 1920 do
  247.     begin
  248.       mem[$f800+i-1]:=2;
  249.     end;
  250.     clrscr;
  251.   end
  252.   else
  253.   begin
  254.     writeln (defaultcityname,' not found.');
  255.   end;
  256. end.