hedgewars/uRandom.pas
author nemo
Sun, 24 Jan 2010 16:46:06 +0000
changeset 2712 8f4527c9137c
parent 2699 249adefa9c1c
child 2716 b9ca1bfca24f
permissions -rw-r--r--
Minor tweak, try to make long flavour text last longer, move the hurt self messages to unused messages group, so they don't get wiped by crate an instant later.
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
393
db01cc79f278 Update copyright information
unc0rr
parents: 351
diff changeset
     3
 * Copyright (c) 2004-2007 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;
2599
c7153d2348f3 move compiler directives to standard pascal
koda
parents: 1066
diff changeset
    24
{$INCLUDE "proto.inc"}
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    25
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    26
procedure init_uRandom;
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    27
procedure SetRandomSeed(Seed: shortstring);
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    28
function  GetRandom: hwFloat; overload;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    29
function  GetRandom(m: LongWord): LongWord; overload;
915
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    30
function  rndSign(num: hwFloat): hwFloat;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    31
{$IFDEF DEBUGFILE}
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    32
procedure DumpBuffer;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    33
{$ENDIF}
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    34
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    35
implementation
915
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    36
{$IFDEF DEBUGFILE}
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    37
uses uMisc;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    38
{$ENDIF}
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    39
var cirbuf: array[0..63] of Longword;
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    40
    n: byte;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    41
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    42
function GetNext: Longword;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    43
begin
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    44
n:= (n + 1) and $3F;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    45
cirbuf[n]:=
105
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    46
           (cirbuf[(n + 40) and $3F] +           {n - 24 mod 64}
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    47
            cirbuf[(n +  9) and $3F])            {n - 55 mod 64}
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    48
            and $7FFFFFFF;                       {mod 2^31}
136
89970b70b076 Implement bot levels
unc0rr
parents: 130
diff changeset
    49
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    50
GetNext:= cirbuf[n]
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    51
end;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    52
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    53
procedure SetRandomSeed(Seed: shortstring);
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    54
var i: Longword;
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    55
begin
155
401f4ea24715 Engine can generate land preview and send it via IPC
unc0rr
parents: 136
diff changeset
    56
n:= 54;
401f4ea24715 Engine can generate land preview and send it via IPC
unc0rr
parents: 136
diff changeset
    57
124
75b892eff74d Fixed PRNG to properly use seed string
unc0rr
parents: 107
diff changeset
    58
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
    59
527
e23490ce1f06 - One more land template
unc0rr
parents: 431
diff changeset
    60
for i:= 0 to Pred(Length(Seed)) do
e23490ce1f06 - One more land template
unc0rr
parents: 431
diff changeset
    61
    cirbuf[i]:= byte(Seed[i + 1]);
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    62
124
75b892eff74d Fixed PRNG to properly use seed string
unc0rr
parents: 107
diff changeset
    63
for i:= Length(Seed) to 54 do
527
e23490ce1f06 - One more land template
unc0rr
parents: 431
diff changeset
    64
    cirbuf[i]:= $A98765 + (cNetProtoVersion * 2); // odd number
130
19e3c16fb9f0 Fix engine PRNG (accidentally deleted a line)
unc0rr
parents: 124
diff changeset
    65
19e3c16fb9f0 Fix engine PRNG (accidentally deleted a line)
unc0rr
parents: 124
diff changeset
    66
for i:= 0 to 1023 do GetNext
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    67
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    68
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    69
function GetRandom: hwFloat;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    70
begin
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    71
GetNext;
918
c8cff180da57 - Small optimization to hwFloat
unc0rr
parents: 916
diff changeset
    72
GetRandom.isNegative:= false;
c8cff180da57 - Small optimization to hwFloat
unc0rr
parents: 916
diff changeset
    73
GetRandom.QWordValue:= GetNext
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    74
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    75
102
c45643d3fd78 New faster random generator
unc0rr
parents: 22
diff changeset
    76
function GetRandom(m: LongWord): LongWord;
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    77
begin
105
e7cb9bb4a9de - Fixed integer->longint
unc0rr
parents: 102
diff changeset
    78
GetNext;
351
29bc9c36ad5f Fixed-point arithmetics in engine.
unc0rr
parents: 320
diff changeset
    79
GetRandom:= GetNext mod m
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    80
end;
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
    81
915
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    82
function rndSign(num: hwFloat): hwFloat;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    83
begin
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    84
num.isNegative:= odd(GetNext);
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    85
rndSign:= num
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    86
end;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    87
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    88
{$IFDEF DEBUGFILE}
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    89
procedure DumpBuffer;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    90
var i: LongInt;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    91
begin
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    92
for i:= 0 to 63 do
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    93
	AddFileLog('[' + inttostr(i) + '] = ' + inttostr(cirbuf[i]))
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    94
end;
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    95
{$ENDIF}
33040b7695c0 - Some changes in clusters initialization
unc0rr
parents: 527
diff changeset
    96
2699
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    97
procedure init_uRandom;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    98
begin
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
    99
	n:= 54;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   100
end;
249adefa9c1c replace initialization/finalization statements with custom init functions
koda
parents: 2630
diff changeset
   101
4
bcbd7adb4e4b - set svn:eol-style to native
unc0rr
parents: 1
diff changeset
   102
end.