hedgewars/uRandom.pas
author nemo
Sun, 26 Dec 2010 00:28:23 -0500
changeset 4686 3682db294dae
parent 4665 fa7ad5f3725f
child 4976 088d40d8aba2
permissions -rw-r--r--
remove all screwing about with uLandGraphics - have not found a way to properly handle LandBackTex through despeckling or fill checks that does not result in ugly fire damage or wiped out landbacktex. Would rather some snowflakes lines than that.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     1
(*
1066
1f1b3686a2b0 Update copyright headers a bit
unc0rr
parents: 920
diff changeset
     2
 * Hedgewars, a free turn based strategy game
3236
4ab3917d7d44 Update (c) lines to 2010 as unc0rr requested - they all had varying values so I just took the first year mentioned, then tacked on -2010
nemo
parents: 3038
diff changeset
     3
 * Copyright (c) 2004-2010 Andrey Korotaev <unC0Rr@gmail.com>
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     4
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
     8
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    12
 * GNU General Public License for more details.
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    13
 *
183
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    14
 * You should have received a copy of the GNU General Public License
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    15
 * along with this program; if not, write to the Free Software
57c2ef19f719 Relicense to GPL
unc0rr
parents: 155
diff changeset
    16
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    17
 *)
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    18
2630
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    19
{$INCLUDE "options.inc"}
079ef82eac75 revamped file access and debug display
koda
parents: 2599
diff changeset
    20
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    21
unit uRandom;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    22
interface
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    23
uses uFloat;
2924
908851e59958 Engine:
smxx
parents: 2716
diff changeset
    24
{$INCLUDE "config.inc"}
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    25
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    26
procedure initModule;
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    27
procedure freeModule;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    28
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    29
procedure SetRandomSeed(Seed: shortstring);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    30
function  GetRandom: hwFloat; overload;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    31
function  GetRandom(m: LongWord): LongWord; overload;
915
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    32
function  rndSign(num: hwFloat): hwFloat;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    33
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    34
implementation
3295
ced0ee8280ad fix building without DEBUGFILE
koda
parents: 3284
diff changeset
    35
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    36
var cirbuf: array[0..63] of Longword;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    37
    n: byte;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    38
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    39
function GetNext: Longword;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    40
begin
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    41
n:= (n + 1) and $3F;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    42
cirbuf[n]:=
105
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    43
           (cirbuf[(n + 40) and $3F] +           {n - 24 mod 64}
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    44
            cirbuf[(n +  9) and $3F])            {n - 55 mod 64}
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    45
            and $7FFFFFFF;                       {mod 2^31}
136
89970b70b076 Implement bot levels
unc0rr
parents: 130
diff changeset
    46
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    47
GetNext:= cirbuf[n]
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    48
end;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    49
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    50
procedure SetRandomSeed(Seed: shortstring);
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    51
var i: Longword;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    52
begin
155
401f4ea24715 Engine can generate land preview and send it via IPC
unc0rr
parents: 136
diff changeset
    53
n:= 54;
401f4ea24715 Engine can generate land preview and send it via IPC
unc0rr
parents: 136
diff changeset
    54
124
75b892eff74d Fixed PRNG to properly use seed string
unc0rr
parents: 107
diff changeset
    55
if Length(Seed) > 54 then Seed:= copy(Seed, 1, 54); // not 55 to ensure we have odd numbers in cirbuf
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    56
527
e23490ce1f06 - One more land template
unc0rr
parents: 431
diff changeset
    57
for i:= 0 to Pred(Length(Seed)) do
e23490ce1f06 - One more land template
unc0rr
parents: 431
diff changeset
    58
    cirbuf[i]:= byte(Seed[i + 1]);
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    59
124
75b892eff74d Fixed PRNG to properly use seed string
unc0rr
parents: 107
diff changeset
    60
for i:= Length(Seed) to 54 do
4665
fa7ad5f3725f Make basic training solvable again. Freeze RNG at current version for less of this kind of issue in future, and a bit more savable of seeds. Disable offsets in preparation for release.
nemo
parents: 4363
diff changeset
    61
    cirbuf[i]:= $A98765 + 68; // odd number
130
19e3c16fb9f0 Fix engine PRNG (accidentally deleted a line)
unc0rr
parents: 124
diff changeset
    62
19e3c16fb9f0 Fix engine PRNG (accidentally deleted a line)
unc0rr
parents: 124
diff changeset
    63
for i:= 0 to 1023 do GetNext
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    64
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    65
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    66
function GetRandom: hwFloat;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    67
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    68
GetNext;
918
c8cff180da57 - Small optimization to hwFloat
unc0rr
parents: 916
diff changeset
    69
GetRandom.isNegative:= false;
c8cff180da57 - Small optimization to hwFloat
unc0rr
parents: 916
diff changeset
    70
GetRandom.QWordValue:= GetNext
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    71
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    72
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    73
function GetRandom(m: LongWord): LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    74
begin
105
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    75
GetNext;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    76
GetRandom:= GetNext mod m
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    77
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    78
915
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    79
function rndSign(num: hwFloat): hwFloat;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    80
begin
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    81
num.isNegative:= odd(GetNext);
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    82
rndSign:= num
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    83
end;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    84
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    85
procedure initModule;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    86
begin
2948
3f21a9dc93d0 Replace tabs with spaces using 'expand -t 4' command
unc0rr
parents: 2924
diff changeset
    87
    n:= 54;
3369
c7289e42f0ee add other controls for map preview, also fix a bug in digest
koda
parents: 3295
diff changeset
    88
    FillChar(cirbuf, 64*sizeof(Longword), 0);
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    89
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    90
3038
4e48c276a468 In pascal unit is a namespace
unc0rr
parents: 2948
diff changeset
    91
procedure freeModule;
2716
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    92
begin
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    93
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    94
end;
b9ca1bfca24f complete the replacement of init/free wrappers for every unit
koda
parents: 2699
diff changeset
    95
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    96
end.