Pentaminos — Apps — HP Prime for All

HP Apps : Pentaminos

Name	Pentaminos
Description	Tiling a Rectangle 5xN by Pentominoes. Seeks solutions (and registers in a spreadsheet), displays solutions, and rebuilds a specified solution.
Author	Michel Déchamps

Source code (download):

Source code formatted by website engine

Penta_Ini() BEGIN

LOCAL kp, kc;

// matrice des pentaminos et leurs config
M9 := MAKEMAT(0, 12, 10);
//pentaminos
FOR kp FROM 1 TO 12 DO FOR kc FROM 1 TO 8 DO M9(kp, kc) := Penta_Dat.Cell(kp, kc)
END;
END;
// couleurs
FOR kp FROM 1 TO 12 DO M9(kp, 9) := Penta_Dat.Cell(kp, 9)
END;
// blanc et noir
M9(10, 10) := Penta_Dat.Cell(10, 10);
M9(11, 10) := Penta_Dat.Cell(11, 10);
//symétries
FOR kp FROM 1 TO 8 DO M9(kp, 10) := Penta_Dat.Cell(kp, 10)
END;

END; P_S(cp, ksym) BEGIN


//symétrisation du code
LOCAL cod1, cl1, cl2, xmax, ymax, k, cod2;
cl1 := MAKELIST("  ", X, 1, 5);
cl2 := MAKELIST("  ", X, 1, 5);

//on découpe le code
cod1 := STRING(cp);
cod2 := LEFT(cod1, 1);
FOR k FROM 1 TO 5 DO cl1(k) := MID(cod1, 2*k, 2);
END;
xmax := EXPR(LEFT(cl1(5), 1));
FOR k FROM 1 to 5 DO cl2(k) := RIGHT(cl1(k), 1) + LEFT(cl1(k), 1);
END;
cl2 := SORT(cl2);
ymax := EXPR(LEFT(cl2(5), 1));

//on fait agir la transformation
//si ksym = 1 sym X, si ksym = 2 sym Y, si ksym = 3 sym XY
CASE IF ksym = 1 THEN FOR k FROM 1 TO 5 DO cl2(k) := LEFT(cl1(k), 1) + STRING(ymax-EXPR(RIGHT(cl1(k), 1)));
END;
END;
IF ksym = 2 THEN FOR k FROM 1 TO 5 DO cl2(k) := STRING(xmax-EXPR(LEFT(cl1(k), 1))) + RIGHT(cl1(k), 1);
END;
END;
END;

//on reconstruit le code
cl2 := SORT(cl2);
FOR k FROM 1 TO 5 DO cod2 := cod2+cl2(k)
END;

RETURN(EXPR(cod2));

END; P_Try(kp, nk, x, y) BEGIN

// on essaie de placer en x, y le pentamino kp de configuration nk
LOCAL cod, k, l, dx, dy, ok;

cod := STRING(nk); ok := 1;
FOR k FROM 1 TO 5 DO dx := EXPR(MID(cod, 2*k, 1)); dy := EXPR(MID(cod, 2*k+1, 1));

IF x+dx > 0 AND x+dx < N+1 AND y+dy > 0 AND y+dy < 6 THEN IF M0(y+dy, x+dx) == 0 THEN M0(y+dy, x+dx) := -1
ELSE
ok := 0
END;
ELSE
ok := 0
END;
IF ok = 0 THEN BREAK; END;
END;

// on met le damier M0 à jour
FOR l FROM 1 TO 5 DO FOR k FROM 1 to N DO IF M0(l, k) == -1 THEN IF ok THEN M0(l, k) := kp ELSE M0(l, k) := 0 END;
END;
END;
END;

RETURN(ok);

END; P_Dsp(kp, cp, x, y, c, td) BEGIN

// affichage du pentamino kp de code cp en x, y de couleur c

LOCAL cod, k, dx, dy, cl, lg = 13;

cod := STRING(cp);
FOR k FROM 1 TO 5 DO dx := EXPR(MID(cod, 2*k, 1)); dy := EXPR(MID(cod, 2*k+1, 1));
IF c THEN // on affiche le pentamino avec sa couleur
cl := M9(c, 9)
ELSE
// on efface le pentamino
cl := M9(10, 10)
END;
RECT_P((x+dx) * lg, (y+dy) * lg, (x+dx+1) * lg-1, (y+dy+1) * lg-1, cl);
IF k = 3 THEN TEXTOUT_P(kp, (x+dx) * lg+2, (y+dy) * lg+3, 1, M9(10, 10));
END;
END;

IF td THEN WAIT(td) END;

END; Penta_Rec(np) BEGIN

// écriture de la solution dans Penta_Sol

LOCAL n_tot, lsol1, ksol, indx;

n_tot := Penta_Dat.Cell(12, 10) + 1;
FOR ksol FROM 1 TO N DO Penta_Sol.Cell(n_tot, ksol) := L0(ksol)
END;
Penta_Dat.Cell(12, 10) := n_tot;

// on calcule le nouvel index
IF n_tot > 1 THEN // on enregistre l'index de la nouvelle solution
indx := Penta_Dat.Cell(np, 11);
IF indx THEN indx := indx+0.001;
Penta_Sol.Cell(n_tot, 13) := indx;
ELSE
indx := np+0.001;
Penta_Sol.Cell(n_tot, 13) := indx;
END;
ELSE
// cas où aucune solution déjà enregistrée
indx := np+0.001;
Penta_Sol.Cell(1, 13) := indx;
Penta_Dat.Cell(12, 10) := 1;
END;
Penta_Dat.Cell(np, 11) := indx;

// on renvoie l'index de la dernière solution enregistrée
RETURN(indx);

END; EXPORT Penta_Dso(np) BEGIN

// affichage d'une solution 5xN

LOCAL lsol1, lsol2, n_tot, tit, ayuda;
LOCAL n_sol, n_soldeb, n_solfin, n_solN, n_sol_C;
LOCAL k = 1, codp, lp, kp, cod, kt, ksym;
LOCAL px, py, hy, na, lst, indx;

N := np;

// constitution de la liste ordonnée des index du tableau Penta_Sol
na := Penta_Dat.Cell(13, 12); lst := ASC(MID(na, 5, 1));
n_tot := Penta_Dat.Cell(12, 10); A := 1 - (lst(1) = 233);
lsol1 := MAKELIST(0, X, 1, n_tot);
lsol2 := MAKELIST(0, X, 1, n_tot);

FOR n_sol FROM 1 TO n_tot DO lsol1(n_sol) := 1000*Penta_Sol.Cell(n_sol, 13)
END;
lsol2 := SORT(lsol1);

n_sol := POS(lsol2, 1000*N+1);
IF n_sol == 0 THEN CASE IF D == 1 THEN MSGBOX("***  Aucune solution 5x"+STRING(N) + " disponible  ***")
END;
IF D == 2 THEN MSGBOX("***  No solution 5x"+STRING(N) + " available  ***")
END;
IF D == 3 THEN MSGBOX("***  Ninguna solución 5x"+STRING(N) + " encontrada ***")
END;
END;
ELSE
indx := Penta_Dat.Cell(np, 11); n_solN := 1000 * (indx-IP(indx));
// si n_solN > 1 on demande à l'utilisateur de choisir la ou les solution(s)
IF n_solN == 1 THEN n_sol := n_solN
ELSE
n_sol := 0;
WHILE n_sol < 1 OR n_sol > n_solN DO CASE IF D == 1 THEN tit := STRING(n_solN) + " solution(s) 5x"+STRING(N) + " trouvée(s)";
ayuda := "Taper 2 ou 2.005 pour les solutions de 2 à 5";
END;
IF D == 2 THEN tit := STRING(n_solN) + " solution(s) 5x"+STRING(N) + " found";
ayuda := "Key in 2 or 2.005 for solutions from 2 to 5";
END;
IF D == 3 THEN tit := STRING(n_solN) + " solución(es) 5x"+STRING(N) + " encontrada(s)";
ayuda := "Teclea 2 o 2.005 para soluciones de 2 hasta 5";
END;
END;
INPUT(n_sol, tit, "sol n°", ayuda)
END
END;

IF IP(n_sol) == n_sol THEN // si on n'a demandé qu'une solution
n_soldeb := n_sol; n_solfin := n_sol;
ELSE
n_soldeb := IP(n_sol);
n_solfin := IP(1000 * (n_sol-n_soldeb));
END;

// on affiche la ou les solutions demandées
FOR n_sol FROM n_soldeb TO MIN(n_solfin, n_solN) DO 
// on nettoie l'écran
RECT_P(M9(10, 10));
RECT_P(12, 12, 13 * (N+1), 78, M9(11, 10), M9(10, 10));
TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
IF D == 1 OR D == 2 THEN tit := "Solution 5x"
ELSE
tit := "Solución 5x"
END;
TEXTOUT_P(tit+STRING(N) + " n° "+STRING(n_sol), 182, 27, 3, M9(11, 10));
// on affiche la solution choisie
lp := MAKELIST(0, X, 1, N);
// on initialise le damier
M0 := MAKEMAT(0, 5, N);
n_sol_C := POS(lsol1, 1000*N+n_sol);

FOR k FROM 1 TO N DO codp := STRING(Penta_Sol.Cell(n_sol_C, k));
kp := EXPR(MID(codp, 2, 2)); lp(k) := kp;
cod := M9(kp, 1);

// on affiche le pentamino courant
P_Dsp(kp, cod, 1+6 * (IP((kp-1) / 3) MOD 4), 7+4 * ((kp-1) MOD 3), kp, 0.3);
// on manipule le pentamino
kt := 1; ksym := EXPR(MID(codp, 3+kt, 1));
WHILE kt < 4 AND ksym > 0 DO cod := P_S(cod, ksym);
kt := kt+1; ksym := EXPR(MID(codp, 3+kt, 1))
END;
px := EXPR(MID(codp, 7, 2));
py := EXPR(MID(codp, 9, 1));
hy := EXPR(MID(STRING(cod), 3, 1));
// on place le pentamino dans le rectangle
IF P_Try(kp, cod, px, py-hy) THEN P_Dsp(kp, cod, px, py-hy, IFTE(A, 0, kp), 0.7);
END;
END;
TEXTOUT_P(lp, 182, 47, 1, M9(11, 10));

IF WAIT() == 4 THEN BREAK; END;
END;
END;

END; EXPORT Penta_ChS(np) BEGIN

// recherche d'un pavage d'un rectangle 5xn (2 < n <= 12)

LOCAL lp, lpc, pu, kpu, non, n_sol, na, lst;
LOCAL jp, ks, kp, kc, kcdeb, kt, ksym, cod;
LOCAL hy, yv, xv, y, x, yvu, xvu, vid;
LOCAL ksol, n_sol, sol_new, tmp, lien, list_s, tecla, indx;

N := np;
na := Penta_Dat.Cell(13, 12);
lst := ASC(MID(na, 5, 1)); A := 1 - (lst(1) = 233);

// on initialise le damier
M0 := MAKEMAT(0, 5, N);
// liste des pentaminos configurés de la solution en cours
L0 := MAKELIST(0, X, 1, N);

// L9 contient l'ordre tiré au sort des pentaminos
L9 := randperm(12);

// listes des pentaminos utilisés et des configs
lp := MAKELIST(0, X, 1, N);
lpc := MAKELIST(0, X, 1, N);

// on initialise l'écran
RECT_P(M9(10, 10));
RECT_P(12, 12, 13 * (N+1), 78, M9(11, 10), M9(10, 10));
TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
TEXTOUT_P(L9, 182, 26, 1, M9(11, 10));
IF D == 1 OR D == 2 THEN TEXTOUT_P("Solution 5x"+STRING(N), 182, 11, 3, M9(11, 10));
ELSE
TEXTOUT_P("Solución 5x"+STRING(N), 182, 11, 3, M9(11, 10));
END;

// on commence par le premier pentamino de la liste L9
kcdeb := 1; pu := 1; yv := 1; xv := 1; ksol := 1; jp := 1; sol_new := 0;

// _________________________________________________________________________________
// boucle principale
REPEAT 
IFERR
kp := L9(jp);
REPEAT tmp := STRING(100+kp);
// on affiche le pentamino courant
P_Dsp(kp, M9(kp, 1), 1+6 * (IP((kp-1) / 3) MOD 4), 7+4 * ((kp-1) MOD 3), kp, 0);

// on essaie de placer ce pentamino en (xv, yv)
non := 1;
FOR kc FROM kcdeb TO 8 DO cod := M9(kp, kc); ksym := EXPR(LEFT(STRING(cod), 1));
IF cod THEN hy := EXPR(MID(STRING(cod), 3, 1));
IF non THEN IF P_Try(kp, cod, xv, yv-hy) THEN P_Dsp(kp, cod, xv, yv-hy, IFTE(A, 0, kp), 0);
tmp := tmp+RIGHT(STRING(M9(ksym, 10)), 3) + RIGHT(STRING(100+xv), 2) + STRING(yv);
L0(ksol) := EXPR(tmp); ksol := ksol+1;
lp(pu) := kp; lpc(pu) := kc; pu := pu+1;
non := 0; sol_new := 1;
BREAK;
END;
END;
ELSE
BREAK;
END;
END;

IF non == 0 THEN // on repère la première case vide pour le pentamino suivant
vid := 1;
FOR xv FROM 1 TO N DO FOR yv FROM 1 TO 5 DO IF M0(yv, xv) == 0 THEN vid := 0; BREAK(2); END;
END;
END;
IF vid THEN BREAK; END;

// on arrête si cette case vide du damier est isolée
lien := 0;
IF yv < 5 THEN y := yv+1;
IF M0(y, xv) == 0 THEN lien := 1 END;
END;
IF (lien == 0) AND xv < N THEN x := xv+1;
IF M0(yv, x) == 0 THEN lien := 1 END;
END;
IF lien == 0 THEN BREAK; END;
END;

// on cherche le pentamino suivant non utilisé
REPEAT jp := jp+1; kcdeb := 1;
IF jp > 12 THEN IF sol_new == 0 THEN BREAK(2);
ELSE
RECT_P(10, 90, 320, 240, M9(10, 10)); TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
sol_new := 0;
jp := 1; kcdeb := 1;
END;
END;
UNTIL POS(lp, L9(jp)) == 0;
kp := L9(jp);

UNTIL 0;

// si on aboutit à une solution on l'enregistre
tecla := 30;
IF ksol > N THEN // on enregistre la solution nouvelle
indx := Penta_Rec(N); indx := 1000 * (indx-IP(indx));
// on affiche les pentaminos non utilisés
RECT_P(10, 90, 320, 240, M9(10, 10)); TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
FOR kp FROM 1 TO 12 DO IF POS(lp, kp) == 0 THEN P_Dsp(kp, M9(kp, 1), 1+6 * (IP((kp-1) / 3) MOD 4), 7+4 * ((kp-1) MOD 3), kp, 0)
END;
END;
TEXTOUT_P("Solution 5x"+STRING(N) + " n° "+STRING(indx), 182, 11, 3, M9(11, 10));

tecla := 0; tecla := WAIT();
// si Esc on s'arrête sinon on cherche la solution suivante
IF tecla == 4 THEN BREAK; END;
END;
IF ksol < N+1 OR tecla == 30 THEN // si échec ou solution suivante désirée, on revient en arrière
non := 1;
WHILE non DO // on efface le dernier pentamino mis
pu := pu-1; kp := lp(pu); kcdeb := lpc(pu); cod := M9(kp, kcdeb);
ksol := ksol-1; tmp := STRING(L0(ksol));
xvu := EXPR(MID(tmp, 7, 2)); yvu := EXPR(RIGHT(tmp, 1));
hy := EXPR(MID(STRING(cod), 3, 1));
P_Dsp(kp, cod, xvu, yvu-hy, 0, 0);

// on met à zéro les cases du damier
FOR xv FROM 1 TO N DO FOR yv FROM 1 TO 5 DO IF M0(yv, xv) == kp THEN M0(yv, xv) := 0; END;
END;
END;

// on efface le dernier pentamino utilisé
lp(pu) := 0; lpc(pu) := 0;
// on efface la dernière sol de L0
L0(ksol) := 0; sol_new := 0;
// on réinitialise les pointeurs
yv := yvu; xv := xvu;

// on étudie la config suivante du pentamino
kcdeb := kcdeb+1;
IF kcdeb < 9 THEN IF M9(kp, kcdeb) THEN non := 0 END;
END;
END;

jp := POS(L9, kp);
IF pu == 0 THEN IF kcdeb < 9 THEN IF M9(kp, kcdeb) == 0 THEN jp := jp+1; kcdeb := 1;
IF jp > 12 THEN L9 := randperm(12); jp := 1; kcdeb := 1;
RECT_P(182, 33, 316, 47, M9(10, 10));
TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
TEXTOUT_P(L9, 182, 26, 1, M9(11, 10))
END
END
END
END
END;

THEN BREAK; END;

UNTIL ksol > N;
// _________________________________________________________________________________

IF ksol < N THEN // on n'a pas trouvé de solution avec cette permutation des pentaminos
RECT_P(10, 90, 320, 240, M9(10, 10));
CASE IF D == 1 THEN TEXTOUT_P("Pas de solution trouvée ... Réessayez", 72, 120, 3, #FF0000);
END;
IF D == 2 THEN TEXTOUT_P("No solution found ... Try again", 72, 120, 3, #FF0000);
END;
IF D == 3 THEN TEXTOUT_P("Ninguna solución ... Inténtelo de nuevo", 67, 120, 3, #FF0000);
END;
END;
WAIT();
END;

RETURN(L0);

END; EXPORT Penta_Cst(np) BEGIN

// affichage d'une solution 5xN

LOCAL lsol1, lsol2, l_kp, n_tot, tit, ayuda;
LOCAL n_sol, n_solN, n_sol_C, raton, kcmax, atras;
LOCAL k = 1, kt, codp, lp, lpc, kp, cod, kc;
LOCAL px, py, hy, na, lst, indx, lg = 13;

N := np;

// symboles
l_kp := MAKELIST(" ", X, 1, 13);
l_kp := {"①", "②", "③", "④", "⑤", "⑥", "⑦", "⑧", "⑨", "⑩", "⑪", "⑫", "◉"};
// constitution de la liste ordonnée des index du tableau Penta_Sol
na := Penta_Dat.Cell(13, 12); lst := ASC(MID(na, 5, 1));
n_tot := Penta_Dat.Cell(12, 10); A := 1 - (lst(1) = 233);
lsol1 := MAKELIST(0, X, 1, n_tot);
lsol2 := MAKELIST(0, X, 1, n_tot);

FOR n_sol FROM 1 TO n_tot DO lsol1(n_sol) := 1000*Penta_Sol.Cell(n_sol, 13)
END;
lsol2 := SORT(lsol1);

n_sol := POS(lsol2, 1000*N+1);
IF n_sol == 0 THEN CASE IF D == 1 THEN MSGBOX("***  Aucune solution 5x"+STRING(N) + " disponible  ***")
END;
IF D == 2 THEN MSGBOX("***  No solution 5x"+STRING(N) + " available  ***")
END;
IF D == 3 THEN MSGBOX("***  Ninguna solución 5x"+STRING(N) + " disponible  ***")
END;
END;
ELSE
indx := Penta_Dat.Cell(np, 11); n_solN := 1000 * (indx-IP(indx));
// si n_solN > 1 on demande à l'utilisateur de choisir la ou les solution(s)
IF n_solN == 1 THEN n_sol := n_solN
ELSE
n_sol := 0;
WHILE n_sol < 3 OR n_sol > n_solN DO CASE IF D == 1 THEN tit := STRING(n_solN) + " solution(s) 5x"+STRING(N) + " trouvée(s)";
ayuda := "Taper le n° de la solution 1 à "+STRING(n_solN);
END;
IF D == 2 THEN tit := STRING(n_solN) + " solution(s) 5x"+STRING(N) + " found";
ayuda := "Key in the number of the solution from 1 to "+STRING(n_solN);
END;
IF D == 3 THEN tit := STRING(n_solN) + " solución(es) 5x"+STRING(N) + " encontrada(s)";
ayuda := "Teclea el numero de la solución de 1 hasta "+STRING(n_solN);
END;
END;
INPUT(n_sol, tit, "sol n°", ayuda)
END
END;

// on propose à l'utilisateur de construire la solution demandée
RECT_P(M9(10, 10));
RECT_P(12, 12, 13 * (N+1), 78, M9(11, 10), M9(10, 10));
TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
IF D == 1 OR D == 2 THEN tit := "Solution 5x"
ELSE
tit := "Solución 5x"
END;
TEXTOUT_P(tit+STRING(N) + " n° "+STRING(n_sol), 182, 27, 3, M9(11, 10));

// on initialise la liste des pentaminos utilisés et damier
lp := MAKELIST(0, X, 1, N); lpc := MAKELIST(0, X, 1, N);
M0 := MAKEMAT(0, 5, N);
n_sol_C := POS(lsol1, 1000*N+n_sol);

// ______________________________________________________________________________
// on commence la construction de la solution guidée pas à pas
k := 1;
REPEAT // on affiche les cases de placement de 2 prochains pentaminos
FOR kt FROM k TO MIN(k+1, N) DO codp := STRING(Penta_Sol.Cell(n_sol_C, kt));
kp := EXPR(MID(codp, 2, 2)); lp(kt) := kp;
px := EXPR(MID(codp, 7, 2));
py := EXPR(MID(codp, 9, 1));
hy := EXPR(MID(STRING(cod), 3, 1));
TEXTOUT_P(l_kp(kp), px*lg+2, py*lg+3, 2, M9(kp, 9))
END;

codp := STRING(Penta_Sol.Cell(n_sol_C, k));
kp := EXPR(MID(codp, 2, 2));

// on affiche une à une les configs possibles du pentamino courant
RECT_P(3, 90, 320, 240, M9(10, 10)); TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
FOR kc FROM 1 TO 8 DO cod := M9(kp, kc);
IF cod THEN kcmax := kc; hy := EXPR(MID(STRING(cod), 3, 1));
TEXTOUT_P(CHAR(kc+64), (1+6 * ((kc-1) MOD 4)) * lg-9, (7+5*IP((kc-1) / 4)) * lg+17, 1, M9(kp, 9));
P_Dsp(kp, cod, 1+6 * ((kc-1) MOD 4), 7+5*IP((kc-1) / 4), kp, 0.3);
ELSE
BREAK;
END;
END;
RECT_P(180, 42, 320, 72, M9(10, 10));
CASE IF D == 1 THEN TEXTOUT_P("Choisir une bonne config", 182, 45, 1, M9(kp, 9));
TEXTOUT_P("Del pour effacer le précédent", 182, 61, 1, M9(11, 10))
END;
IF D == 2 THEN TEXTOUT_P("Choose a correct config", 182, 45, 1, M9(kp, 9));
TEXTOUT_P("Del to erase the previous", 182, 61, 1, M9(11, 10))
END;
IF D == 3 THEN TEXTOUT_P("Elija una correcta config", 182, 45, 1, M9(kp, 9));
TEXTOUT_P("Del para borrar el anterior", 182, 61, 1, M9(11, 10))
END;
END;
// on demande à l'utilisateur de choisir la configuration
atras := 0;
WHILE 1 DO // on attend la souris (ou le clavier)
WHILE 1 DO raton := MOUSE();
IF SIZE(raton(1)) THEN // si on a cliqué avec la souris au bon endroit
kc := 4*IP((IP(raton(1, 2)) - 90) / 55) + IP(IP(raton(1, 1)) / 78) + 1;
IF kc >= 1 AND kc <= kcmax THEN BREAK; END;
END;
// si on a touché au clavier
CASE IF ISKEYDOWN(19) AND k > 1 THEN atras := 1; BREAK(2); END;
IF ISKEYDOWN(4)  THEN BREAK(3); END;
IF ISKEYDOWN(14) THEN kc := 1; BREAK; END;
IF ISKEYDOWN(15) THEN kc := 2; BREAK; END;
IF ISKEYDOWN(16) THEN kc := 3; BREAK; END;
IF ISKEYDOWN(17) THEN kc := 4; BREAK; END;
IF ISKEYDOWN(18) THEN kc := 5; BREAK; END;
IF ISKEYDOWN(20) THEN kc := 6; BREAK; END;
IF ISKEYDOWN(21) THEN kc := 7; BREAK; END;
IF ISKEYDOWN(22) THEN kc := 8; BREAK; END;
END;
END;
// on essaie de placer le pentamino dans la configuration choisie
cod := M9(kp, kc);
IF cod THEN px := EXPR(MID(codp, 7, 2)); py := EXPR(MID(codp, 9, 1));
hy := EXPR(MID(STRING(cod), 3, 1));
IF P_Try(kp, cod, px, py-hy) THEN // si c'est possible on le fait
P_Dsp(kp, cod, px, py-hy, IFTE(A, 0, kp), 0);
lpc(k) := kc;
BREAK;
ELSE
// sinon on signale que c'est impossible
CASE IF D == 1 THEN TEXTOUT_P("Placement de "+CHAR(kc+64) + " Impossible", 172, 230, 1, #FF0000);
END;
IF D == 2 THEN TEXTOUT_P("Placement of "+CHAR(kc+64) + " Impossible", 172, 230, 1, #FF0000);
END;
IF D == 3 THEN TEXTOUT_P("Colocación de "+CHAR(kc+64) + " Imposible", 172, 230, 1, #FF0000);
END;
END;
WAIT(1); RECT_P(120, 210, 320, 240, M9(10, 10));
END
END
END;

// si on revient en arrière
IF atras THEN // on efface le dernier pentamino placé
k := k-1; kc := lpc(k);
codp := STRING(Penta_Sol.Cell(n_sol_C, k));
kp := EXPR(MID(codp, 2, 2));
cod := M9(kp, kc);
px := EXPR(MID(codp, 7, 2)); py := EXPR(MID(codp, 9, 1));
hy := EXPR(MID(STRING(cod), 3, 1));
P_Dsp(kp, cod, px, py-hy, 0, 0);

// on met à zéro les cases du damier
FOR px FROM 1 TO N DO FOR py FROM 1 TO 5 DO IF M0(py, px) == kp THEN M0(py, px) := 0; END;
END;
END;
ELSE
k := k+1;
END;

UNTIL k > N;
RECT_P(3, 90, 320, 240, M9(10, 10)); TEXTOUT_P(na, 12, 230, 1, M9(11, 10));
RECT_P(180, 42, 320, 72, M9(10, 10)); TEXTOUT_P(lp, 182, 47, 1, M9(11, 10));

WAIT();
// ____________________________________________________________________________

END;

END; EXPORT Pentaminos() BEGIN

// menu principal

LOCAL fd, np, tit, tit1, tit2, list_chx;

IF NOT (M9(1, 1) == Penta_Dat.Cell(1, 1)) THEN Penta_Ini END;

D := 1; CHOOSE(D, " ", {"  Logiciel en Français ", "  Software in English  ", "  Programa en Español  "});
CASE IF D == 1 THEN tit1 := "Rectangle de Pentaminos 5xN"; tit2 := "de 3 à 12";
list_chx := {"Chercher des solutions", "Afficher des solutions", "Reconstruire une solution"}
END;
IF D == 2 THEN tit1 := "Rectangle of Pentominoes 5xN"; tit2 := "from 3 to 12";
list_chx := {"Seek solutions", "Display solutions", "Rebuild a solution"}
END;
IF D == 3 THEN tit1 := "Rectangulo de Pentaminos 5xN"; tit2 := "de 3 hasta 12";
list_chx := {"Buscar soluciones", "Mostrar soluciones", "Reconstruir una solución"}
END;
END;

REPEAT np := 0;
CHOOSE(fd, tit1, list_chx);
IF D == 1 OR D == 2 THEN tit := "Rectangle 5xN"
ELSE
tit := "Rectangulo 5xN"
END;
CASE IF fd == 1 THEN // recheche de solutions
WHILE np < 3 OR np > 12 DO INPUT(np, tit, "N", tit2);
END;
Penta_ChS(np)
END;
IF fd == 2 THEN // affichage de solutions
WHILE np < 1 OR np > 12 DO INPUT(np, tit, "N", tit2);
END;
Penta_Dso(np)
END;
IF fd == 3 THEN // Construction d'une solution
WHILE np < 3 OR np > 12 DO INPUT(np, tit, "N", tit2);
END;
Penta_Cst(np)
END;
DEFAULT BREAK;
END
UNTIL 0;

END;

HP Prime for All

HP Apps : Pentaminos

Source code (download):

Comments