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