program DELPRAND ;

{ Emulation of BP7 & D3 Randomize and Random in pure Pascal/Delphi,
  to give random results independent of compiler version }

{$I version.pas}
uses
  {$IFDEF DELPHI} SysUtils {$ENDIF}
  {$IFDEF PASCAL} Dos {$ENDIF}
  ;


function LZ(const Q : byte) : string ;
var S : string [3] ;
begin Str(Q:2, S) ; if S[1]=#32 then S[1] := '0' ; LZ := S end {LZ} ;

Const Two32 = 4294967296.0 ;

var RS : {$IFDEF PASCAL} longint {$ENDIF} {$IFDEF DELPHI} comp {$ENDIF} ;
{ N.B. In this program, the types of variables are unusually important }

procedure NextRS ;
const Factor = $08088405 ; Term = 1 ; 
{$IFDEF DELPHI} type T = array [0..1] of longint ; {$ENDIF}
begin
  {$IFDEF PASCAL}
    {$Q-} RS := RS*Factor + Term {$Q+} ;
    {$ENDIF}
  {$IFDEF DELPHI}
    {$Q-} RS := RS*Factor + Term {$Q+} ;
    T(RS)[1] := 0 ; // < May'04 was: RS := RS - Trunc(RS/Two32)*Two32 ;
    {$ENDIF}
  end {NextRS} ;


procedure WriteRS ;
begin
  {$IFDEF PASCAL} Write(RS:14  ) ; {$ENDIF}
  {$IFDEF DELPHI} Write(RS:14:0) ; {$ENDIF}
  end {WriteRS} ;


procedure TryCycle ;
var J, K, L : word ; X, XRand : extended ;
const Q = 1666 { Q^3 > 2^32 } ;
begin
  Writeln(^M^J'Long Test, > 2^32') ;
  Writeln('':18, '------ BORLAND ------    ------- THIS -------   MATCH') ;
  RandSeed := 0 ; RS := 0 ;
  for J := Q downto 0 do begin Write(J:7, #13) ;
    for K := 0 to Q do for L := 0 to Q do begin
      XRand := Random ;
      NextRS ;
      X := RS/Two32 ;
      {$IFDEF PASCAL} if X<0.5 then X := X+0.5 else X := X-0.5 ; {$ENDIF}
      if (X<>Xrand) then begin
        Write(J:5, K:5, L:5, RandSeed:14, XRand:10:6) ;
        WriteRS ; Writeln(X:10:6, X=Xrand:8) ; HALT end ;
      end {K} ;
    end {J} ;
  end {TryCycle} ;


procedure TryRandom ;
var J : word ;
X, XRand : extended ;
begin
  Writeln(^M^J'Can the standard generator be emulated in Random?') ;
  Writeln('      ------ BORLAND ------    ------- THIS -------   MATCH') ;
  RandSeed := 0 ; RS := 0 ;
  for J := 1 to 10 do begin XRand := Random ;
    Write(J:3, RandSeed:14, XRand:10:6) ;
    NextRS ; WriteRS ;
    X := RS/Two32 ;
    {$IFDEF PASCAL} if X<0.5 then X := X+0.5 else X := X-0.5 ; {$ENDIF}
    Writeln(X:10:6, X=Xrand:8) ;
    end ;
  end {TryRandom} ;


procedure TryRandomN ;
var J, JR, JRand : word ; T : extended ;
const M : word = 9753 ;
begin
  Writeln(^M^J'Can the standard generator be emulated in Random(N)?') ;
  Writeln('      ---- BORLAND ----    ----- THIS -----   MATCH') ;
  RandSeed := 0 ; RS := 0 ;
  for J := 1 to 10 do begin JRand := Random(M) ;
    Write(J:3, RandSeed:14, JRand:6) ;
    NextRS ; WriteRS ;
    T := RS/Two32 ;
    if T<0 then T := T+1.0 ;
    JR := Trunc(T*M) ;
    Writeln(JR:6, JR=JRand:8) ;
    end ;
  end {TryRandomN} ;


procedure TryRandomize ;
var J, H, M, S, ss : word ;
T, XT, XR : longint ;
{$IFDEF DELPHI} N : TDateTime ; {$ENDIF}
const
{$IFDEF DELPHI} F = 1000 ; {$ENDIF}
{$IFDEF PASCAL} F = 100 ; {$ENDIF}
type AR = record a, b, c, d : byte end ;
begin

  XR := -1 ; J := 0 ; XT := 0 ;

  Writeln(^M^J'Investigation of Randomize result changes') ;

  {$IFDEF PASCAL}
  Writeln('    csec    Diffcsec   RandSeed ;',
    '     Time     =>     RS      Match') ;
  {$ENDIF}
  {$IFDEF DELPHI}
  Writeln('   Time      ',
    '    msec   Diffmsec;  RandSeed   msec-RandSeed') ;
  {$ENDIF}

  repeat Randomize ;

    if RandSeed<>XR then begin
      {$IFDEF PASCAL} GetTime(                  H, M, S, ss) ; {$ENDIF}
      {$IFDEF DELPHI} N := Time ; DecodeTime(N, H, M, S, ss) ; {$ENDIF}
      T := ((longint(H)*60+M)*60+S)*F + ss { Time in csec or msec } ;
      if J>0 then begin

        {$IFDEF DELPHI} write(N:12:9) ; {$ENDIF}

        write(T:11, T-XT:6, RandSeed:14) ;

        {$IFDEF PASCAL}
        with AR(RS) do begin B := H ; A := M ; D := S ; C := ss end ;
        Write(H:6, ':', M:2, ':', S+ss/F:5:2, RS:13, RS=RandSeed:8) ;
        {$ENDIF}

        {$IFDEF DELPHI}
        Write(T-RandSeed:13) ;
        {$ENDIF}
        Writeln end ;

      XR := RandSeed ;
      XT := T ; Inc(J) end ;

    until J=10 ;

  Writeln(^M^J'In JRS''s Win98,') ;
  {$IFDEF PASCAL}
  Writeln('BP7 : RandSeed changes each 5 or 6 cs; derives from ToD.') ;
  {$ENDIF}

  {$IFDEF DELPHI}
  Writeln('D3 : RandSeed changes each 50 or 60 ms; derives from ToD.',
    ^M^J'Varies with version.  I, in UK Summer, get diffs of 3.6M - GMT?') ;
  {$ENDIF}

  Writeln(^M^J'Above tested in BP7 & D3; algorithm differs.') ;

  end {TryRandomize} ;


BEGIN ;
Writeln('DELPRAND.PAS  www.merlyn.demon.co.uk >= 2004-05-26') ;

if ParamStr(1)='ALL' then begin TryRandom ; TryCycle ; HALT end ;

TryRandom ; TryRandomN ; 

Writeln(^M^J'I believe that the above Random & Random(N), which agree',
  ' in my BP7 & D3,'^M^J'will also agree in D5, D7, and others between.') ;

TryRandomize ;

END.