10 REM (c)     By J.de B.Pollard,                      (and J.M.Sargent)
   20 REM (C) 19860522
   30 :
   40 MODE7:PROCinit
   50 ONERRORPROCerr:RUN
   60 MODE7:PROChello
   70 MODE2:VDU7,23,1,0;0;0;0;:PROCpost:VDU7:I%=0
   80 REPEAT:I%=I%+1
   90 REPEAT:X%=RND(30)-1:Y%=RND(30)-1:UNTILM%(X%,Y%)>0:U%=RND(30)-1:V%=RND(30)-1
  100 PROCinter(X%,Y%,U%,V%)
  110 PROCdisp(X%,Y%):PROCdisp(U%,V%)
  120 @%=&404:PRINTTAB(16,0)I%;:@%=&303
  130 UNTILFALSE
  140 :
  150 DEFPROCinit
  160 on$=CHR$132+CHR$157+CHR$135:off$="  "+CHR$156:@%=&303
  170 DIMM%(29,29),C%(8)
  180 ENDPROC
  190 :
  200 DEFPROChello
  210 PRINT'TAB(8)on$"Einsteinean Solids"off$''
  220 PRINT'"1>"on$"All 900 atoms with 1 quantum"TAB(36)off$
  230 PRINT'"2>"on$"300 atoms with 1 quantum"TAB(36)off$
  240 PRINT'"3>"on$"1/3 with 0,1 and 2 quanta"TAB(36)off$
  250 PRINTTAB(2,13)on$"Please select option :"off$;:REPEAT:L%=GET-&30:UNTILL%>0 ANDL%<4:VDU23,1,0;0;0;0;
  260 PRINTTAB(2,13)on$"Option "CHR$(L%+&30)" selected.  Please wait."off$
  270 IFL%=1 PROCinit1
  280 IFL%=2 PROCinit2
  290 IFL%=3 PROCinit3
  300 ENDPROC
  310 :
  320 DEFPROCinit1
  330 FORX%=0TO29:FORY%=0TO29:M%(X%,Y%)=1:NEXTY%,X%
  340 ENDPROC
  350 :
  360 DEFPROCinit2
  370 FORL%=0TO300:REPEAT:X%=RND(30)-1:Y%=RND(30)-1:UNTILM%(X%,Y%)=0:M%(X%,Y%)=1
  380 NEXTL%
  390 ENDPROC
  400 :
  410 DEFPROCinit3
  420 FORX%=0TO29:FORY%=0TO9:M%(X%,Y%)=2:M%(X%,Y%+10)=1:NEXTY%,X%
  430 ENDPROC
  440 :
  450 DEFPROCpost
  460 PRINTTAB(0,0)"Initialising :";
  470 FORL%=0TO960STEP32:MOVEL%,0:DRAWL%,960:MOVE0,L%:DRAW960,L%:NEXTL%
  480 FORL%=0TO7:PROCset(L%,39,29-L%):NEXTL%
  490 FORX%=0TO29:FORY%=0TO29:PROCdisp(X%,Y%):PROCcolour(X%,Y%,1):NEXTY%,X%
  500 PRINTTAB(0,0)SPC(14);
  510 ENDPROC
  520 :
  530 DEFPROCinter(X%,Y%,U%,V%)
  540 PROCcolour(X%,Y%,-1):M%(X%,Y%)=M%(X%,Y%)-1
  550 PROCcolour(X%,Y%,1)
  560 PROCcolour(U%,V%,-1):M%(U%,V%)=M%(U%,V%)+1:PROCcolour(U%,V%,1)
  570 ENDPROC
  580 :
  590 DEFPROCcolour(X%,Y%,C%)
  600 LOCALL%,P%:L%=M%(X%,Y%)
  610 IFL%>7 L%=7
  620 C%(L%)=C%(L%)+C%
  630 G%=L%:IFL%=0 G%=7
  640 FORP%=988TO1004STEP8
  650 GCOL0,G%
  660 MOVEP%+L%*24,0:DRAWP%+L%*24,C%(L%)+4
  670 GCOL0,0
  680 DRAWP%+L%*24,C%(L%)+8
  690 NEXTP%
  700 PRINTTAB(16,L%+2)C%(L%);
  710 ENDPROC
  720 :
  730 DEFPROCdisp(X%,Y%)
  740 LOCALL%
  750 L%=M%(X%,Y%)
  760 IFL%>7 L%=7
  770 PROCset(L%,X%,Y%)
  780 ENDPROC
  790 :
  800 DEFPROCset(C%,X%,Y%)
  810 GCOL0,C%
  820 MOVEX%*32+8,Y%*32+4:MOVEX%*32+8,Y%*32+28
  830 PLOT85,X%*32+28,Y%*32+4:PLOT85,X%*32+28,Y%*32+28
  840 ENDPROC
  850 :
  860 DEFPROCerr
  870 ONERROROFF
  880 IFERR=17 ANDNOTINKEY-1 ENDPROC
  890 REPORT:PRINT" at line ";ERL