10 REM ******************************
20 REM *     Frantic Freddy         *
30 REM * by Martin Adams            *
40 REM *                            *
50 REM *  1523 Pershore Road        *
60 REM *   Stirchley                *
70 REM *    Birmingham              *
80 REM ******************************
90 REM
100 REM **** initialisation cold ******
110 DEFINT a-p,r-z
120 MODE 1
130 LOCATE 13,12:PRINT"Frantic Freddy"
140 FOR i=1 TO 3000:NEXT i
150 DIM screen[20,25],midp[10],monc[10],mx[6],my[6],md[6]
160 DIM scoret[10],namet$[10],skillt[10]
170 upleftk=0:uprightk=2:leftk=8:rightk=1
180 upleftj=72:uprightj=73:leftj=74:rightj=75
190 SYMBOL AFTER 248
200 SYMBOL 248,16,56,146,124,16,40,40,40
210 SYMBOL 249,16,56,16,254,16,40,68,130
220 REM
230 REM ********* TV type ************
240 CLS:PRINT"what type is your tv or monitor?"
250 LOCATE 4,4:PRINT"1) black and white"
260 LOCATE 4,6:PRINT"2) colour"
270 BORDER 0:INK 0,0:INK 1,24:INK 3,6:INK 5,24:INK 6,26:INK 8,18:INK 9,11
280 IF NOT INKEY(64) OR NOT INKEY(13) THEN INK 7,21:INK 10,26:INK 11,26:GOTO 360
290 IF NOT INKEY(65) OR NOT INKEY(14) THEN INK 7,6:INK 10,15:INK 11,18:GOTO 360
300 GOTO 280
310 REM
320 REM ******** play again? ********
330 CLS:PRINT "would you like to play again (y/n)?"
340 IF NOT INKEY(46) THEN CALL &BC02:BORDER 1:PAPER 0:PEN 1:CALL &BB03:CLS:END
350 IF INKEY(43) THEN 340
360 REM ******* instructions ********
370 CLS:PRINT" Bob a job Freddy thinks he has found aneasy job in moving some pot plants from the attic to the cellar of an old house."
380 PRINT:PRINT" But poor Freddy is in trouble because  the plants are magical and are gaurded  by angry ghosts."
390 PRINT:PRINT:PRINT" Freddy must hurry because once the"
400 PRINT"owner comes back his time is up althoughthe magical plants give him five lives."
410 LOCATE 1,25:PRINT"press space bar to continue"
420 IF INKEY(47) THEN 420
430 CLS
440 PRINT:PRINT " Move Freddy by using the cursor keys orjoystick as shown below":PRINT
450 PRINT:PRINT TAB(3)+CHR$(247);" to make Freddy go left."
460 PRINT:PRINT TAB(3)+CHR$(246);" to make Freddy go right."
470 PRINT:PRINT TAB(3)+CHR$(244);" to make Freddy jump to the left."
480 PRINT:PRINT TAB(3)+CHR$(245);" to make Freddy jump to the right."
490 LOCATE 1,25:PRINT"press space bar to continue"
500 IF INKEY(47) THEN 500
510 CLS
520 PRINT SPACE$(5);CHR$(248)+CHR$(248)+CHR$(248)+CHR$(248)+CHR$(248);
530 PRINT SPACE$(5);" score 0 ";SPACE$(5)+CHR$(143)
540 LOCATE 8,3:PRINT CHR$(240)
550 FOR i=4 TO 7:LOCATE 8,i:PRINT ":":NEXT i
560 PRINT "Freddy's lives."
570 LOCATE 20,3:PRINT CHR$(240)
580 FOR i=4 TO 12:LOCATE 20,i:PRINT ":":NEXT i
590 LOCATE 13,13:PRINT"Freddy's score."
600 LOCATE 30,3:PRINT CHR$(240)
610 FOR i=4 TO 16:LOCATE 30,i:PRINT ":":NEXT i
620 LOCATE 28,17:PRINT"Alarm "
630 LOCATE 19,19:PRINT"green/light-owner out."
640 LOCATE 19,21:PRINT"red/dark-owner nearby."
650 LOCATE 1,25:PRINT"press space bar to continue"
660 IF INKEY(47) THEN 660
670 REM
680 REM ******* skill level? *********
690 CALL &BB03
700 CLS:PRINT" The time taken for the owner to return is longer for higher skill levels"
710 PRINT:PRINT" Choose skill level  1  to 5  ";
720 IF NOT INKEY(64) OR NOT INKEY(13) THEN skill=1:GOTO 780
730 IF NOT INKEY(65) OR NOT INKEY(14) THEN skill=2:GOTO 780
740 IF NOT INKEY(57) OR NOT INKEY(5) THEN skill=3:GOTO 780
750 IF NOT INKEY(56) OR NOT INKEY(20) THEN skill=4:GOTO 780
760 IF NOT INKEY(49) OR NOT INKEY(12) THEN skill=5:GOTO 780
770 GOTO 720
780 PRINT skill
790 REM
800 REM **** initialisation warm *****
810 score=0:life=6
820 tlast=INT((RND*40)+30):tint=60*skill+tlast:tlast=tint-tlast
830 timeout=0
840 i=INT(RND*10):IF i>4 THEN side=1 ELSE side=-1
850 ilast=0:c=1
860 FOR i=1 TO 6:md[i]=1:NEXT i
870 GOSUB 2780:REM tune set up
880 REM
890 REM ****** screen set up ********
900 MODE 0:PEN 5
910 FOR i=1 TO 20:FOR j=1 TO 25:screen[i,j]=0:NEXT j:NEXT i
920 FOR i=1 TO 20
930 LOCATE i,1:PRINT CHR$(207);:screen[i,1]=14
940 LOCATE i,25:PRINT CHR$(207);:screen[i,25]=14
950 NEXT i
960 FOR i=2 TO 24
970 LOCATE 1,i:PRINT CHR$(207);:screen[1,i]=14
980 LOCATE 20,i:PRINT CHR$(207);:screen[20,i]=14
990 NEXT i
1000 FOR j=5 TO 21 STEP 4
1010 side=side*-1
1020 FOR i=2 TO 19
1030 LOCATE i,j:PRINT CHR$(207)
1040 screen[i,j]=14
1050 NEXT i
1060 IF side=1 THEN i=INT(RND*6)+3 ELSE i=INT(RND*6)+11
1070 IF i=ilast THEN 1060 ELSE ilast=i:midp(c)=i
1080 IF ilast>10 THEN monc[c]=3 ELSE monc[c]=18
1090 LOCATE i,j:PRINT CHR$(32)
1100 screen[i,j]=0:screen[i,j-1]=2:screen[i,j+3]=1
1110 c=c+1
1120 FOR lumps=1 TO 4
1130 lumpx=INT(RND*16)+3:IF lumpx=i OR screen[lumpx,j+1]=14 OR screen[lumpx+1,j+1]=14 OR screen[lumpx-1,j+1]=14 THEN 1130
1140 LOCATE lumpx,j+1:PRINT CHR$(207):screen[lumpx,j+1]=14
1150 NEXT lumps
1160 NEXT j
1170 PEN 8
1180 IF monc[1]=18 THEN temp=19 ELSE temp=2
1190 LOCATE temp,5:PRINT CHR$(35);:screen[temp,4]=4
1200 PEN 9
1210 IF monc[5]=18 THEN temp=19 ELSE temp=2
1220 LOCATE temp,25:PRINT CHR$(35);:screen[temp,24]=5
1230 PEN 10
1240 IF monc[1]=18 THEN LOCATE 19,4 ELSE LOCATE 2,4
1250 PRINT CHR$(229)
1260 PEN 6
1270 LOCATE 3,1:PRINT CHR$(248);CHR$(248);CHR$(248);CHR$(248);CHR$(32)
1280 LOCATE 8,1:PRINT"score";SPACE$(6);:LOCATE 13,1:PRINT score
1290 REM
1300 REM ****** place players *******
1310 snda=1
1320 IF sndsync=0 THEN 1320
1330 life=life-1:obj=0:fall=0:coll=0:caught=0:qdatum=TIME:ctime=0
1340 IF timeout=1 THEN timeout=0:LOCATE x,y:PRINT CHR$(32);
1350 PEN 11:LOCATE 17,1:PRINT CHR$(143)
1360 PEN 10
1370 IF monc[1]=18 THEN LOCATE 19,4 ELSE LOCATE 2,4
1380 PRINT CHR$(229)
1390 PEN 6
1400 LOCATE 3,1:PRINT SPACE$(5)
1410 LOCATE 3,1:FOR i=life-1 TO 1 STEP -1:PRINT CHR$(248);:NEXT i
1420 IF life=0 THEN CALL &BCA7:snda=0:sndb=0:GOSUB 2380:PEN 1:GOTO 320
1430 IF monc[5]=18 THEN x=19 ELSE x=2
1440 y=24:LOCATE x,y:PRINT CHR$(248)
1450 PEN 7
1460 st=0
1470 FOR m=1 TO 5
1480 st=st+4
1490 my[m]=st:mx[m]=monc[m]:LOCATE mx[m],my[m]:PRINT CHR$(224)
1500 NEXT m
1510 mx[6]=10:my[6]=24
1520 PEN 6
1530 REM
1540 REM ********* main loop ********
1550 GOSUB 1820:REM move Freddy
1560 IF coll THEN 1750:REM collision
1570 GOSUB 1930:REM Freddy fall
1580 PEN 7:REM move ghosts
1590 FOR m=1 TO 6
1600 xm=mx[m]:ym=m*4
1610 GOSUB 2340:IF caught THEN 1750
1620 IF screen[xm+md(m),ym]<2 THEN LOCATE xm,ym:PRINT CHR$(32);:mx[m]=xm+md[m]:xm=mx[m]:LOCATE xm,ym:PRINT CHR$(224); ELSE md[m]=md[m]*-1
1630 GOSUB 2340:IF caught THEN 1750
1640 NEXT m:REM ghost move ends
1650 PEN 6
1660 IF screen[x,y]=4 THEN obj=1
1670 IF obj THEN IF screen[x,y]=5 THEN obj=0:score=score+10/skill:LOCATE 13,1:PRINT SPACE$(3);:LOCATE 13,1:PRINT score:PEN 10:IF monc[1]=18 THEN LOCATE 19,4:PRINT CHR$(229) ELSE LOCATE 2,4:PRINT CHR$(229):PEN 6
1680 ctime=(TIME-qdatum)/300:IF ctime>tlast THEN PEN 3:LOCATE 17,1:PRINT CHR$(143):PEN 6
1690 IF ctime<tint THEN 1550
1700 REM
1710 REM ********* Freddy gone ********
1720 timeout=1
1730 SOUND 4,100,50,15:SOUND 4,200,50,15:SOUND 4,300,50,15
1740 FOR i=1 TO 200:NEXT i
1750 GOSUB 2780
1760 FOR m=1 TO 6
1770 LOCATE mx[m],my[m]:PRINT CHR$(32)
1780 NEXT m
1790 snda=0:sndb=0:CALL &BCA7:sndsync=0
1800 GOTO 1300:REM start again
1810 REM
1820 REM ******** Freddy MOVE ********
1830 IF fall THEN RETURN ELSE h1=x:h2=y
1840 IF NOT INKEY(upleftj) OR NOT INKEY(upleftk) THEN IF screen[x,y-1]<14 THEN jumpr=-1:GOTO 1890
1850 IF NOT INKEY(uprightj) OR NOT INKEY(uprightk) THEN IF screen[x,y-1]<14 THEN jumpr=1:GOTO 1890
1860 IF NOT INKEY(leftj) OR NOT INKEY(leftk) THEN IF screen[x-1,y]<14 THEN x=x-1:fr=248:GOTO 1900
1870 IF NOT INKEY(rightj) OR NOT INKEY(rightk) THEN IF screen[x+1,y]<14 THEN x=x+1:fr=248:GOTO 1900
1880 RETURN
1890 fr=248:GOSUB 2000
1900 IF coll=0 THEN LOCATE h1,h2:PRINT CHR$(32);:LOCATE x,y:PRINT CHR$(fr);
1910 RETURN
1920 REM
1930 REM ******* Freddy fall *********
1940 IF screen[x,y+1]=14 THEN RETURN
1950 LOCATE x,y:PRINT CHR$(32);
1960 y=y+1:LOCATE x,y:PRINT CHR$(249);
1970 IF screen[x,y+1]=14 THEN fall=0 ELSE fall=1
1980 RETURN
1990 REM
2000 REM ******* Freddy jump *********
2010 SOUND 4,100,20,15
2020 IF screen[x,y]<>1 THEN 2090
2030 LOCATE x,y:PRINT CHR$(32);
2040 FOR i=1 TO 4
2050 y=y-1:LOCATE x,y:PRINT CHR$(249);:LOCATE x,y:PRINT CHR$(32);
2060 NEXT i
2070 x=x+jumpr
2080 LOCATE x,y:PRINT CHR$(249);:RETURN
2090 LOCATE x,y:PRINT CHR$(32);
2100 x=x+jumpr:y=y-1:GOSUB 2230:IF coll THEN RETURN
2110 LOCATE x,y:PRINT CHR$(249);
2120 LOCATE x,y:PRINT CHR$(32);
2130 x=x+jumpr:y=y-1:GOSUB 2230:IF coll THEN RETURN
2140 LOCATE x,y:PRINT CHR$(249);
2150 LOCATE x,y:PRINT CHR$(32);
2160 x=x+jumpr:y=y+1:GOSUB 2230:IF coll THEN RETURN
2170 LOCATE x,y:PRINT CHR$(249);
2180 LOCATE x,y:PRINT CHR$(32);
2190 x=x+jumpr:y=y+1:GOSUB 2230:IF coll THEN RETURN
2200 LOCATE x,y:PRINT CHR$(249);
2210 RETURN
2220 REM
2230 REM *** Freddy collision check ***
2240 IF screen[x,y]<14 THEN coll=0:RETURN
2250 SOUND 4,0,30,15,0,0,15
2260 FOR i=1 TO 3
2270 LOCATE x,y:PRINT CHR$(203)
2280 FOR j=1 TO 100:NEXT j
2290 LOCATE x,y:PRINT CHR$(207)
2300 NEXT i
2310 coll=1
2320 RETURN
2330 REM
2340 REM **** Freddy caught check ****
2350 IF xm=x THEN IF ym=y THEN SOUND 4,100,15,15,0,1:LOCATE xm,ym:PRINT CHR$(32);:FOR i=1 TO 100:NEXT i:LOCATE xm,ym:PRINT CHR$(224);:caught=1
2360 RETURN
2370 REM
2380 REM ***** display scores ********
2390 MODE 1:PEN 5:CALL &BB03
2400 INPUT "what is your name ";name$
2410 name$=LEFT$(name$,9)
2420 CLS
2430 FOR i=10 TO 1 STEP -1
2440 IF scoret[i] > score THEN NEXT i:GOTO 2500
2450 FOR j=i TO 1 STEP -1
2460 tempscore=scoret[j]:tempname$=namet$[j]:tempskill=skillt[j]
2470 scoret[j]=score:namet$[j]=name$:skillt[j]=skill
2480 score=tempscore:name$=tempname$:skill=tempskill
2490 NEXT j
2500 PRINT" name"SPACE$(7);"score";SPACE$(8);"skill":PRINT
2510 FOR i=10 TO 1 STEP -1
2520 PRINT CHR$(32);namet$[i],scoret[i],skillt[i]
2530 NEXT i
2540 LOCATE 1,25:PRINT"press space bar to continue"
2550 IF INKEY(47) THEN 2550
2560 RETURN
2570 REM
2580 REM ****** tune part A **********
2590 IF snda=1 THEN sndb=1:sndsync=1 ELSE sndb=0:RETURN
2600 SOUND 1,300,20,vol
2610 SOUND 1,1000,25,0
2620 SOUND 1,400,20,vol
2630 SOUND 1,1000,20,0
2640 SOUND 1,300,20,vol
2650 RETURN
2660 REM
2670 REM ******* tune part B *********
2680 IF sndb=0 THEN RETURN
2690 SOUND 1,300,20,vol
2700 SOUND 1,1000,17,0
2710 SOUND 1,350,20,vol
2720 SOUND 1,1000,25,0
2730 SOUND 1,400,20,vol
2740 SOUND 2,1000,120,0
2750 SOUND 2,450,20,vol
2760 RETURN
2770 REM
2780 REM ********* tune set up ********
2790 ENT 1,150,-12,1
2800 delay1=350
2810 EVERY delay1 GOSUB 2580
2820 FOR i=1 TO 2500:NEXT i
2830 EVERY delay1,1 GOSUB 2580
2840 FOR i=1 TO 2500:NEXT i
2850 EVERY delay1,2 GOSUB 2670
2860 FOR i=1 TO 3000:NEXT i
2870 EVERY delay1,3 GOSUB 2670
2880 snda=1:vol=13
2890 RETURN