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