🚀 go-pugleaf

Endlich mal einer den das hier �berhaupt interessiert...
(Echtzeit-Programmierer, wo seid ihr???) Mein Beitrag
weiter unten war ja nicht sehr fruchtbar.

Hier nun die L�sung, bestehend aus den beiden Units
"TimerTic" und "Micro"

Have Fun,
Jens

{ (C) Jens-Erich Lange. Alle Rechte vorbehalten! }
{ http://home.t-online.de/home/dynamo            }
unit TimerTic;

interface


function  TimerTicks : longint;

function  NewTimer(Msek : longint) : longint;
function  TimeOut(Time : longint) : boolean;

procedure WaitTimeOut(Time : longint);
procedure WaitDelay(Msek : longint);


implementation

uses
    Micro;

const
    MaxGap = 60000;
    { Mindestens alle 60 Sek nachschauen! }
    MaxTimer = 86400000;
    { �berlauf des Z�hlers }


function TimerTicks;
begin
    TimerTicks := CurrentMilli;
end;



function NewTimer;
begin
    NewTimer := (CurrentMilli + MSek) mod MaxTimer;
end;



function TimeOut;
var
    t : longint;
    x : longint;
begin
    TimeOut := false;
    t := CurrentMilli;
    x := t - Time;
    if (x >= 0) and (x < MaxGap) then TimeOut := true;
    x := MaxTimer - Time + t;
    if (x >= 0) and (x < MaxGap) then TimeOut := true;
end;



procedure WaitTimeOut;
begin
    repeat
    until TimeOut(Time);
end;



procedure WaitDelay;
var Time : longint;
begin
    Time := NewTimer(Msek);
    WaitTimeOut(Time);
end;



end.


{ (C) Jens-Erich Lange. Alle Rechte vorbehalten! }
{ http://home.t-online.de/home/dynamo            }
unit Micro;

interface

type
    MicroTime = record
        TicValue : longint;
        MicValue : word;
    end;

    MicroClock = record
        Hour     : byte; { 0..23  }
        Minute   : byte; { 0..59  }
        Second   : byte; { 0..59  }
        MilliSec : word; { 0..999 }
        MicroSec : word; { 0..999 }
    end;


function  MTimeToMilli(T : MicroTime) : longint;
function  MTimeToMicro(T : MicroTime) : real;

function  ClockToMilli(C : MicroClock) : longint;
function  ClockToMicro(C : MicroClock) : real;

procedure MicroToClock(M : real; var C : MicroClock);
procedure MTimeToClock(T : MicroTime; var C : MicroClock);

procedure CurrentMTime(var T : MicroTime);
procedure CurrentClock(var C : MicroClock);
function  CurrentMilli : longint;
function  CurrentMicro : real;

procedure MilliDelay(MilliSec : longint);
procedure MicroDelay(MilliSec : real);


implementation

const
    TimerC = $43;
    Timer0 = $40;
    Modus2 = $34;
    Modus3 = $36;
    Faktor = 1193.182;

var
    Ticker   : longint absolute $0040:$006C;
    ExitSave : pointer;


function MTimeToMilli(T : MicroTime) : longint;
begin
    MTimeToMilli := round(((T.TicValue * 65536.0) + T.MicValue) / Faktor);
end;



function MTimeToMicro(T : MicroTime) : real;
begin
    MTimeToMicro := ((T.TicValue * 65536.0) + T.MicValue) / Faktor;
end;



function ClockToMilli(C : MicroClock) : longint;
begin
    with C do ClockToMilli := (longint(Hour) * 3600000) +
                              (longint(Minute) * 60000) +
                              (longint(Second) * 1000)  +
          MilliSec;
end;



function ClockToMicro(C : MicroClock) : real;
begin
    with C do ClockToMicro := (longint(Hour) * 3600000) +
                              (longint(Minute) * 60000) +
                              (longint(Second) * 1000)  +
                               MilliSec +
                              (MicroSec / 1000);
end;



procedure MicroToClock(M : real; var C : MicroClock);
begin
    with C do
    begin
        if (M > 86400000.0) or (M < 0.0) then M := 0.0;
        Hour     := byte(trunc(M / 3600000.0));
        M        := M - (Hour * 3600000.0);
        Minute   := byte(trunc(M / 60000.0));
        M        := M - (Minute * 60000.0);
        Second   := byte(trunc(M / 1000.0));
        M        := M - (Second * 1000.0);
        MilliSec := word(trunc(M));
        MicroSec := word(trunc(frac(M) * 1000.0));
    end;
end;



procedure MTimeToClock(T : MicroTime; var C : MicroClock);
var M : real;
begin
    M := MTimeToMicro(T);
    MicroToClock(M,C);
end;



procedure CurrentMTime(var T : MicroTime);
var
    HIB : byte;
    LOB : byte;
begin
    T.TicValue := Ticker;
    port[TimerC] := 0;
    LOB := port[Timer0];
    HIB := port[Timer0];
    T.MicValue := not (word(HIB) shl 8 + LOB);
    if (Ticker > T.TicValue) and (T.MicValue < 32000) then inc(T.TicValue);
end;



procedure CurrentClock(var C : MicroClock);
var T : MicroTime;
begin
    CurrentMTime(T);
    MTimeToClock(T,C);
end;



function CurrentMilli : longint;
var T : MicroTime;
begin
    CurrentMTime(T);
    CurrentMilli := MTimeToMilli(T);
end;



function CurrentMicro : real;
var T : MicroTime;
begin
    CurrentMTime(T);
    CurrentMicro := MTimeToMicro(T);
end;



procedure MilliDelay(MilliSec : longint);
var
    T0 : MicroTime;
    T1 : longint;
    T2 : longint;
begin
    CurrentMTime(T0);
    T1 := MTimeToMilli(T0);
    repeat
        CurrentMTime(T0);
        T2 := MTimeToMilli(T0);
    until (T2-MilliSec) > T1;
end;



procedure MicroDelay(MilliSec : real);
var
    T0 : MicroTime;
    T1 : real;
    T2 : real;
begin
    CurrentMTime(T0);
    T1 := MTimeToMicro(T0);
    repeat
        CurrentMTime(T0);
        T2 := MTimeToMilli(T0);
    until (T2-MilliSec) > T1;
end;



{$F+}
procedure ExitCode;
begin
    {$IFDEF ShowExit}
        writeln('Micro');
    {$ENDIF}
    ExitProc := ExitSave;
    port[TimerC] := Modus3;
    port[Timer0] := 0;
    port[Timer0] := 0;
end;
{$F-}



begin
    {$IFDEF ShowInit}
        writeln('Micro');
    {$ENDIF}
    ExitSave := ExitProc;
    ExitProc := @ExitCode;
    port[TimerC] := Modus2;
    port[Timer0] := 0;
    port[Timer0] := 0;
end.