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
"