/* PENTOMINO SOLVER 8/24/90 */
  /* by manny juan            */
  /*    manny@bdt.com         */
  /*    juanm@wellsfargo.com  */
 
  /* HERE IS THE 3 X 20       */
  /*
 UUXIIIIIZWWTTTFLLLLV
 UXXXPPZZZYWWTFFFNNLV
 UUXPPPZYYYYWTFNNNVVV
  */
 
  PENTO:PROC OPTIONS(MAIN);
    DCL (SUBSTR,MOD,CEIL,TRUNC)BUILTIN;
    DCL 1 PIECE,
          2 CELLS(5),
            3 I FIXED BIN(15),
            3 J FIXED BIN(15);
    DCL WP LIKE PIECE;
    DCL 1 PDEF(12),
          2 BC FIXED BIN(15),
          2 BG FIXED BIN(15),
          2 BP(24) LIKE PIECE;
    DCL (C,I,G,J,L,M,N,P) FIXED BIN(15);
    DCL (S) CHAR(32) VAR;
    DCL (HI,HJ) FIXED BIN(15);
    DCL (NS) FIXED BIN(15) INIT(10);
    DCL (NP,NC,MP) FIXED BIN(15);
    DCL U(12)     FIXED BIN(15) INIT((12)0);
    MP=12;
    NS=1;
 
    HI=6;HJ=10;                        /* THE PATTERN TO FILL IS HERE */
    DCL V(3,20) FIXED BIN(15);
    DO I=1 TO HI;DO J=1 TO HJ;V(I,J)=0;END;END;
    NP=MP;
    NC=HI*HJ;
    CALL BUILD_PIECES;
    C=0;
    CALL SOLVE(C);
    EXIT;
 
  SOLVE:PROC(CC) RECURSIVE;
    DCL (C,P,G) FIXED BIN(15);
    DCL (I,J) FIXED BIN(15);
    DCL (CC) FIXED BIN(15);
    IF(NC=0)THEN
      DO;
        CALL PRINTSOL;
        NS=NS-1;IF(NS<1)THEN EXIT;
      END;
    ELSE
      DO;
        C=CC;
        DO UNTIL(V(I,J)=0);
          C=C+1;
          I=MOD((C-1),HI)+1;
          J=TRUNC((C-1)/HI)+1;
          /*
          PUT SKIP EDIT('C=')(A)
          (C,I,J,V(I,J))(F(3));
          */
        END;
        DO P=1 TO MP;
          IF(U(P)=0)THEN
            DO G=1 TO BG(P);
              IF(FITS(P,G,I,J))THEN
                DO;
                  CALL PUTPIECE(P,G,I,J);
                  /*
                  CALL PRINTSOL;
                  */
                  U(P)=1;
                  NP=NP-1;
                  NC=NC-BC(P);
                  CALL SOLVE(C);
                  CALL REMOVEPIECE(P,G,I,J);
                  NC=NC+BC(P);
                  NP=NP+1;
                  U(P)=0;
                END;
            END;
        END;
      END;
    RETURN;
  END SOLVE;
 
  FITS:PROC(P,G,BI,BJ)RETURNS(BIT(1));
    DCL (P,G,BI,BJ) FIXED BIN(15);
    DCL (X,N,I,J) FIXED BIN(15);
    DCL (DONE) BIT(1);
    N=0;X=0;DONE='0'B;
    DO UNTIL (DONE);
      N=N+1;
      I=BI+BP(P,G).I(N);
      J=BJ+BP(P,G).J(N);
      IF(I>HI|J>HJ)THEN DONE='1'B;
      ELSE
      IF(I<1 |J<1)THEN DONE='1'B;
      ELSE
      IF(V(I,J)=0)THEN X=X+1;ELSE DONE='1'B;
      IF(N=BC(P))THEN DONE='1'B;
    END;
    /*
    PUT SKIP EDIT(P,G,X=BC(P))(F(4));
    */
    RETURN(X=BC(P));
  END FITS;
 
  PUTPIECE:PROC(P,G,BI,BJ) RECURSIVE;
    DCL (P,G,BI,BJ) FIXED BIN(15);
    DCL (N,I,J) FIXED BIN(15);
    DO N=1 TO BC(P);
      I=BI+BP(P,G).I(N);
      J=BJ+BP(P,G).J(N);
      V(I,J)=P;
    END;
  END PUTPIECE;
 
  REMOVEPIECE:PROC(P,G,BI,BJ) RECURSIVE;
    DCL (P,G,BI,BJ) FIXED BIN(15);
    DCL (N,I,J) FIXED BIN(15);
    DO N=1 TO BC(P);
      I=BI+BP(P,G).I(N);
      J=BJ+BP(P,G).J(N);
      V(I,J)=0;
    END;
  END REMOVEPIECE;
 
  PRINTSOL:PROC;
    DCL Z CHAR(16) VAR INIT('.TUVWXYZFILPN@#$');
    DCL S CHAR(64) VAR;
    DCL(I,J)FIXED BIN(15);
    DO I=1 TO HI;
      S='';
      DO J=1 TO HJ;
        S=S||SUBSTR(Z,V(I,J)+1,1);
      END;
      PUT SKIP EDIT(S)(A);
    END;
    PUT SKIP;
  END PRINTSOL;
 
  BUILD_PIECES:PROC;
    DCL DEFSTR(3) CHAR(60) INIT
   ('XXX. XX.. X... X... .X.. XXXX XX.. XX.. XXXXXXXXX XXX. XX.. ',
    '.X.. X... X... XX.. XXX. ..X. .X.. .XX. .... X... XX.. .XXX ',
    '.X.. XX.. XXX. .XX. .X.. .... .XX. .X.. .... .... .... .... ');
    DO P=1 TO MP;
      N=0;
        DO I=1 TO 3;
          DO J=1 TO 5;
            IF(SUBSTR(DEFSTR(I),(P-1)*5+J,1)='X')THEN
              DO;N=N+1;PIECE.I(N)=I;PIECE.J(N)=J;END;
          END;
        END;
      BC(P)=N;
      /*
      PUT SKIP EDIT('CELLS=')(A)(BC(P))(F(3));
      DO N=1 TO BC(P);
        PUT SKIP EDIT(PIECE.I(N),PIECE.J(N))(F(3));
      END;
      */
      CALL GEN(P);
      PUT SKIP EDIT('S=',P,BG(P))(A,F(3),F(3));
    END;
  END;
 
  GEN:PROC(P);
    DCL P FIXED BIN(15);
    DCL (Q,A,B,C,R,S,H,T,W,IFACT,JFACT) FIXED BIN(15);
    DCL (LO_I,LO_J) FIXED BIN(15);
    DCL (MAT) FIXED BIN(15);
    DCL (DONE) BIT(1);
    S=0;
    DO H=1 TO 8;
      A=CEIL(H/4)-1;
      B=CEIL((H-A*4)/2)-1;
      C=1-MOD(H,2);
      /*
      PUT SKIP EDIT(H,Q,A,B,C)(F(4));
      */
      IF(C)THEN JFACT=-1;ELSE JFACT=1;
      IF(B)THEN IFACT=-1;ELSE IFACT=1;
      DO N=1 TO BC(P);
        WP.I(N)=PIECE.I(N);
        WP.J(N)=PIECE.J(N);
        IF(A)THEN
          DO;
          T=WP.I(N);WP.I(N)=WP.J(N);WP.J(N)=T;
          END;
        WP.I(N)=IFACT*WP.I(N);
        WP.J(N)=JFACT*WP.J(N);
      END;
      /* SORT CELLS */
      DO N=1 TO BC(P)-1;
        T=N;
        LO_I=WP.I(N);
        LO_J=WP.J(N);
        DO M=N+1 TO BC(P);
          IF((WP.J(M)<LO_J)
            |(WP.J(M)=LO_J & WP.I(M)<LO_I))THEN
            DO;
              T=M;
              LO_I=WP.I(M);
              LO_J=WP.J(M);
            END;
        END;
        IF(T^=N)THEN
          DO;
            W=WP.I(N);WP.I(N)=WP.I(T);WP.I(T)=W;
            W=WP.J(N);WP.J(N)=WP.J(T);WP.J(T)=W;
          END;
      END;
      /* ADJUST */
      DO N=BC(P) TO 1 BY -1;
        WP.I(N)=WP.I(N)-WP.I(1);
        WP.J(N)=WP.J(N)-WP.J(1);
      END;
      /* DROP DUPS */
      S=S+1;
      BP(P,S)=WP;
      R=0;
      DONE='0'B;
      DO UNTIL(DONE);
        R=R+1;
        MAT=0;
        DO N=1 TO BC(P);
          IF((BP(P,R).I(N)=WP.I(N))
            &(BP(P,R).J(N)=WP.J(N)))THEN
            MAT=MAT+1;
        END;
        DONE=(MAT=BC(P));
      END;
      IF(R<S)THEN S=S-1;
      BG(P)=S;
      /*
      DO N=1 TO BC(P);
        PUT SKIP EDIT(WP.I(N),WP.J(N))(F(4));
      END;
      PUT SKIP EDIT('---')(A);
      */
    END;
  END GEN;
  END PENTO;