HP Prime для всех

English  Русский 
Pentaminos games-app screenshot}}
Название Pentaminos
Описание Tiling a Rectangle 5xN by Pentominoes. Seeks solutions (and registers in a spreadsheet), displays solutions, and rebuilds a specified solution.
Автор Michel Déchamps

Исходный код (скачать):

Исходный код отформатирован программными средствами сайта

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;

Комментарии