(*********************************************************************
 *                                                                   *
 *  :Program.    TimerSupport.mod                                    *
 *  :Author.     Hartmut Höhn                                        *
 *  :Address.    Friedenstraße 1                                     *
 *  :Address.    6255 Dornburg 5                                     *
 *  :shortcut.   []                                                  *
 *  :Version.    1.0                                                 *
 *  :Date.       27.12.88                                            *
 *  :Copyright.  PD                                                  *
 *  :Language.   Modula-II                                           *
 *  :Translator. M2Amiga                                             *
 *  :update.     -     					             *
 *                                                                   *
 *********************************************************************)


IMPLEMENTATION MODULE TimerSupport;

(* Copyright (c) in 1988 by Hartmut Höhn *)

FROM Arts        IMPORT Assert;
FROM SYSTEM      IMPORT ADR,LONGSET;
FROM Timer       IMPORT timerName,microHz,vBlank,TimeRequest,TimeVal,
                        getSysTime,setSysTime,addRequest,TimeRequestPtr;
FROM ExecSupport IMPORT CreatePort,DeletePort,CreateExtIO,DeleteExtIO;
FROM Exec        IMPORT MsgPortPtr,DoIO,IOStdReqPtr,OpenDevice,CloseDevice;
FROM MODIV       IMPORT Div;

VAR   TimerPort     : MsgPortPtr;
      myVal         : TimeVal;
      reqPtr        : TimeRequestPtr;
      Monate        : ARRAY[0..11] OF INTEGER;
      i             : INTEGER;

CONST micProSek    = 1000000;        (* Anzahl der MicroSek pro Sekunde *)

      sekProMin    = 60;             
      sekProStunde = 60*60;          (* Definitionen der *)
      sekProTag    = 60*60*24;       
      sekProJahr   = 60*60*24*365;   (* Sekunden pro Zeiteinheit *)
      sekProSJahr  = 60*60*24*366;

PROCEDURE CloseTimer;
 BEGIN
  CloseDevice(reqPtr);
  DeleteExtIO(reqPtr);
  DeletePort(TimerPort);
 END CloseTimer;

PROCEDURE OpenTimer(mode : BOOLEAN);
 VAR  myMode : INTEGER;
 BEGIN
  IF mode THEN
   myMode := vBlank;
  ELSE;
   myMode := microHz;
  END;
 
  TimerPort := CreatePort(ADR("MyTimer"),0);
  Assert(TimerPort#NIL,ADR("Kann TimerPort nicht öffnen !!"));
  reqPtr    := CreateExtIO(TimerPort,SIZE(TimeRequest));
   IF reqPtr = NIL THEN
    DeletePort(TimerPort);
    Assert(FALSE,ADR("Kann ExtIO nicht öffnen"));
   END; 
  OpenDevice(ADR(timerName),myMode,reqPtr,LONGSET{});
 END OpenTimer;

PROCEDURE TimerWait(Sek,micr : LONGINT);
BEGIN
  WITH myVal DO
   secs  := Sek;
   micro := micr;
  END;
  
  WITH reqPtr^ DO
    node.command := addRequest;
    time := myVal;
  END;

  DoIO(reqPtr);
END TimerWait; 

PROCEDURE GetTimeLong(VAR Sek,micr : LONGINT);
 BEGIN 
   WITH reqPtr^ DO
    node.command := getSysTime;
    time := myVal;
   END;
 
   DoIO(reqPtr);
 
   WITH reqPtr^.time DO
    Sek  := secs;
    micr := micro; 
   END; 
END GetTimeLong;

PROCEDURE GetTime(VAR Jahr,Monat,Tag,Stunde,Minute,Sekunde : LONGINT);
 
 VAR zw,n : LONGINT;
      Va  : TimeVal;
BEGIN
 GetTimeLong(Sekunde,n);
 
 zw := Div(Sekunde,sekProTag);
 DEC(Sekunde,zw*sekProTag);

 Stunde := Div(Sekunde,sekProStunde); 
 DEC(Sekunde,Stunde*sekProStunde);
 Minute := Div(Sekunde,sekProMin);
 DEC(Sekunde,Minute*sekProMin);
 
  n:=zw-2251;
  Jahr:=(4*n+3) DIV 1461;
  n:=n-1461*Jahr DIV 4;
  Jahr:=Jahr+84;
  Monat:=(5*n+2) DIV 153;
  Tag:=n-(153*Monat+2) DIV 5+1;
  Monat:=Monat+3;
  IF (Monat>12) THEN
  	Jahr:=Jahr+1;
        Monat:=Monat-12;
  END; (*IF*)
 
END GetTime;  

PROCEDURE SetTimeLong(Sek,micr: LONGINT);
BEGIN
  WITH myVal DO
   secs  := Sek;
   micro := micr;
  END;  
     
  WITH reqPtr^ DO
    node.command := setSysTime;
    time := myVal;
  END;
 
  DoIO(reqPtr);
END SetTimeLong; 

PROCEDURE Test(VAR was : LONGINT;hoch,tief : LONGINT);
BEGIN
 IF (was > hoch) OR (was < tief) THEN
  was := tief;
 END;
END Test;

PROCEDURE SetTime(Jahr,Monat,Tag,Stunde,Minute,Sekunde : LONGINT);
 VAR zw  : LONGINT;
 BEGIN 
  
  Test(Jahr   ,1999,1978);
  Test(Monat  ,  12,   1);
  Test(Tag    ,  31,   1);
  Test(Stunde ,  23,   0);
  Test(Minute ,  59,   0);
  Test(Sekunde,  59,   0);
  
   zw := 0;DEC(Tag);DEC(Monat);
  
  IF ((Jahr MOD 4) = 0) THEN 
   Monate[1] := 29;
  ELSE
   Monate[1] := 28;
  END; 
   
  FOR i := 1978 TO (Jahr-1) DO
   IF ((i MOD 4) = 0) THEN
    INC(zw,sekProSJahr);
   ELSE
    INC(zw,sekProJahr);
   END;
  END; 
   i := 0;
  
 IF Monat > 0 THEN 
  REPEAT 
   INC(zw,(Monate[i]*sekProTag));
   INC(i);
  UNTIL (i =  Monat);
 END; 
  INC(zw,(Tag*sekProTag));
  INC(zw,(Stunde*sekProStunde));
  INC(zw,(Minute*sekProMin));
  INC(zw,Sekunde);
  
  SetTimeLong(zw,0);

END SetTime;

PROCEDURE SubTime(VAR t1,t2 : TimeVal);
BEGIN
 IF (t2.micro > t1.micro) THEN
  INC(t1.micro,micProSek);
  DEC(t1.secs);
 END;
 DEC(t1.micro-t2.micro);
 IF t1.secs > t2.secs THEN
  DEC(t1.secs,t2.secs);
 ELSE
 END;
END SubTime;

PROCEDURE AddTime(VAR t1,t2 : TimeVal);
 VAR   zw : LONGINT;
 
BEGIN
 t1.micro := t1.micro+t2.micro;
  IF (t1.micro > micProSek) THEN
   zw := Div(t1.micro,micProSek);
   DEC(t1.micro,(zw*micProSek));
   INC(t1.secs,zw);
  END;
 t1.secs  := t1.secs+t2.secs;
 
END AddTime;

PROCEDURE CmpTime(VAR t1,t2 : TimeVal) : INTEGER;
 VAR zur : INTEGER;
BEGIN
 IF (t1.secs > t2.secs) THEN
  zur := 1;
 ELSIF (t1.secs = t2.secs) THEN
  IF (t1.micro > t2.micro) THEN
   zur := 1;
  ELSIF (t1.micro = t2.micro) THEN
   zur := 0;
  ELSE
   zur := -1;
  END;
 ELSE
  zur := -1;
 END;
 RETURN(zur);
END CmpTime;

BEGIN
  
 Monate[0] := 31; Monate[1] := 28; Monate[2] := 31; Monate[3] := 30;
 Monate[4] := 31; Monate[5] := 30; Monate[6] := 31; Monate[7] := 31;
 Monate[8] := 30; Monate[9] := 31; Monate[10] := 30; Monate[11] := 31; 
 
END TimerSupport.