{ Written by Vadim Rumyantsev, 2:5030/48.4. }
{ Generic DELAY unit -- release  timeslices }
{ if under OS/2 2.0, Windows 3.0, DesqView, }
{ DoubleDOS and probably DOS 5.0 (?!), else }
{ do nothing.                               }
{ It is assumed that program  receives time }
{ quantums every day...  so, don't run this }
{ unit on slow systems!   ;-)               }
{ You may use this **without restrictions** }


{$I MKB.DEF}

UNIT USLDelay;

INTERFACE

procedure Delay (n : longint);

IMPLEMENTATION

{$IFDEF VIRTUALPASCAL}
uses VpSysLow;
procedure Delay;
  begin
    SysCtrlSleep( n );    { The delay of the operating system is very good }
  end;

{$ELSE}
uses Dos;



{ Define Seg0040 for backward compatibility with TP 4.0 .. TP 6.0 }

{$IFDEF MSDOS}
  {$IFNDEF DPMI}
    const Seg0040 = $0040;
  {$ENDIF}
{$ENDIF}

var
  sys : (STANDARD, OS2, DESQVIEW, DOUBLEDOS);
  r   : Registers;

procedure Delay;
const
  TicksPerDay = 1572480;

var
  DelayQnt : longint;
  DoneTime : longint;
  DateFlag : boolean;
  nh, nl   : word;

begin

  if sys = OS2 then begin
    nh := n shr 16;
    nl := n and $FFFF;
    asm
      mov    dx, nh;
      mov    ax, nl;
      hlt;
      db     $35,$CA
    end;
    exit
  end;

  DoneTime := Mem [Seg0040:$006C];                   { What time is it?     }
  DelayQnt := round (n / 1000 * 18.2);               { How many ticks wait? }
  DateFlag := (DoneTime + DelayQnt) >= TicksPerDay;  { Skip midnight?       }
  DoneTime := (DoneTime + DelayQnt) mod TicksPerDay; { When we'll finish?   }

  while (DateFlag or (Mem [Seg0040:$006C] < DoneTime)) do

    if Mem [Seg0040:$006C] < DoneTime then   { A new day! }
      DateFlag := false;

    { Release timeslice }

    case sys of

      STANDARD:
        asm
          mov AX,1680h
          Int 2Fh
        end;

      DESQVIEW:
        asm
          mov AX,1000h;
          Int 15h
        end;

      DOUBLEDOS:
        begin
          if DelayQnt > 767 then
            nl := $FF
          else
            nl := DelayQnt div 3;
          nl:=nl*3;
          asm
            mov  AH, 0EEh
            mov  dx, word ptr DelayQnt
            sub  dx, nl
            Int  21h
          end
        end

    end

end;



BEGIN

  { Check for Novell NetWare to eliminate conflict with DoubleDOS detection }

  asm
    mov  ax, 0DC00h
    Int  21h
    test al,al
    jnz @netw_found

    { NetWare is not installed, so we can check for DoubleDOS }

    mov  AX,0E400h
    Int  21h

    test al,al
    jz @netw_found
    { Yes, DoubleDos }
    mov sys, DOUBLEDOS
    jmp @ende
    @netw_found:

    { Check for DesqView }

    mov AX, 1022h
    xor BX,BX
    Int 15h

    jz @no_desq
    { Yes, DesqView or TopView }
    mov sys, DESQVIEW;
    jmp @ende

    @no_desq:
    { Check for OS/2 }

    mov AX, 4010h
    xor bx, bx
    Int 2Fh

    cmp bh,20
    jb @no_os2
    mov sys, os2
    jmp @ende

    @no_os2:
    mov sys,standard

    @ende:
  end;
{$ENDIF}

END.