8-Bit Software Online Conversion

Eureka - Listing

10REM PROGRAM EUREKA 20REM Version B.1.0 30REM Author Alan Gray 40REM BEEBUG 1993 50REM Program subject to copyright 60: 70MODE 7 80VDU19,7,0,0;0;0; 100DIM tag(6),m$(9),rn(6),sc%(8) 110b$=CHR$132+CHR$157+CHR$131 120r$=CHR$129+CHR$157+CHR$135 130cy$=CHR$134+CHR$157+CHR$132 140d$=CHR$141 150topsc%=100 160FOR j=1 TO 9:READ m$(j):NEXT 170REPEAT 180FOR j%=1 TO 8:sc%(j%)=0:NEXT 190n%=0 200REPEAT 210n%=n%+1 220FOR j%=1 TO 6:tag(j%)=0:NEXT 230PROCscreen(8) 240PRINTTAB(3,4)"Try to match the targ et using" 250PRINTTAB(3,5)"A B C D E F and / onl y once" 260PRINTTAB(3,6)"combined with ( ) + - and *" 270PRINTTAB(3,7)"Complying with BBC Ba sic syntax" 280A=RND(4) 290REPEAT:B=RND(4):UNTIL B<>A 300C=RND(6)+4:D=RND(6)+4 310REPEAT:E=RND(6)+4:UNTIL E<>D 320F=RND(4)*25 330IF F=25 T%=RND(499)+100 ELSE T%=RND (899)+100 340rn(1)=A:rn(2)=B:rn(3)=C 350rn(4)=D:rn(5)=E:rn(6)=F 360PRINTTAB(16,9);"Round ";n%; 370PRINTTAB(3,11);"Target number= ";T% 380PRINTTAB(3,15);"To correct input er rors" 390PRINTTAB(3,16);"Press delete key,wh ich" 400PRINTTAB(3,17);"erases the whole li ne." 410FOR j=1 TO 6 420PRINTTAB(32,10+j);CHR$(64+j);"=";rn (j) 430NEXT 440f$="":pos=0:pdiv=0:br1=0:br2=0 450TIME=0:nc=0:pc=0 460PRINTTAB(0,21); 470REPEAT 480ch=GET:ok=0:test=-1 490IF ch=127 THEN ch=7:PROCdel 500IF ch>64 AND ch<71 THEN PROCvar 510IF ch>41 AND ch<46 THEN PROCoper 520IF ch=40 OR ch=41 THEN PROCbrac 530IF ch=47 THEN PROCdiv 540IF ok THEN PROCformula 550IF ch=13 AND pos=0 THEN ch=7:PROCer r(9) 560IF ch=13 AND pc=3 THEN ch=7:PROCerr (7) 570IF ch=13 AND br1<>br2 THEN ch=7:PRO Cerr(2) 580UNTIL ch=13 590time%=TIME/100 600IF pdiv>0 THEN PROCchdiv 610FOR L%=15 TO 17:PRINTTAB(3,L%);SPC( 25):NEXT 620PROCscore 630sc%(n%)=score 640PRINTTAB(3,24)"PRESS ANY KEY TO CON TINUE"; 650w=GET 660UNTIL n%=8 670CLS:PROCtable 680UNTIL FALSE 690END 700: 1000DEFPROCscreen(s%) 1010CLS 1020FOR j=0 TO 2:PRINTcy$:NEXT 1030FOR j=3 TO s%:PRINTb$:NEXT 1040FOR j=s%+1 TO 19:PRINTr$:NEXT 1050FOR j=20 TO 22:PRINTcy$:NEXT 1060PRINTTAB(16,1)d$;"EUREKA" 1070PRINTTAB(16,2)d$;"EUREKA" 1080ENDPROC 1090: 1100DEFPROCdel 1110FOR j=1 TO pos 1120PRINTTAB(j+7,21);" " 1130PRINTTAB(j+7,22);" " 1140NEXT 1150f$=" ":pos=0:pdiv=0:br1=0:br2=0:nc= 0:pc=0 1160FOR j=1 TO 6:tag(j)=0:NEXT 1170FOR j=1 TO 6 1180PRINTTAB(28,10+j);r$:NEXT 1190ENDPROC 1200: 1210DEFPROCformula 1220f$=f$+CHR$(ch):pos=pos+1 1230PRINTTAB(6,21)d$;TAB(pos+7,21);CHR$ (ch) 1240PRINTTAB(6,22)d$;TAB(pos+7,22);CHR$ (ch) 1250ENDPROC 1260: 1270DEFPROCvar 1280IF pc=2 OR pc=4 THEN PROCerr(8):END PROC 1290IF tag(ch-64)=0 THEN ok=-1:pc=4:tag (ch-64)=1:nc=nc+1 ELSE PROCerr(5) 1300IF ok PRINTTAB(28,ch-54);b$ 1310ENDPROC 1320: 1330DEFPROCoper 1340IF nc=6 THEN PROCerr(1):ENDPROC 1350IF ch=44 ENDPROC 1360IF pc=2 OR pc=4 THEN ok=-1:pc=3 1370ENDPROC 1380: 1390DEFPROCdiv 1400IF pdiv>0 THEN PROCerr(3):ENDPROC 1410IF pc=0 OR pc=1 OR pc=3 THEN PROCer r(8):ENDPROC 1420IF pdiv=0 THEN pdiv=pos+1:ok=-1:pc= 3 1430ENDPROC 1440: 1450DEFPROCchdiv 1460test=-1 1470den$=MID$(f$,pdiv+1,1) 1480num$=MID$(f$,pdiv-1,1) 1490IF den$="(" THEN n=pdiv+1:PROCfcb 1500IF num$=")" THEN n=pdiv-1:PROCfob 1510den%=EVAL(den$) 1520IF den%=0 THEN test=0:PROCerr(4):EN D 1530IF NOT test PROCerr(1):ENDPROC 1540div$=num$+"/"+den$ 1550num=EVAL(div$) 1560IF ABS(num-INT(num))<.0001 THEN tes t=-1 ELSE test=0:PROCerr(6):ENDPROC 1570ENDPROC 1580: 1590DEFPROCfcb 1600REPEAT 1610n=n+1 1620IF MID$(f$,n,1)="(" THEN PROCfcb 1630UNTIL MID$(f$,n,1)=")" OR n=LEN(f$) 1640IF MID$(f$,n,1)=")" THEN den$=MID$( f$,pdiv+1,n) 1650ENDPROC 1660: 1670DEFPROCfob 1680REPEAT 1690n=n-1 1700IF MID$(f$,n,1)=")" THEN PROCfob 1710UNTIL MID$(f$,n,1)="(" OR n=1 1720IF MID$(f$,n,1)="(" THEN num$=MID$( f$,pdiv-1) 1730ENDPROC 1740: 1750DEFPROCbrac 1760IF br2=br1 AND ch=41 PROCerr(8):END PROC 1770IF ch=40 AND (pc=2 OR pc=4)PROCerr( 8):ENDPROC 1780IF ch=41 AND (pc=1 OR pc=3)PROCerr( 8):ENDPROC 1790IF br1<3 AND ch=40 br1=br1+1:ok=-1: pc=1 1800IF br2<br1 AND ch=41 br2=br2+1:ok=- 1:pc=2 1810ENDPROC 1820: 1830DEFPROCerr(l%) 1840PRINTTAB(2,24);m$(l%); 1850SOUND 0,-10,1,5 1860w=INKEY(200) 1870PRINTTAB(2,24);SPC(37); 1880ENDPROC 1890: 1900DEFPROCscore 1910ans%=EVAL(f$):dif%=ABS(T%-ans%) 1920PRINTTAB(6,12);"Your total= ";ans% 1930PRINTTAB(6,14);"Difference= ";dif% 1940IF dif%=0 score=50 1950IF dif%>0 AND dif%<4 score=20 1960IF dif%>3 AND dif%<11 score=10 1970IF dif%>10 score=0 1980IF time%<60 score=score*2 1990IF time%>120 score=score/2 2000PRINTTAB(3,16)"Time taken was ";tim e% "secs"; 2010PRINTTAB(5,18);"You scored ";score; "points" 2020ENDPROC 2030: 2040DEFPROCtable 2050PROCscreen(15) 2060tot%=0:top%=0:bon=1 2070FOR j%=1 TO 8 2080tot%=tot%+sc%(j%) 2090PRINTTAB(4,3)"Current top score ="t opsc% 2100PRINTTAB(4,j%+4);"Round ";j%,sc%(j% ) 2110IF sc%(j%)>top% top%=sc%(j%) 2120IF sc%(j%)>0 THEN bon=bon+bon 2130NEXT 2140PRINTTAB(4,13)"Total ",tot% 2150tot%=tot%+bon 2160IF tot%>topsc% THEN topsc%=tot% 2170PRINTTAB(4,15)"Bonus ",bon 2180PRINTTAB(4,17)"Score ",tot% 2190PRINTTAB(4,21)" Another game? Y/N" 2200REPEAT:an$=GET$:UNTIL an$="Y" OR an $="N" 2210IF an$="N" END 2220ENDPROC 2230: 2240DATA "All Variables have been used" 2250DATA "Missing bracket" 2260DATA "Only one divide allowed" 2270DATA "You can't divide by zero" 2280DATA "That variable already used" 2290DATA "Division not integer" 2300DATA "You can't end with an operato r" 2310DATA "You can't enter that characte r" 2320DATA "You pressed RETURN by mistake "