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
| PROGRAM Disposition_Tableaux;
USES Crt, E_Texte;
CONST La0 = 70; Lb0 = 50;
Lc0 = 40; Ld0 = 30;
Lm0 = 500; // Dimensions intrinsques
Et = 8; Em = 6; // Ecarts imposs
La = La0 - Et; Lb = Lb0 - Et; // Dimensions effectives
Lc = Lc0 - Et; Ld = Ld0 - Et;
Lm = (Lm0 + Et) - (2 * Em);
X0 = 5; X1 = X0 + 30; // Directives d'affichage
Y0 = 10; Y1 = Y0 + 3; o = 5;
PROCEDURE AffLtNabcd(Lt, Ka, Kb, Kc,Kd: Word);
VAR d: Reel;
BEGIN
E(0010); We(X1, Y1, Lt, o);
E(0014); Write(Ka:o, Kb:o, Kc:o, Kd:o); E(0700);
d:= (Lm0 - Lt + Et)/2; Wr(X1, Y1 + 3, d, 502)
END;
FUNCTION F_Parite(Ka, Kb, Kc, Kd: Word): Bool;
VAR s: Byte;
BEGIN
s:= Ka MOD 2; Inc(s, Kb MOD 2);
Inc(s, Kc MOD 2); Inc(s, Kd MOD 2);
Result:= (s<2)
END;
PROCEDURE Comparaison(Lt, Ja, Jb, Jc, Jd: Word;
VAR Lt_, Ja_, Jb_, Jc_, Jd_: Word);
VAR TestA, TestB, TestC, TestL, TestP, TestLP, TestABC: Bool;
BEGIN
TestL:= (Lt>Lt_); TestP:= F_Parite(Ja, Jb, Jc, Jd);
TestA:= (Ja>Ja_); TestB:= (Jb>Jb_); TestC:= (Jc>Jc_);
TestLP:= (TestL AND TestP);
TestABC:= TestA AND (TestB AND TestC);
IF (TestLP AND TestABC) THEN
BEGIN
Lt_:= Lt; Ja_:= Ja; Jb_:= Jb; Jc_:= Jc;
Jd_:= Jc; AffLtNabcd(Lt, Ja, Jb, Jc, Jd)
END
END;
PROCEDURE AffNq(k: LongInt);
BEGIN
E(0012); We(X1, Y0, k, o)
END;
PROCEDURE Enumeration;
VAR Iam, Ibm, Icm, Idm,
Ia, IaMax, Ib, IbMax, Ic, IcMax, Id, IdMa,
L1, L2, L3, Ltot, Ltm: Word; Nq: LongInt;
BEGIN
Iam:= 0; Ibm:= 0; Icm:= 0; Idm:= 0;
Ltm:= 0; Nq:= 0;
IaMax:= Lm DIV La;
FOR Ia:= 1 TO IaMax DO
BEGIN
L1:= Lm - (Ia * La); IbMax:= L1 DIV Lb;
IF (IbMax>0) THEN
FOR Ib:= 1 TO IbMax DO
BEGIN
L2:= L1 - (Ib * Lb); IcMax:= L2 DIV Lc;
IF (IcMax>0) THEN
FOR Ic:= 1 TO IcMax DO
BEGIN
L3:= L2 - (Ic * Lc); Id:= L3 DIV Ld;
Ltot:= Ia * La; Inc(Ltot, Ib * Lb);
Inc(Ltot, Ic * Lc); Inc(Ltot, Id * Ld);
IF (Id>0) THEN
BEGIN
Inc(Nq); AffNq(Nq);
Comparaison(Ltot, Ia, Ib, Ic, Id,
Ltm, Iam, Ibm, Icm, Idm)
END
END
END
END;
A_
END;
PROCEDURE AffT;
CONST L1 = 10; o = 5;
BEGIN
E(1015); Wt(X0, Y0 - 3, '( Lm0, La0, Lb0, Lc0, Ld0 )');
Wt(X0, Y0, 'Nombre de quintuplets calculs:');
Wt(X0, Y1, '( Lt, Na, Nb, Nc, Nd ) =');
Wt(X0, Y1 + 3, 'Distance rsiduelle: d = ');
E(0009); We(X1, Y0 - 3, Lm0, o);
E(0011); Write(La0:o, Lb0:o, Lc0:o, Ld0:o)
END;
BEGIN
AffT; Enumeration
END. |
Partager