10 REMMODHow a Volcano erupts 20 REMMOD by Ian Warwick 30 REMLINEProgname "MAGMA" 40 REMDIVf0=sound f1=nosound 50 *KEY0*FX210,0|M 60 *KEY1*FX210,1|M 70 MODE1 80 DIM XP(16),YP(16),VV(8),VH(8) 90 PROCSETUP 100 PROCLTYPE 110 REPEAT 120 PROCERUPT 130 UNTIL H%>110 140 PROCPAUSE(2) 150 IF L$="R" THEN PROCNOCALD ELSE PROCCALD 160 *FX15,1 170 PRINT:COLOUR1:PRINT"Press any key for another volcano":Z%=GET:COLOUR3 180 GOTO90 190 END 200 DEFPROCSETUP 210 L%=0:XST=20:YST=50:S=0.6:PS=S 220 YOR=300:XOR=590:SP=0.2:B%=-250 230 VDU29,XOR;YOR; 240 VDU16,30,19,2,4;0; 250 GCOL0,3:MOVE-XOR,0:PLOT1,1280,0 260 PROCMAGMA 270 VDU23,230,0,0,0,7,8,16,38,32 280 VDU23,231,0,3,156,98,65,128,0,0 290 VDU23,232,0,0,206,49,17,136,0,2 300 VDU23,233,64,4,4,36,34,32,25,6 310 VDU23,234,0,0,40,40,20,19,132,120 320 VDU23,235,34,34,20,1,129,1,130,252 330 VDU23,240,24,60,127,127,254,254,60,24 340 VDU23,241,&4830;&3048;&200;&207; 350 CLOUD$="" 360 FOR I%=230 TO 232:CLOUD$=CLOUD$+CHR$(I%):NEXT 370 CLOUD$=CLOUD$+CHR$(10)+CHR$(8)+CHR$(8)+CHR$(8) 380 FOR I%=233 TO 235:CLOUD$=CLOUD$+CHR$(I%):NEXT 390 ENDPROC 400 DEFPROCMAGMA 410 DATA -170,-200,-110,-180,-150,-260,-60,-140 420 DATA -70,-260,70,-140,-30,-290,110,-180 430 DATA 70,-260,170,-185,170,-295,210,-260 440 RESTORE 410 450 READX%,Y%:MOVEX%,Y%:READX%,Y%:MOVEX%,Y% 460 GCOL0,1 470 FORI%=1 TO 10:READX%,Y%:PLOT85,X%,Y% 480 NEXT 490 ENDPROC 500 DEFPROCSTART 510 PRINTTAB(0,2);"Magma slowly moves towards the surface from it's underground chamber" 520 GCOL0,1:Y%=-140 530 REPEAT:MOVE-10-RND(8),Y%:DRAW10+RND(8),Y%:Y%=Y%+4:PROCPAUSE(0.2) 540 UNTIL Y%=0 550 PRINTTAB(0,2),"And then the eruption begins!";SPC(80);TAB(0,0); 560 SOUND0,-4,4,-1 570 Y%=32 580 MOVE-32,32:VDU5:GCOL0,3 590 FOR I%=1 TO 50 600 J%=230+(I% MOD 5):VDU J%,J%+1 610 Y%=Y%+RND(20):X%=RND(Y%*0.75)-Y%*0.38 620 MOVE X%,Y%:PROCPAUSE(0.1) 630 NEXT 640 VDU4 650 ENDPROC 660 DEFPROCFLOW(COL) 670 GCOL0,1 680 Y2=H%:X2=10:Y1=Y2-YST:X1=10:X%=X1+XST:Y%=Y1-PS*XST 690 MOVE X1,Y1:MOVE X2,Y2:PLOT85,X%,Y% 700 MOVE-X1,Y1:MOVE-X2,Y2:PLOT85,-X%,Y% 710 X1=X2:Y1=Y2:X2=X%:Y2=Y% 720 N%=2*H%/(XST*S) 730 FOR I%=1 TO N% 740 IF (I% MOD 2)=1 THEN X%=X2-XST/2:Y%=Y1-S*XST ELSE X%=X1+XST:Y%=Y1-PS*XST 750 PROCBUBBLE 760 ENVELOPE1,2,0,0,0,10,10,10,2,5,-5,-1,50,126 770 IF RND(3)=2 THEN SOUND&10,1,5,RND(15) 780 SOUND0,1,4,RND(20) 790 GCOL0,COL 800 IF Y%<0 THENY%=0 810 MOVE X1,Y1:MOVE X2,Y2:PLOT85,X%,Y% 820 MOVE-X1,Y1:MOVE-X2,Y2:PLOT85,-X%,Y% 830 X1=X2:Y1=Y2:X2=X%:Y2=Y% 840 PROCPAUSE(SP) 850 NEXT 860 ENDPROC 870 DEFPROCBUBBLE 880 GCOL3,1:VDU5 890 MOVE-16,B%:VDU241 900 B%=B%+60:IF B%>H% THEN B%=-250 910 MOVE-16,B%:VDU241 920 VDU4 930 ENDPROC 940 DEFPROCPLUME 950 GCOL0,3:X%=-RND(200):Y%=H%+160 960 IF L%<4 THEN Y%=Y%+110 970 VDU5 980 FOR I%=1 TO 9 990 X%=X%+RND(80)+20:Y%=Y%+RND(60) 1000 MOVE X%,Y%:PRINT CLOUD$ 1010 NEXT 1020 VDU4 1030 ENDPROC 1040 DEFPROCPAUSE(P) 1050 Z%=TIME+P*100 1060 REPEAT:UNTIL TIME>Z% 1070 ENDPROC 1080 DEFPROCLTYPE 1090 PRINTTAB(0,3);"Choose the type of lava for the volcano" 1100 REPEAT 1110 INPUT "RUNNY (R) or STICKY (S)",L$ 1120 L$=LEFT$(L$,1) 1130 UNTIL L$="R" OR L$="S" 1140 IF L$="R" THEN S=0.3:SP=0.05:EJ=1:YS=0:YST=20 ELSE S=0.6:SP=0.2:EJ=1:YST=40 1150 PS=S:PRINTTAB(0,3);SPC(120) 1160 ENDPROC 1170 DEFPROCERUPT 1180 REPEAT 1190 OK=TRUE 1200 INPUTTAB(0,2),SPC(35),TAB(0,2),"How many layers of lava",NL 1210 IF NL+L%>9 OR NL<1 THEN OK=FALSE:VDU7:PRINT "Between 1 and ";9-L%;" please!";TAB(0,2),SPC(30) 1220 UNTIL OK 1230 PRINTTAB(0,2);SPC(80);TAB(0,0) 1240 IF L%=0 THEN PROCSTART 1250 FOR C%=0 TO NL-1 1260 H%=(L%+1)*YST 1270 PROCEXPL(EJ) 1280 GCOL0,1:MOVE-10,H%:MOVE-10,H%-YST*2 1290 PLOT85,10,H%-YST*2:PLOT85,10,H% 1300 PROCFLOW(1):PROCPLUME 1310 PROCFLOW((L% MOD2)+2) 1320 PS=S:S=S*0.9:L%=L%+1 1330 NEXT 1340 ENDPROC 1350 DEFPROCEXPL(FL) 1360 T=0:TSTEP=2:YLLIM=0:G=-5 1370 IF FL=1 THEN YLLIM=YLLIM+32 1380 VDU5:GCOL3,1 1390 FOR I%=1 TO 8 1400 XP(I%)=RND(100)-50:YP(I%)=H%-RND(100) 1410 VH(I%)=RND(30)+10 1420 IF RND(2)=2 THEN VH(I%)=-VH(I%) 1430 VV(I%)=40+RND(50) 1440 NEXT 1450 ENVELOPE2,2,0,0,0,10,10,10,20,-1,0,-1,126,100 1460 SOUND&10,2,6,20:SOUND0,2,4,15 1470 REPEAT 1480 PROCDRAW 1490 T=T+TSTEP:FIN=TRUE 1500 FOR I%=9 TO 16 1510 YP(I%)=(G*T+VV(I%-8))*T+H% 1520 IF YP(I%)>YLLIM THEN FIN=FALSE:XP(I%)=VH(I%-8)*T ELSE YP(I%)=YLLIM 1530 NEXT 1540 PROCDRAW 1550 FORI%=1 TO 8 1560 XP(I%)=XP(I%+8):YP(I%)=YP(I%+8) 1570 NEXT 1580 UNTIL FIN 1590 GCOL0,3:PROCDRAW:VDU4 1600 ENDPROC 1610 DEFPROCDRAW 1620 FOR J%=1 TO 8 1630 MOVE XP(J%),YP(J%) 1640 IF FL=1 THEN VDU 240 ELSE PLOT65,0,0 1650 NEXT 1660 ENDPROC 1670 DEFPROCNOCALD 1680 PROCERASM 1690 PRINTTAB(0,0);"The volcano cools down .." 1700 PROCCOOLV 1710 PRINT"and becomes dormant." 1720 ENDPROC 1730 DEFPROCCALD 1740 PROCERASM 1750 PRINTTAB(0,0);"The volcano cools down .." 1760 PROCPAUSE(2):PROCCOOLV 1770 PRINT"and the magma pressure builds up below the plug ..":PROCPAUSE(3) 1780 PRINT"until .."; 1790 GCOL0,0:MOVE0,-20:MOVE-20,H%/2:PLOT85,20,H%/2 1800 PROCSEMIC(0,H%,H%/2) 1810 VDU5:GCOL0,3 1820 FOR I%=1 TO 50 1830 MOVE RND(200)-110,H%/2+RND(2*H%) 1840 VDU230+(I% MOD 6) 1850 NEXT 1860 VDU4:PRINT"an eruption makes a caldera"; :VDU5 1870 FOR P%=1 TO 6 1880 FOR I%=1 TO 5 1890 MOVE RND(200)-110,H%/2+RND(2*H%) 1900 VDU5,230+I% 1910 NEXT I% 1920 PROCEXPL(1) 1930 NEXT P% 1940 ENDPROC 1950 DEFPROCSEMIC(XC,YC,R) 1960 N%=20:MOVE XC-R,YC 1970 CD=COS(2*PI/N%):SD=SIN(2*PI/N%):CT=1:ST=0 1980 FOR I%=1 TO N%/2 1990 NCT=CT*CD-ST*SD:NST=ST*CD+CT*SD:CT=NCT:ST=NST 2000 MOVE XC,YC:PLOT85,XC-R*CT,YC-R*ST 2010 NEXT 2020 ENDPROC 2030 DEFPROCCOOLV 2040 GCOL0,3:Y%=H%-YST/4 2050 REPEAT:MOVE-10-RND(8),Y%:PLOT1,20+RND(16),0:Y%=Y%-4:PROCPAUSE(0.2) 2060 UNTIL Y%<-20 2070 ENDPROC 2080 DEFPROCERASM 2090 GCOL0,0:Y%=1024 2100 FOR I%=1 TO 6 2110 Y%=1024+4*I% 2120 REPEAT 2130 MOVE-XOR,Y%:PLOT1,1280,0:Y%=Y%-24:PROCPAUSE(0.1) 2140 UNTIL Y%