Program DCF77;
{***************************************************************************}
{**                                                                       **}
{**      Programm:           DCF77 fuer DOS                               **}
{**      Datum,Vers.:        Oktober 1998 Version siehe const             **}
{**      Programmiert:       Manuel Magnin, Morgentalstr. 44 8355 Aadorf  **}
{**      Souce:              Geschrieben in Turbo-Pascal Version 4.0      **}
{**                                                                       **}
{**      Copyright:          SYSTEM-CLINCH, Postfach 159                  **}
{**                          8355 Aadorf, Schweiz                         **}
{**                                                                       **}
{***************************************************************************}
{                                                                           }
{  Adressen:      COM-1      $03F8          Zum Chip Intell 8250            }
{                 COM-2      $02F8                                          }
{                 COM-3      $03E8                                          }
{                 COM-4      $02E8                                          }
{                                                                           }
{---------------------------------------------------------------------------}
{                                                                           }
{  Pinbelegung: DB25      1: (Geh„use Erde)    6: /DSR     Inp              }
{                         2: TxD      Out      7: GND      Logik            }
{                         3: RxD      Inp      8: /DCD     Inp              }
{                         4: /RTS     Out     20: /DTR     Out              }
{                         5: /CTS     Inp     22: /RI      Inp              }
{                                                                           }
{  Pinbelegung: DB9       1: /DCD     Inp      6: /DSR     Inp              }
{                         2: RxD      Inp      7: /RTS     Out              }
{                         3: TxD      Out      8: /CTS     Inp              }
{                         4: /DTR     Out      9: /RI      Inp              }
{                         5: GND      Logik                                 }
{                                                                           }
{---------------------------------------------------------------------------}
{                                                                           }
{                                                                           }
{---------------------------------------------------------------------------}
{  Funktionsweise:                                                          }
{                                                                           }
{---------------------------------------------------------------------------}
{                                                                           }
{---------------------------------------------------------------------------}

{$M $800,0,0}                            { 2K stack, no heap }
{$F+}                                    { FAR Pointer erzwingen }

Uses DOS,Crt;

Const        Vers              = 'V0.03';
             TDCountMax        = 4;
             ESC               = 27;
             Uhr               = $70;     { Adresse der Uhr MC146818 }
             TiHz              = 18.2064; { Frequenz Timer in Hz }
             TiMem             = $46c;    { RAM 3 Byte Uhr }
             DatMem            = $bf0;    { RAM 17 Byte Datum & Tabelle }
             DualPort          = $180;    { RAM f�r Debug Software }

Type         TimeDate_   = Record
             D,Mo, H,Mi,S      : Byte;
             Y                 : Word;
end;

Var          COM_ADR           : Array[1..4] of Word Absolute $0040:0000;
                                { COM1 := $03F8, COM2 := $02F8, COM3 := $03e8, com4 := $2e8 }
             COM               : Word;
             Ch                : Char;
             Adr               : Word;
             Po                : Word;
             Daten             : String[61];
             Ti                : LongInt;
             ErrPuls,ErrSek,ErrAnz,ErrPar,ErrPak,OKPak     : LongInt;
             TimeDate          : Array[0..TDCountMax] of TimeDate_;
             TDCount           : Word;
             Key               : Char;
             IntVectSave       : Pointer;
             IRQTimer          : LongInt;
             Modus             : Word;


Function AuxInChar(COMNR:Word): Char;
Begin;
  AuxInChar:=Chr(Port[COM_ADR[COMNR]]);
End;

Function AuxInReady(COMNR: Word): Boolean;
Begin;
If (Port[COM_ADR[COMNR]+5] and $01)=1 Then
    AuxInReady := True
  Else
    AuxInReady := False;
End;

Function BCD(Bin : Word):Word;                   { Umwandlung nach BCD f�r Uhr }
Begin;
  BCD := (Bin Mod 10) + (Bin Div 10)*16;         { Je 4 Bit pro Ziffer }
End;

Procedure SetTime_(H,M,S,SS:Word);               { Erforderlich da im Interrupt keine Bios aufrufe erlaubt sind }
Var PackTime : LongInt;
Begin;
  Port[Uhr]  :=0;                                { CMOS Setup Zeit einstellen }
  Port[Uhr+1]:=BCD(S);                           { Uhr l„uft in BCD Code }
  Port[Uhr]  :=2;
  Port[Uhr+1]:=BCD(M);
  Port[Uhr]  :=4;
  Port[Uhr+1]:=BCD(H);
  PackTime   := M*6+H*360;                       { MS-DOS Zeit einstellen }
  PackTime   := Round(PackTime*TiHz*10);         { Erst jetzt mal 10 da M*60+H*3600 > 65535 Turbo nimmt Word zum Rechnen }
  MEM[0:TiMem]   := PackTime And $ff;            { 24-Bit Counter 0-1.573.032 = 1 Tag }
  MEM[0:TiMem+1] := (PackTime shr 8) And $ff;
  MEM[0:TiMem+2] := (PackTime shr 16) And $ff;
End;

Procedure SetDate_(Y,M,D:Word);                  { Erforderlich da im Interrupt keine Bios aufrufe erlaubt sind }
var PackDate : LongInt;
    I        : Word;
Begin;
  Port[Uhr]  :=7;                                { CMOS Setup Datum einstellen }
  Port[Uhr+1]:=BCD(D);                           { Datum l„uft im BCD Modus }
  Port[Uhr]  :=8;
  Port[Uhr+1]:=BCD(M);
  Port[Uhr]  :=9;
  Port[Uhr+1]:=BCD(Y Mod 100);
  PackDate   := 6574+D;                          { 6575 Tage f�r 1.1.98 seit 1.1.80 }
  If M>1 Then Begin;                             { ohne januar }
    For I:=0 To M-2 Do Begin;
      PackDate := PackDate + mem[0:DatMem+6+I];  { Tage je Woche Liste }
    End;
  End;
  PackDate := PackDate + (Y-1998)*365;           { Jahr dazu rechnen }
  PackDate := PackDate + ((Y-1997) shr 2);       { Schaltjahr korrektur }
  mem[0:DatMem]   := PackDate And $ff;           { Zwei Bytes f�r Tage }
  mem[0:DatMem+1] := (PackDate Shr 8) And $ff;
  mem[0:DatMem+4] := Y Div 100;                  { Zwei Bytes f�r Jahr }
  mem[0:DatMem+5] := Y Mod 100;
  { mem[0:$bf6] bis mem[0:$c01]=Tage je Monat 31,28,31,30,31,... }
End;

Function Str_(S:Word):String;                   { Als Funktion wegen R�ckgabewert }
Var St    : String[6];
Begin;
  Str(S,St);
  Str_ := St;
End;

Function Bin(Wert:Word):String;
Var I:Word;
    S:String;
Begin;
  S:='';
  For I:=1 To 8 Do Begin;;
    S:=Chr((Wert Mod 2)+48)+ S;
    Wert := Wert Shr 1;
  End;
  Bin := S;
End;

Function Dez(Wert:String):Word;
Var I,II,D:Word;
Begin;
  D := 0;
  I := 1;
  II := Ord(Wert[0]);
  While II>0 Do Begin;
    {D := D + Abs((Ord(Wert[II])-48) * I);          { Immer Abst�rze ??? }
    If Wert[II]='1' Then D := D + I;
    I := I Shl 1;
    Dec(II);
  End;
  Dez := D;
End;


Procedure Check;
Var I : Word;
    Ok : Boolean;
Begin;
    If Po=58 Then Begin;
      Ok := True;
      For I:=0 To TDCountMax-1 Do Begin;                  { Alle Messungen aufeinander folgend }
        If TimeDate[I].Y  <> TimeDate[I+1].Y  Then Ok := False;
        If TimeDate[I].Mo <> TimeDate[I+1].Mo Then Ok := False;
        If TimeDate[I].D  <> TimeDate[I+1].D  Then Ok := False;
        If TimeDate[I].H  <> TimeDate[I+1].H  Then Ok := False;
        If TimeDate[I].Mi+1 <> TimeDate[I+1].Mi Then Ok := False;
        If (TimeDate[I].Y <1998) Or (TimeDate[I].Y > 2050) Then Ok := False;
      End;
      If Ok Then Begin;                                   { Setzen der Zeit, Datum und Ausgeben }
         SetTime_(TimeDate[TDCountMax].H,TimeDate[TDCountMax].Mi,TimeDate[TDCountMax].S,0);
         SetDate_(TimeDate[TDCountMax].Y,TimeDate[TDCountMax].Mo,TimeDate[TDCountMax].D);
      End;
    End;
    If (IRQTimer-Ti > 30) Or (Po>58) Then Begin;{1 Sek =98-99, 2 Sek= 198}
    If Po<>58 Then Inc(ErrAnz);                { Fehler Anz. Bits im Frame }
    TimeDate[TDCount].H := DEZ(Copy(Daten,26,2))*10 + DEZ(Copy(Daten,28,4));
    TimeDate[TDCount].Mi := DEZ(Copy(Daten,33,3))*10 + DEZ(Copy(Daten,36,4));
    TimeDate[TDCount].S := 0;
    TimeDate[TDCount].D := DEZ(Copy(Daten,19,2))*10 + DEZ(Copy(Daten,21,4));
    TimeDate[TDCount].Mo := DEZ(Copy(Daten,11,1))*10 + DEZ(Copy(Daten,12,4));
    TimeDate[TDCount].Y := DEZ(Copy(Daten,3,4))*10 + DEZ(Copy(Daten,7,4)) + 1900;
    If DEZ(Copy(Daten,3,4))<>9 Then TimeDate[TDCount].Y := TimeDate[TDCount].Y +100;
    Inc(TDCount);
    If TDCount > TDCountMax Then TDCount := 0;
    If Po<>58 Then Inc(ErrPak);
    If Po=58 Then Inc(OKPak);
  End;
  If (Ord(Ch)<>$00) And (Ord(Ch)<>$80) And (Ord(Ch)<>$C0) And (Ord(Ch)<>$E0) And (Ord(Ch)<>$F0) And
    (Ord(Ch)<>$F8) And (Ord(Ch)<>$FC) And (Ord(Ch)<>$FE) Then Inc(ErrPuls);
  If (IRQTimer-Ti<16) Or (IRQTimer-Ti>40) Or
    (IRQTimer-Ti<22) And (IRQTimer-Ti>32) Then Inc(ErrSek);
End;

{$F+}
Procedure TimerHandler; interrupt;
Begin;
    If AuxInReady(COM) Then Begin;                 { Ist ein Zeichen Da? }
{      InLine($FA);                                 {CLI}
      Ch := AuxInChar(COM);                        { Welches Zeichen }
      If Ch >= Chr(128) Then                       { Welches Zeichen 0 oder 1 }
         Daten := '0'+ Daten                       { Daten-Strom erstellen }
      Else
         Daten := '1'+ Daten;                      { Daten-Strom erstellen }
      Check;                                       { Pr�fen ob Zeit aufeinander folgend }
      Inc(Po);                                     { Bit-Zahler }
      If (IRQTimer-Ti > 22) Or (Po>58) Then Begin; { 1 Sek =98-99, 2 Sek= 198}
        Po := 0;                                   { auf 1. Bit warten }
        Daten := '';                               { Datenstrom l”schen }
      End;
      Ti:= IRQTimer;                               { Speichere Momentan }
{      InLine($FB);                                 { STI }
      Mem[0:DualPort]:=Po;                         { Sekunden f�r Debug }
      Mem[0:DualPort+1]:=Ord(Ch);                  { Bit f�r Debug }
    End;
    Inc(IRQTimer);                                 { Z„hler mit 18Hz }
    If IRQTimer<0 Then IRQTimer := 0;              { Make unsigned Timer }
    Mem[0:DualPort+2] := $5A;                      { zum Erkennen ob TSR bereits l„uft }
    Mem[0:DualPort+3] := Round((OKPak)/(OKPak+ErrPak+0.001)*100) And $ff;
End;
{$F-}           {############ AB HIER NICHTS MEHR DAS VIA TSR AUFGERUFFEN WIRD #########}


Procedure FillTitelMaske;
Var Ja,Mo,Ta,H,M,S,SS,I : Word;
Begin;
  GotoXY(25,5);
  GetTime(H,M,S,SS);
  GetDate(Ja,Mo,Ta,S);
  Write(H:2,':',M:2,':',S:2,'  ',Ta:2,'.',Mo:2,'.',Ja:4);
  If Po<>58 Then Begin;
    GotoXY(69-Po,13);                           { ohne Bit 58/59 }
    Write(Daten[1]);                            { Zeige Bit }
  End;
  GotoXY(70,5);
  Write(Bin(Ord(Ch)));
  GotoXY(70,6);
  Write(ErrPuls:8);
  GotoXY(70,7);
  Write(ErrSek:8);
  GotoXY(70,8);
  Write(ErrAnz:8);
  GotoXY(70,9);
  Write(ErrPar:8);
  GotoXY(20,19);
  Write((OKPak)/(OKPak+ErrPak+0.001)*100:7:0,'%');
  GotoXY(20,20);
  Write(OKPak:8);
  GotoXY(20,21);
  Write(ErrPak:8);

  If Po=58 Then Begin;
    GotoXY(12,13);
    Write('..........................................................0');

    GotoXY(25,7);                                 { Letzte gute DCF Zeit }
    Write(TimeDate[TDCountMax].H:2,':');
    Write(TimeDate[TDCountMax].Mi:2,':');
    Write(TimeDate[TDCountMax].S:2,'  ');
    Write(TimeDate[TDCountMax].D:2,'.');
    Write(TimeDate[TDCountMax].Mo:2,'.');
    Write(TimeDate[TDCountMax].Y:4);
  End;

  GotoXY(25,9);                                 { Aktuelle DCF Zeit }
  If TDCount = 0 Then I := TDCountMax Else I:= TDCount -1;
  Write(TimeDate[I].H:2,':');
  Write(TimeDate[I].Mi:2,':');
  Write(TimeDate[I].S:2,'  ');
  Write(TimeDate[I].D:2,'.');
  Write(TimeDate[I].Mo:2,'.');
  Write(TimeDate[I].Y:4);
End;

Procedure TitelMaske;
Begin;
  ClrScr;
  WriteLn(' ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
  WriteLn(' ³    DCF-77 Funkuhr ',Vers,'                              (C) SYSTEM-CLINCH    ³');
  WriteLn(' ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
  WriteLn;
  WriteLn(' Systemzeit:            ST:MI:SE  TA.MO.JAHR             Byte Puls:   ');
  WriteLn('                                                         Puls Fehler: ');
  WriteLn(' letzte gute DCF-Zeit:  ST:MI:SE  TA.MO.JAHR             Sek. Fehler: ');
  WriteLn('                                                         Anz Bit Fehl:');
  WriteLn(' aktuelle DCF-Zeit:     ST:MI:SE  TA.MO.JAHR             Parity Fehler:');
  WriteLn;
  WriteLn('                    1         2         3         4         5');
  WriteLn('          012345678901234567890123456789012345678901234567890123456789');
  WriteLn('          x..........................................................0');
  WriteLn('          SPÀJahrÄÙÀMonÄÙÀÄ´ÀTagÄÙPÀStdÄÙPÀÄMinÄÙ³³³³³³ÀÄÄReserviertÄÙ');
  WriteLn('          ÀÄSyncmarke      ÀÄWochentag           ³³³³³ÀÄReserveantenne');
  WriteLn('                           Start ZeitinformationÄÙ³³³ÀÄÄWechsel Sommer/Winter');
  WriteLn('                           SchaltsekundeÄÄÄÄÄÄÄÄÄÄÙ³ÀÄÄÄSommerzeit    ');
  WriteLn('                                                   ÀÄÄÄÄNormalzeit    ');
  WriteLn(' DCF-Quality:                                                         ');
  WriteLn(' DCF-Pakete OK:                                                       ');
  WriteLn(' DCF-Pakete def:                                                      ');
End;


Begin;
  If (ParamStr(1)='?') Or (ParamStr(1)='/?') Then Begin;
    WriteLn;
    WriteLn('DCF77 Atomuhr Empf„nger f�r DOS   Ver:',Vers);
    WriteLn('(C) 1997 by SYSTEM-CLINCH Aadorf Switzerland');
    WriteLn('Dokumentation:');
    WriteLn('HTTP://WWW.CLINCH.CH/CLINCH/DCF77/DCF77.HTM   MailTo:Info@CLINCH.CH');
    WriteLn;
    WriteLn('Aufruf:');
    WriteLn('DCF77 [COM-PORT (1..4)] [Option]');
    WriteLn('ohne COM-PORT wird COM1 verwendet');
    WriteLn('Option D = Debug Mode');
    WriteLn;
    Halt(1);
  End;
  COM := 1;                                                  { Default MODEM COM }
  If ParamStr(1)='1' Then COM := 1;
  If ParamStr(1)='2' Then COM := 2;
  If ParamStr(1)='3' Then COM := 3;
  If ParamStr(1)='4' Then COM := 4;
  Modus := 0;                                                { Default nicht Debug Mode }
  If (ParamStr(2)='D') or (ParamStr(2)='d') Then Modus := 1; { Modus 0=TSR, 1=DEBUG }

  Port[COM_ADR[COM]+4] := Port[COM_ADR[COM]+4] And 253;      { RTS auf minus}
  Port[COM_ADR[COM]+4] := Port[COM_ADR[COM]+4] Or 1;         { DTR auf plus}

  Port[COM_ADR[COM]+3] := Port[COM_ADR[COM]+3] Or $80;       { Set DLAB Mode 8250 }
  Port[COM_ADR[COM]+0] := 00;                                { Set BAL Divisor }
  Port[COM_ADR[COM]+1] := 09;                                { Set BAH Divisor }
  Port[COM_ADR[COM]+3] := Port[COM_ADR[COM]+3] And $7F;      { Set Normal Mode 8250 }

  Port[COM_ADR[COM]+1] := 00;                                { Set IER all IRQ off }
  Port[COM_ADR[COM]+2] := 01;                                { Set IIR to Pending }
  Port[COM_ADR[COM]+3] := 03;                                { Set LCR No: Brk, Parity & 1 Stop Bit }
 {Port[COM_ADR[COM]+5] := $7b;                               { Set LSR (Read Onely) }
  Port[COM_ADR[COM]+6] := 00;                                { Set MSR }
  Port[COM_ADR[COM]+7] := $7f;                               { Set SCR }

  Daten   := '';                                   { Daten Strom l”schen }
  Po      := 0;                                    { auf 1. Bit warten }
  ErrPuls := 0;                                    { Fehler Z„hler }
  ErrSek  := 0;
  ErrAnz  := 0;
  ErrPar  := 0;
  ErrPak  := 0;
  OKPak   := 0;
  TDCount := 0;                                    { Momentane Aktive Zeile der Tabelle }
  IRQTimer:= 0;                                    { Z„hler der IRQ Schleife 18Hz }
  Ti      := 0;                                    { Speichere Momentan. }
  Key     := 'x';                                  { Abbruch bedingung }

  Mem[0:DualPort+2] := $00;                        { zum Erkennen ob TSR bereits l„uft }
  Delay(100);                                      { nach 100mS sollte }
  If Mem[0:DualPort+2] = $5A Then Begin;
    WriteLn('Sorry DCF77 l„uft bereits');
    Halt(4);
  End;

  If AuxInReady(COM) Then Ch := AuxInChar(COM);    { Testen of DCF Modul da }
  Repeat;
    Delay(100);
    Inc(Ti);
    Write('.');                                    { Scan for char }
  Until AuxInReady(COM) Or (Ti>30);                { DCF Signal schon gekommen }
  WriteLn;                                         { Newline nach Scan ... }
  If Ti>30 Then Begin;                             { Sorry kein DCF Signal }
    WriteLn('Sorry kein DCF77 Signal auf COM',COM,' erkannt');
    WriteLn('DCF77 1 D           ( 1=COM1, D=Debug Mode )');
    {If Modus = 0 Then Halt(3);}
    Delay(4000);
  End;

  GetIntVec($1C,IntVectSave);                      { Alter Vektor retten }
  SetIntVec($1C,Addr(TimerHandler));               { Timer IRQ installieren }
  If Modus=0 Then Begin;                           { TSR Modus }
    WriteLn('DCF77  TSR gestartet an COM',COM);    { Start Resident Msg }
    Keep(0);                                       { Terminate, stay resident }
  End;

  If Modus=1 Then Begin;                           { Debug Modus }
    TitelMaske;                                    { Titel ausgeben }
    Repeat;                                        { Wiederhole bis KeyPressed }
      If KeyPressed Then Key := ReadKey;           { Abbruch bedinung }
      FillTitelMaske;                              { Bild aktualisieren }
      Delay(100);                                  { Damits nicht so flimmert }
    Until Key=Chr(ESC);                            { Ende mit ESC }
  End;

  SetIntVec($01C,IntVectSave);                     { Timer IRQ DeInstall }
End.