hedgewars/uRandom.pas
changeset 102 c45643d3fd78
parent 22 517be8dc5b76
child 105 e7cb9bb4a9de
equal deleted inserted replaced
101:f568cc72ea8c 102:c45643d3fd78
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
    32  *)
    32  *)
    33 
    33 
    34 unit uRandom;
    34 unit uRandom;
    35 interface
    35 interface
    36 uses uSHA;
       
    37 
    36 
    38 procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
    37 procedure SetRandomSeed(Seed: shortstring);
    39 function  GetRandom: real; overload;
    38 function  GetRandom: real; overload;
    40 function  GetRandom(m: LongWord): LongWord; overload;
    39 function  GetRandom(m: LongWord): LongWord; overload;
    41 
    40 
    42 implementation
    41 implementation
    43 var  sc1, sc2: TSHA1Context;
    42 const rndM = 2147483578;
    44      Fill: shortstring;
    43 var cirbuf: array[0..63] of Longword;
       
    44     n: byte;
    45 
    45 
    46 procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
    46 function GetNext: Longword;
    47 begin
    47 begin
    48 SHA1Init(sc1);
    48 n:= (n + 1) and $3F;
    49 SHA1Update(sc1, @Seed, Length(Seed)+1);
    49 cirbuf[n]:=
    50 Fill:= FillBuf
    50            (cirbuf[(n + 40) and $3F] +           {== n - 24 mod 64}
       
    51             cirbuf[(n +  9) and $3F]) mod rndM;  {== n - 55 mod 64}
       
    52             
       
    53 Result:= cirbuf[n]
       
    54 end;
       
    55 
       
    56 procedure SetRandomSeed(Seed: shortstring);
       
    57 var i: Longword;
       
    58 begin
       
    59 for i:= 0 to pred(Length(Seed)) do
       
    60     cirbuf[i]:= byte(Seed[i + 1]) * 35791253;
       
    61 
       
    62 for i:= Length(Seed) to 63 do
       
    63     cirbuf[i]:= i * 23860799;
       
    64 
       
    65 for i:= 0 to 1024 do GetNext;
    51 end;
    66 end;
    52 
    67 
    53 function GetRandom: real;
    68 function GetRandom: real;
    54 var dig: TSHA1Digest;
       
    55 begin
    69 begin
    56 SHA1Update(sc1, @Fill[1], Length(Fill));
    70 Result:= frac( GetNext * 0.0007301 + GetNext * 0.003019)
    57 sc2:= sc1;
       
    58 dig:= SHA1Final(sc2);
       
    59 Result:= frac( dig.LongWords[0]*0.0000731563977
       
    60                + pi * dig.Words[6]
       
    61                + 0.0109070019*dig.Words[9])
       
    62 end;
    71 end;
    63 
    72 
    64 function  GetRandom(m: LongWord): LongWord;
    73 function GetRandom(m: LongWord): LongWord;
    65 var dig: TSHA1Digest;
       
    66 begin
    74 begin
    67 SHA1Update(sc1, @Fill[1], Length(Fill));
    75 Result:= GetNext mod m
    68 sc2:= sc1;
       
    69 dig:= SHA1Final(sc2);
       
    70 Result:= (dig.LongWords[0] + dig.LongWords[2] + dig.LongWords[3]) mod m
       
    71 end;
    76 end;
    72 
    77 
    73 end.
    78 end.