REM > Poly - generate all polyominoes of size M%
REM Denis Howe <dbh@doc.ic.ac.uk>
REM 13-Jan-1993

MODE 0:OFF
M%=6                            :REM The number of squares in an omino
DIM X%(M%+1),Y%(M%+1),Site%(M%) :REM Base omino.
DIM XT%(M%+1),YT%(M%+1)         :REM Transformed omino.
Side%=24:D=(M%+1)*Side%         :REM Displayed square size.
DisplayX%=0:DisplayY%=0         :REM Origin for next displayed omino.
Known%=TOP+200*M%               :REM List of known ominoes.
PL%=Known%:DL%=2*M%             :REM Pointer to end of list.
N%=0
REPEAT
  WHILE N%<M% PROCAdd:ENDWHILE
  XT%()=X%():YT%()=Y%()
  PROCShift
  IF FNNew PROCDraw:PROCTrans
  REPEAT
    PROCMove
    Done%=Y%(N%)>=0
    IF NOT Done% N%-=1:Done%=N%=1 
  UNTIL Done%
UNTIL N%=1
END

REM Add a new square at the first unoccupied site to the right of 0,0.

DEF PROCAdd
LOCAL O%,X%:X%=0
REPEAT
  O%=FNOccupant(X%,0)
  IF O% Site%(N%+1)=O%:X%+=1
UNTIL O%=0
N%+=1:X%(N%)=X%:Y%(N%)=0
ENDPROC

REM Rotate X%(N%),Y%(N%) around its site or vice versa.

DEF PROCMove
LOCAL O%,VX%,VY%
REPEAT
  VX%=Y%(Site%(N%))-Y%(N%)
  VY%=X%(N%)-X%(Site%(N%))
  O%=FNOccupant(X%(N%)+VX%,Y%(N%)+VY%)
  IF O% Site%(N%)=O%
UNTIL O%=0
O%=FNOccupant(X%(Site%(N%))+VX%,Y%(Site%(N%))+VY%)
IF O% THEN
  X%(N%)=X%(N%)+VX%:Y%(N%)=Y%(N%)+VY%:Site%(N%)=O%
ELSE
  X%(N%)=X%(Site%(N%))+VX%:Y%(N%)=Y%(Site%(N%))+VY%
ENDIF
ENDPROC

REM Return the index (1-N%) of the square occupying X%,Y% or 0 if none.

DEF FNOccupant(X%,Y%)
LOCAL I%
I%=N%
WHILE I%
  IF X%(I%)=X% IF Y%(I%)=Y% THEN=I%
  I%-=1
ENDWHILE
=0

REM Sort the points and shift them so that their min X and Y are 0.

DEF PROCShift
LOCAL XMN%,YMN%,T%
YMN%=YT%(N%)
FOR I%=1 TO N%-1
  FOR J%=I%+1 TO N%
    T%=XT%(J%)-XT%(I%):IF T%=0 T%=YT%(J%)-YT%(I%)
    IF T%<0 THEN
      SWAP XT%(I%),XT%(J%)
      SWAP YT%(I%),YT%(J%)
    ENDIF
  NEXT
  IF YT%(I%)<YMN% YMN%=YT%(I%)
NEXT
XMN%=XT%(1)
FOR I%=1 TO N%:XT%(I%)-=XMN%:YT%(I%)-=YMN%:NEXT
ENDPROC
 
DEF PROCDraw
FOR I%=1 TO N%:PROCBox(X%(I%),Y%(I%)):NEXT
DisplayX%+=D
IF DisplayX%>1200-D DisplayX%=0:DisplayY%+=D:IF DisplayY%>1024-D z=GET:CLG:DisplayY%=0
ENDPROC
 
DEF PROCBox(X%,Y%)
RECTANGLE DisplayX%+X%*Side%,DisplayY%+Y%*Side%, Side%,Side%
ENDPROC

REM See if the omino in XT(),YT() is known.

DEF FNNew
LOCAL P%,Q%
P%=Known%
REPEAT
  Q%=P%
  FOR I%=1 TO N%
    IF (XT%(I%)AND&FF)<>?Q% OR (YT%(I%)AND&FF)<>Q%?1 I%=1E9
    Q%+=2
  NEXT
  IF I%<1E9 THEN=FALSE :REM Found a match.
  P%+=DL%
UNTIL P%>=PL%
=TRUE :REM No match.

REM Add the omino in XT%(),YT%() to the list of known ominoes.
 
DEF PROCList
LOCAL I%,P%
P%=PL%
FOR I%=1 TO N%
  P%?0=XT%(I%):P%?1=YT%(I%):P%+=2
NEXT
PL%+=DL%
ENDPROC

REM Genreate eight different transformations of XT%(),YT%() and
REM add the results to the list if new.  The transformations
REM are generated by alternately reflecting in y=0 and y=x.

DEF PROCTrans
LOCAL C%,Q%,I%
PROCList :REM Add the original.
FOR C%=1 TO 7
  IF C% AND 1 THEN
    FOR I%=1 TO N%:YT%(I%)=-YT%(I%):NEXT
  ELSE
    FOR I%=1 TO N%:SWAP XT%(I%),YT%(I%):NEXT
  ENDIF
  PROCShift:IF FNNew PROCList
NEXT
ENDPROC