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 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179
| (*HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
P2 / Fonctions de couleur
HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH*)
CONST m = 255; g = 0.700; h = 1 - g; // g = niveau relatif de gris (<= 1)
Lim1 = 0.350; I_Lm1 = 1 / (1 - Lim1);
Lim2 = 0.400; L22 = Lim2 * Lim2; I_L4 = 1 / (L22 * L22);
FUNCTION Fc2(t: Reel): Byte; // t varie entre -1 et +1
VAR s, u, v, w: Reel;
BEGIN
s:= Abs(t);
IF (s<Lim1) THEN BEGIN
u:= Sqr(s / Lim1); w:= g + (h * u)
END
ELSE BEGIN
u:= (s - Lim1) * I_Lm1;
v:= Sqr(u); w:= 1 - v
END;
Result:= Round(m * w)
END;
FUNCTION Fc1(t: Reel): Byte; // t varie entre -1 et +1
VAR u, v, w: Reel;
BEGIN
IF (t<0) THEN BEGIN
u:= Sqr(1 + t); v:= Sqr(u); w:= g * v
END
ELSE IF (t<Lim2) THEN BEGIN
u:= Sqr(Sqr(t)); v:= h * u;
w:= g + (I_L4 * v)
END
ELSE w:= 1;
Result:= Round(m * w)
END;
(*HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
P2 / Procédures et calculs divers
HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH*)
FUNCTION Norme2(V: Vect_2D): Reel;
VAR X2, Y2: Z_32;
BEGIN
X2:= Sqr(V.x); Y2:= Sqr(V.y);
Result:= X2 + Y2
END;
CONST D_Pi = 2 * Pi; H_Pi = Pi / 2;
FUNCTION Angle2Vb(V1, V2: Vect_2D): Reel;
VAR At, Dt, N1N2, N21, N22, p, Ps, q, Theta: Reel; T1, T2: Bool;
BEGIN
N21:= Norme2(V1); N22:= Norme2(V2); N1N2:= Sqrt(N21 * N22);
p:= V1.x * V2.x; q:= V1.y * V2.y; Ps:= p + q;
p:= V1.x * V2.y; q:= V1.y * V2.x; Dt:= p - q;
T1:= (N1N2<1E-18); T2:= (Abs(Ps)<Abs(Dt));
IF T1 THEN Theta:= 0
ELSE IF T2 THEN BEGIN
At:= ArcTan(Ps/Dt);
IF (Dt>0) THEN Theta:= H_Pi - At
ELSE Theta:= -H_Pi - At
END
ELSE BEGIN
At:= ArcTan(Dt/Ps);
IF (Ps>0) THEN Theta:= At
ELSE IF (Dt<0) THEN Theta:= At - Pi
ELSE Theta:= At + Pi
END;
Result:= Theta
END;
PROCEDURE IncR(VAR u: Reel; v: Reel);
VAR w: Reel;
BEGIN
w:= u + v; u:= w
END;
FUNCTION Diff_2V(V1, V2: Vect_2D): Vect_2D;
VAR W12: Vect_2D;
BEGIN
W12.x:= V1.x - V2.x;
W12.y:= V1.y - V2.y; Result:= W12
END;
PROCEDURE ZeroM(VAR Ma: Tab_Pix);
CONST Pzero: Pixel = (150, 0, 150);
VAR i, j: Z_32;
BEGIN
FOR i:= 0 TO Dim_Max DO
FOR j:= 0 TO Dim_Max DO Ma[i, j]:= Pzero
END;
(*HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
P2 / Calcul de la seconde matrice
HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH*)
VAR Nsomm1, Ntour1: Byte;
PROCEDURE Trace_Polygone(Imax: Byte; L_V: Tab_V2d; VAR Ma2: Tab_Pix);
CONST c = 0; Pc: Pixel = (c, c, c);
VAR i, j: Byte; Dx, Dy, k, Npoint, Xm, Ym: Z_32; I_Np, Kx, Ky: Reel;
Ta, Tb: Bool; Px: Pixel;
BEGIN
FOR i:= 1 TO Imax DO
BEGIN
IF (i<Imax) THEN j:= i + 1
ELSE j:= 1;
Dx:= L_V[j].x - L_V[i].x; Dy:= L_V[j].y - L_V[i].y;
Npoint:= 1; Inc(Npoint, Abs(Dx));
Inc(Npoint, Abs(Dy)); I_Np:= 1 / Npoint;
Kx:= Dx / Npoint; Ky:= Dy / Npoint;
FOR k:= 0 TO Npoint DO
BEGIN
Xm:= L_V[i].x; Inc(Xm, Round(k * Kx));
Ym:= L_V[i].y; Inc(Ym, Round(k * Ky));
Ma2[Xm, Ym]:= Pc
END
END
END;
PROCEDURE Calc_Mat_Im2(Ns1, Nt1: Byte; La, Ha: Z_32; VAR Ma1, Ma2: Tab_Pix);
CONST Nmax = 3;
VAR i, j, Ntour: Byte; Xm, Ym: Z_32; Sa, r: Reel;
Vg1, Vg2, Vg: Vect_2D; Px: Pixel;
BEGIN
ZeroM(Matrice_2);
FOR Xm:= 0 TO (La - 1) DO
FOR Ym:= 0 TO (Ha - 1) DO
BEGIN
Sa:= 0; Vg.x:= Xm; Vg.y:= Ym;
FOR i:= 1 TO Ns1 DO
BEGIN
IF (i<Ns1) THEN j:= i + 1
ELSE j:= 1;
Vg1:= Diff_2V(Polygone[i], Vg);
Vg2:= Diff_2V(Polygone[j], Vg);
IncR(Sa, Angle2Vb(Vg1, Vg2));
END;
Ntour:= Round(Sa / D_Pi); r:= Ntour / Nt1;
IF (r> 1) THEN r:= 1;
IF (r<-1) THEN r:= -1;
Px[1]:= Fc1(r); Px[3]:= Fc1(-r);
Px[2]:= Fc2(r); Ma2[Xm, Ym]:= Px
END
END;
PROCEDURE Calc_Pol_10(VAR Ns_1, Nt_1: Byte; La1, Ha1: Z_32; VAR L_V: Tab_V2d); // NmaxV = 10
CONST N1 = 10; f = 0.100;
TYPE TabE = ARRAY[1..N1] OF Byte;
CONST Lx1: TabE = (1, 9, 9, 1, 1, 3, 7, 7, 3, 3); // Polygone crois
Ly1: TabE = (1, 1, 9, 9, 1, 3, 3, 7, 7, 3);
Lx2: TabE = (1, 9, 9, 1, 1, 3, 3, 7, 7, 3); // Polygone non crois
Ly2: TabE = (1, 1, 9, 9, 1, 3, 7, 7, 3, 3);
VAR i: Word; p, q: Reel; V: Vect_2D;
BEGIN
Ns_1:= N1; Nt_1:= 2;
FOR i:= 1 TO N1 DO BEGIN
// p:= f * Lx1[i]; V.x:= Round(La1 * p);
// q:= f * Ly1[i]; V.y:= Round(Ha1 * q);
p:= f * Lx2[i]; V.x:= Round(La1 * p);
q:= f * Ly2[i]; V.y:= Round(Ha1 * q);
L_V[i]:= V
END
END;
PROCEDURE Zero_Pol(VAR Lst_V: Tab_V2d);
VAR i: Byte;
BEGIN
FOR i:= 1 TO NmaxV DO
WITH Lst_V[i] DO BEGIN
x:= 0; y:= 0
END
END; |
Partager