-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathutils.pas
152 lines (127 loc) · 3.63 KB
/
utils.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
UNIT Utils;
INTERFACE
CONST
M_PI = 3.14159265358979323846;
M_PI2 = M_PI + M_PI;
gamma2_2 = 1.0 / 2.2;
NEARzero = 1.0e-15;
TYPE
FloatType = DOUBLE;
ErandType = WORD;
ERandArray = ARRAY[0..3] OF ErandType;
FUNCTION isZERO(a : FloatType) : boolean; INLINE;
FUNCTION Utils_fabs(value : FloatType) : FloatType;
FUNCTION Utils_clamp(value : FloatType) : FloatType;
FUNCTION Utils_toInt(value : FloatType) : INTEGER; INLINE;
FUNCTION Utils_power(Number, Exponent : FloatType) : FloatType; INLINE;
FUNCTION Utils_erand48(VAR xseed : ERandArray) : FloatType;
FUNCTION Utils_kahanSum(a, b : FloatType) : FloatType;
FUNCTION Utils_kahanSum3(a, b, c : FloatType) : FloatType;
IMPLEMENTATION
USES
math;
CONST
RAND48_MULT_0 : ErandType = ($e66d);
RAND48_MULT_1 : ErandType = ($deec);
RAND48_MULT_2 : ErandType = ($0005);
RAND48_ADD : ErandType = ($000b);
sErandType8 : integer = (sizeof(ErandType) * 8);
VAR
_rand48_mult : ARRAY[0..2] OF ErandType;
_rand48_add : ErandType;
FUNCTION isZERO(a : FloatType) : boolean; INLINE;
BEGIN
result := (a > -NEARzero) AND (a < NEARzero);
END;
FUNCTION Utils_kahanSum3(a, b, c : FloatType) : FloatType;
VAR
sum : FloatType;
cc : FloatType;
y : FloatType;
t : FloatType;
BEGIN
sum := a;
cc := 0.0;
y := b - cc;
t := sum + y;
cc := (t - sum) - y;
sum := t;
y := c - cc;
t := sum + y;
cc := (t - sum) - y;
sum := t;
Utils_kahanSum3 := sum;
END;
// This function doesn't do anything useful except summation
FUNCTION Utils_kahanSum(a, b : FloatType) : FloatType;
VAR
sum : FloatType;
c : FloatType;
y : FloatType;
t : FloatType;
BEGIN
sum := a;
c := 0.0;
y := b - c;
t := sum + y;
c := (t - sum) - y;
sum := t;
Utils_kahanSum := sum;
END;
procedure _dorand48(VAR xseed : ERandArray);
var
accu : Longint;
temp : ARRAY[0..1] OF ErandType;
begin
accu := longint(_rand48_mult[0]) * LongInt(xseed[0]) + LongInt(_rand48_add);
temp[0] := ErandType(accu);
//accu := accu SHR (sizeof(ErandType) * 8);
accu := accu SHR (sErandType8);
accu := accu + (LongInt(_rand48_mult[0]) * LongInt(xseed[1]) + LongInt(_rand48_mult[1]) * LongInt(xseed[0]));
temp[1] := ErandType(accu);
//accu := accu SHR (sizeof(ErandType) * 8);
accu := accu SHR (sErandType8);
accu := accu + (_rand48_mult[0] * xseed[2] + _rand48_mult[1] * xseed[1] + _rand48_mult[2] * xseed[0]);
xseed[0] := temp[0];
xseed[1] := temp[1];
xseed[2] := ErandType(accu);
end;
function Utils_erand48(VAR xseed : ERandArray) : FloatType;
begin
_dorand48(xseed);
Utils_erand48 := ldexp((xseed[0]), -48) + ldexp((xseed[1]), -32) + ldexp(xseed[2], -16);
end;
FUNCTION Utils_fabs(value : FloatType) : FloatType;
BEGIN
IF (value < 0) THEN
Utils_fabs := -value
ELSE
Utils_fabs := value;
END;
FUNCTION Utils_clamp(value : FloatType) : FloatType;
BEGIN
IF value < 0.0 THEN
Utils_clamp := 0.0
ELSE
IF value > 1.0 THEN
Utils_clamp := 1.0
ELSE
Utils_clamp := value;
END;
FUNCTION Utils_power(Number, Exponent : FloatType) : FloatType; INLINE;
BEGIN
IF isZERO(Number) OR isZERO(Exponent) THEN
Utils_power := 0
ELSE
Utils_power := Exp(Exponent * Ln(Number));
END;
FUNCTION Utils_toInt(value : FloatType) : INTEGER; INLINE;
BEGIN
Utils_toInt := round(Utils_power(Utils_clamp(value), gamma2_2) * 255.0 + 0.5);
END;
BEGIN
_rand48_mult[0] := RAND48_MULT_0;
_rand48_mult[1] := RAND48_MULT_1;
_rand48_mult[2] := RAND48_MULT_2;
_rand48_add := RAND48_ADD;
END.