program funkgen; {Funkuhrzeitgenerator}
uses dos;
var
y,mon,d,dow: Word;
h,m,s,s100: Word;
Puls: Boolean;
function CountBits(w:LongInt):Integer;
var
r:Integer;
begin
r:=0;
while w<>0 do begin
if w and 1 <>0 then Inc(r);
w:=w shr 1;
end;
CountBits:=r;
end;
procedure CalcPuls;
var
Min,Std:Word;
Datum: LongInt;
begin
Puls:=false;
if s>58 then exit;
if s100>20 then exit;
if s100<10 then begin Puls:=true; exit; end;
Min:=m div 10 shl 4 or m mod 10;
if CountBits(Min) and 1 <>0 then Min:=Min or $80;
Std:=h div 10 shl 4 or h mod 10;
if CountBits(Std) and 1 <>0 then Std:=Std or $40;
if dow=0 then dow:=7; {Sonntag}
y:=y mod 100;
Datum:=d mod 10 {36-39}
or d div 10 shl 4 {40-41}
or dow shl 6 {42-44}
or mon mod 10 shl 9 {45-48}
or LongInt(mon div 10) shl 13 {49}
or LongInt(y mod 10) shl 14 {50-53}
or LongInt(y div 10) shl 18; {54-57}
if CountBits(Datum) and 1 <>0 then Datum:=Datum or $400000;
case s of
17,20: Puls:=true; {MESZ,Startbit}
21..28: if Min shr (s-21) and 1 <>0 then Puls:=true;
29..35: if Std shr (s-29) and 1 <>0 then Puls:=true;
36..58: if Datum shr (s-36) and 1 <>0 then Puls:=true;
end;
end;
procedure Drehstrich;
begin
write(h:2,':',m:2,':',s:2,':',s100 div 10,#13);
end;
begin
repeat
GetDate(y,mon,d,dow);
GetTime(h,m,s,s100);
CalcPuls;
if Puls then Port[$37A]:=4 else Port[$37A]:=0;
Drehstrich;
until false;
end.
| Detected encoding: ASCII (7 bit) | 2
|