10 REM BAR CODE ROUTE PLANNER
   20 REM Mike Bostock
   30 REM (c) CET 1983 Published by BBC Publications
   40 REM version 2.0
   50 :
   60 ?&FE62 = 15 : REM 00001111 0-3 output 4-7 input
   70 port = &FE60 : REM user port location
   80 PROCmotors_on
   90 :
  100 ON ERROR PROCend : IF ERR=17 THEN PROCcomplete : END ELSE REPORT:PRINT" at line ";ERL:END
  110 :
  120 MODE7 : PROCoff
  130 PROCsetup
  140 PROCdouble (CHR$ 130 +program_name$,-1,7)
  150 IF NOT FNbuggy_connected THEN PROCnogo : PROCend : END
  160 :
  170 PROCcharacters
  180 PRINT TAB(2,20) "Do you need instructions ?  (Y/N) ";
  190 answer$ = FNinput (1,"YyNn")
  200 IF answer$="Y" OR answer$="y" THEN PROCintroduction
  210 :
  220 ON ERROR IF ERR=17 MODE7:PROCescape ELSE PROCend:REPORT:PRINT" at line ";ERL:END
  230 REM continues here after PROCescape
  240 IF end THEN PROCcomplete : PROCend : END
  250 :
  260 MODE4 : PROCoff : VDU 19,1,4,0,0,0 : VDU 19,0,7,0,0,0 : REM blue on white
  270 REPEAT
  280 REPEAT
  290 REPEAT
  300 IF fault = 0 THEN CLS
  310 crash = 0
  320 IF fault THEN M$ = "continue scan" ELSE M$ = "scan three cards"
  330 PROCscreen1
  340 PROCcentre ("Press ESCAPE to halt.",30)
  350 :
  360 PROCchoice1 : answer$ = FNinput (1,"1234")
  370 IF answer$="2" THEN CLS : PROClist : IF A$(1) <> "" THEN PROCreplay1 : PROCremove1 : PROCspace1 (28) : CLS
  380 IF answer$="3" THEN PROCmanual
  390 IF answer$="4" THEN CLS : PROClist : CLS
  400 UNTIL answer$ = "1"
  410 :
  420 PRINT TAB(25,1) instruction
  430 IF fault=0 THEN PROCclean
  440 fault = 0
  450 REPEAT
  460 PRINT TAB(5,1) card
  470 PROCbar_scan
  480 IF fault=0 THEN PROCmanage_card
  490 card = card + 1
  500 UNTIL card = 4 OR fault
  510 IF fault THEN PROCfault
  520 PROCerase
  530 IF fault<>2 THEN PROCspace1 (27)
  540 IF card = 4 AND fault = 0 THEN card = 1
  550 UNTIL instruction >48
  560 fault = 3
  570 PROCfault
  580 UNTIL FALSE
  590 END
  600 :
  610 :
  620 :
  630 DEF PROCbar_check (direction,colour)
  640 LOCAL pulse,edge
  650 pulse = (direction OR 2)
  660 pulsecount = 0 : edge = 0
  670 REPEAT
  680 ?port = direction : PROCdelay(speedcontrol)
  690 ?port = pulse : PROCdelay(2)
  700 IF FNsensor = colour THEN edge = 1
  710 pulsecount = pulsecount + 1
  720 IF pulsecount>maxwidth THEN fault = 1
  730 UNTIL edge OR fault
  740 ?port = 0
  750 ENDPROC
  760 :
  770 DEF PROCbar_scan
  780 fault = 0
  790 PROCsensor
  800 IF fault = 1 THEN ENDPROC
  810 PROCprocess
  820 IF fault = 2 OR fault = 3 THEN ENDPROC
  830 PROClook_up
  840 IF fault = 4 THEN ENDPROC
  850 ENDPROC
  860 :
  870 DEF PROCbig_number (marker,biggest)
  880 LOCAL I%
  890 FOR I% = 1 TO 5
  900 IF I% <> biggest THEN IF barwidth(I%) > barwidth(marker) THEN marker = I% : store  = I%
  910 NEXT
  920 ENDPROC
  930 :
  940 DEF FNbuggy_connected = NOT (?port AND 32)
  950 :
  960 DEF PROCcharacters
  970 REM box
  980 VDU23,239,255,129,129,129,129,129,129,255
  990 REM block
 1000 VDU23,240,255,255,255,255,255,255,255,255
 1010 ENDPROC
 1020 :
 1030 DEF PROCchoice1
 1040 PROCerase
 1050 PRINT TAB(3,25) "1 " M$
 1060 PRINT TAB(3,26) "2 carry out orders"
 1070 PRINT TAB(3,27) "3 manual drive"
 1080 PRINT TAB(3,28) "4 see instructions"
 1090 PRINT TAB(24,27) "Your choice: ";
 1100 ENDPROC
 1110 :
 1120 DEF PROCclean
 1130 LOCAL index
 1140 FOR index = 1 TO 3
 1150 PRINT TAB(33,index*7-1) " "
 1160 NEXT index
 1170 PRINT TAB(5,13) "   "
 1180 ENDPROC
 1190 :
 1200 DEF PROCcode1
 1210 LOCAL N,X,Y
 1220 X=6 : Y=9 : PRINT TAB(X,Y)
 1230 FOR N = 1 TO (instruction-1)
 1240 PRINT TAB(X,Y) A$(N) TAB(X+1,Y) B(N) TAB(X+5); : X=X+5
 1250 IF X>33 THEN PRINT : X=6 : Y=Y+2
 1260 NEXT N
 1270 ENDPROC
 1280 :
 1290 DEF PROCcommands
 1300 PROCdouble (CHR$ 130 +program_name$,-1,1)
 1310 PRINT TAB(6,5) "The command numbers are -"
 1320 PRINT TAB(11,7) "1   Forwards"
 1330 PRINT TAB(11) "2   Backwards"
 1340 PRINT TAB(11) "3   Left"
 1350 PRINT TAB(11) "4   Right"
 1360 PRINT TAB(11) "5   Wait"
 1370 ENDPROC
 1380 :
 1390 DEF PROCdelay (count)
 1400 LOCAL delay
 1410 FOR delay = 1 TO count : NEXT delay
 1420 ENDPROC
 1430 :
 1440 DEF PROCdelete_instruction
 1450 IF instruction > 1 THEN instruction = instruction - 1
 1460 IF instruction = 1 THEN A$(1) = ""
 1470 card = 1
 1480 ENDPROC
 1490 :
 1500 DEF PROCdirection
 1510 IF number = 1 THEN A$(instruction) = "F"
 1520 IF number = 2 THEN A$(instruction) = "B"
 1530 IF number = 3 THEN A$(instruction) = "L"
 1540 IF number = 4 THEN A$(instruction) = "R"
 1550 IF number = 5 THEN A$(instruction) = "W"
 1560 IF number = 0 OR number >5 THEN fault = 2
 1570 ENDPROC
 1580 :
 1590 DEF PROCdraw_card (position)
 1600 LOCAL B%,I%,J%
 1610 FOR B% = 1 TO 5
 1620 PRINT TAB(12,B%+position);
 1630 FOR I% = 1 TO 5
 1640 IF pattern(I%) = 1 THEN PRINT CHR$ 240 " ";
 1650 IF pattern(I%) = 4 THEN FOR J% = 1 TO 4:PRINT CHR$ 240;:NEXT J%:PRINT" ";
 1660 NEXT I%
 1670 NEXT B%
 1680 PRINT TAB(33,position+3) number
 1690 SOUND 1,-10,197,2
 1700 ENDPROC 
 1710 :
 1720 DEF PROCencode
 1730 REM This compiles the five-figure number
 1740 code = 0
 1750 FOR I% = 1 TO 5
 1760 code = code+pattern(I%)*10^(5-I%)
 1770 NEXT
 1780 ENDPROC
 1790 :
 1800 DEF PROCerase
 1810 LOCAL I%
 1820 FOR I% = 25 TO 28
 1830 PROCcentre (" ",I%)
 1840 NEXT I%
 1850 ENDPROC
 1860 :
 1870 DEF PROCescape
 1880 PROCmotors_on
 1890 fault = 0
 1900 PRINT TAB(0,1) CHR$(130) "BBC Buggy"
 1910 PROCdouble (CHR$ 130 +program_name$,-1,4)
 1920 PRINT TAB(7,8) "1. continue"
 1930 PRINT TAB(7,10) "2. delete last instruction"
 1940 PRINT TAB(7,12) "3. start again"
 1950 PRINT TAB(7,14) "4. see commands"
 1960 PRINT TAB(7,16) "5. end program"
 1970 PRINT TAB(3,20) CHR$(134) "Your choice: ";
 1980 answer$ = FNinput (1,"12345")
 1990 IF answer$ = "2" THEN PROCdelete_instruction
 2000 IF answer$ = "3" THEN RUN
 2010 IF answer$ = "4" THEN CLS : PROCcommands : PROCspace1 (23)
 2020 IF answer$ = "5" THEN end = 1
 2030 card=1
 2040 ENDPROC
 2050 :
 2060 DEF PROCfault
 2070 LOCAL count
 2080 count=0
 2090 IF fault = 1 THEN message$ = "READ FAULT"             : card = card - 1
 2100 IF fault = 2 THEN message$ = "Unexpected card"        : card = card - 1 
 2110 IF fault = 3 THEN message$ = "instruction store full" : instruction = instruction - 1
 2120 IF fault = 4 THEN message$ = "No record of this card" : card = card - 1
 2130 REPEAT
 2140 count = count + 1
 2150 PROCcentre (message$,30)
 2160 PROCdelay(600)
 2170 PROCcentre (" ",30)
 2180 SOUND 2,-15,197,1
 2190 PROCdelay(200)
 2200 UNTIL count=6
 2210 IF card <1 THEN card = 1
 2220 IF fault = 2 THEN PROCcentre ("card 1 range-1(F),2(B),3(L),4(R),5(W)",30) :G$=FNwait: PROCcentre (" ",30)
 2230 PROCcentre ("Press ESCAPE to restart from card 1",30)
 2240 IF fault = 2 THEN CLS
 2250 ENDPROC
 2260 :
 2270 DEF PROCintroduction
 2280 CLS
 2290 PROCdouble (CHR$ 130 +program_name$,-1,1)
 2300 PROCcentre ("Use the number cards to give the",7)
 2310 PROCcentre ("Buggy information about its route.",9)
 2320 PROCcentre ("Set them out in groups of three.",13)
 2330 PROCcentre ("The first card provides the command,",15)
 2340 PROCcentre ("the second and third give the",17)
 2350 PROCcentre (" distance (cms), or turn (degrees).",19)
 2360 PROCspace1 (23)
 2370 CLS
 2380 PROCcommands
 2390 PROCspace1 (23)
 2400 ENDPROC
 2410 :
 2420 DEF PROClast_card
 2430 PROCdelay(1000)
 2440 SOUND 1,-12,213,4
 2450 B(instruction) = ((ST*10)+number)
 2460 PRINT TAB(5,13) A$(instruction) B(instruction)
 2470 instruction = instruction + 1
 2480 ENDPROC
 2490 :
 2500 DEF PROClist
 2510 PROCrectangle(6,6,1274,1018)
 2520 IF A$(1)="" THEN PROCcentre (program_name$,1) : PROCcentre ("No instructions in memory.",14) : PROCspace1 (28) : CLS : ENDPROC
 2530 PRINT TAB(9,5) "My instructions are :-"
 2540 total = instruction - 1
 2550 PROCcode1
 2560 PROCspace1 (28)
 2570 ENDPROC
 2580 :
 2590 DEF PROClook_up
 2600 LOCAL N,I%
 2610 RESTORE 2620
 2620 DATA 11441,41114,14114,44111,11414,41411,14411,11144,41141,14141
 2630 fault = 4
 2640 FOR I%=0 TO 9
 2650 READ N
 2660 IF code = N THEN number = I% : fault = 0
 2670 NEXT
 2680 ENDPROC
 2690 :
 2700 DEF PROCmanage_card
 2710 position=(card*7)-4 : PROCdraw_card(position)
 2720 IF card = 1 THEN PROCdirection
 2730 IF card = 2 THEN ST = number
 2740 IF card = 3 THEN PROClast_card
 2750 ENDPROC
 2760 :
 2770 DEF PROCmanual
 2780 *FX 15,0
 2790 PROCerase
 2800 PROCcentre ("MANUAL DRIVE",26)
 2810 PROCcentre ("Use arrow keys to drive Buggy",27)
 2820 G$ = FNwait
 2830 PROCcentre("Press SPACE to continue",27)
 2840 REPEAT
 2850 G$=FNwait
 2860 *FX 4,1
 2870 IF INKEY (uparrow)    THEN PROCmove (forward,uparrow)
 2880 IF INKEY (downarrow)  THEN PROCmove (backward,downarrow)
 2890 IF INKEY (leftarrow)  THEN PROCmove (left,leftarrow)
 2900 IF INKEY (rightarrow) THEN PROCmove (right,rightarrow)
 2910 UNTIL G$=" "
 2920 REPEAT UNTIL INKEY(nokey)
 2930 PROCerase
 2940 ENDPROC
 2950 ?port = 0
 2960 ENDPROC
 2970 :
 2980 DEF PROCmotors_off
 2990 ?port = 8
 3000 ENDPROC
 3010 :
 3020 DEF PROCmotors_on
 3030 ?port = 0
 3040 ENDPROC
 3050 :
 3060 DEF PROCmove (direction,key)
 3070 LOCAL pulse
 3080 pulse = (direction OR 2)
 3090 REPEAT
 3100 ?port = direction : PROCdelay(4)
 3110 IF FNsensor =black THEN PRINT TAB(37,1) CHR$ 240 ELSE PRINT TAB(37,1) CHR$ 239
 3120 ?port = pulse : PROCdelay(2)
 3130 UNTIL INKEY(key) = FALSE
 3140 ?port = 0
 3150 ENDPROC
 3160 :
 3170 DEF PROCmove2 (direction,amount)
 3180 LOCAL counter,pulse
 3190 pulse =(direction OR 2)
 3200 IF direction = forward OR direction = backward THEN counter = amount*7 ELSE counter = amount
 3210 REPEAT
 3220 IF (?port AND bumpers) <>0 THEN SOUND 0,-15,4,20: crash=1 :PROCcentre("MISSION ABORTED",26) : UNTIL crash : ?port=0 :ENDPROC
 3230 ?port = direction : PROCdelay(speedcontrol)
 3240 ?port = pulse : PROCdelay(2)
 3250 counter = counter - 1
 3260 UNTIL counter <= 0 OR crash
 3270 PROCdelay(500)
 3280 ?port = 0
 3290 ENDPROC
 3300 :
 3310 DEF PROCnogo
 3320 PROCcentre ("Buggy not connected, END OF PROGRAM.",21)
 3330 PRINT
 3340 ENDPROC
 3350 :
 3360 DEF PROCpattern
 3370 LOCAL I%
 3380 FOR I% = 1 TO 5
 3390 IF I% = big1 OR I% = big2 THEN  pattern(I%) = 4 ELSE pattern(I%) = 1
 3400 NEXT
 3410 ENDPROC
 3420 :
 3430 DEF PROCprocess
 3440 store=1
 3450 PROCbig_number(store,0)
 3460 big1= store
 3470 IF store <> 1 THEN store = 1 ELSE store = 2
 3480 PROCbig_number(store,big1)
 3490 big2 = store
 3500 PROCpattern
 3510 PROCencode
 3520 ENDPROC
 3530  :
 3540 DEF PROCremove1
 3550 LOCAL N
 3560 X=6 : Y=10 : PRINT TAB(X,Y)
 3570 FOR N = 1 TO total
 3580 PRINT TAB(X,Y) " "; : X=X+5
 3590 IF X>33 THEN PRINT : X=6 : Y=Y+2
 3600 NEXT N
 3610 ENDPROC
 3620  :
 3630 DEF PROCreplay1
 3640 LOCAL N,X,Y
 3650 N=1 : X=6 : Y=10
 3660 PROCcentre ("FOLLOWING THE ROUTE...",28)
 3670 REPEAT
 3680 PRINT TAB(X,Y)
 3690 PRINT TAB(X,Y) "-" : X=X+5
 3700 IF X>33 THEN X=6 : Y=Y+2
 3710 IF A$(N)="W"THEN PROCdelay (B(N)*1500)
 3720 IF A$(N)="F"THEN PROCmove2 (forward,B(N))
 3730 IF A$(N)="B"THEN PROCmove2 (backward,B(N))
 3740 IF A$(N)="L"THEN PROCmove2 (left,B(N))
 3750 IF A$(N)="R"THEN PROCmove2 (right,B(N))
 3760 N=N+1
 3770 UNTIL N >= instruction OR crash
 3780 ENDPROC
 3790 :
 3800 DEF PROCscreen1
 3810 PRINT TAB(13,1) "instruction" TAB(25,1) instruction
 3820 PRINT TAB(1,1) "card" card TAB(33,1) "bar " CHR$ 239
 3830 PROCrectangle(6,6,1274,1018)
 3840 PROCrectangle(380,716,860,912)
 3850 PROCrectangle(380,492,860,688)
 3860 PROCrectangle(380,268,860,464)
 3870 PROCline(6,240,1274,240)
 3880 PROCline(6,930,1274,930)
 3890 PROCline(6,80,1274,80)
 3900 ENDPROC
 3910 :
 3920 DEF PROCsensor
 3930 bars = 0
 3940 REPEAT
 3950 fault = 0
 3960 bars = bars + 1
 3970 PRINT TAB(37,1) CHR$239
 3980 PROCbar_check (forward,1)
 3990 IF fault THEN UNTIL fault : ENDPROC
 4000 PRINT TAB(37,1) CHR$240
 4010 IF bars = 1 THEN duration = pulsecount ELSE strip(bars) = pulsecount
 4020 PROCbar_check (forward,0)
 4030 IF fault THEN UNTIL fault : ENDPROC
 4040 barwidth(bars) = pulsecount
 4050 PRINT TAB(37,1) CHR$239
 4060 UNTIL bars = 5 OR fault
 4070 ENDPROC
 4080 :
 4090 DEF FNsensor = ADVAL(2) DIV 33000
 4100 :
 4110 DEF PROCsetup
 4120 *FX 4,1
 4130 DIM A$(50)  : DIM B(50)
 4140 DIM strip(5): DIM barwidth(5)
 4150 DIM pattern(5)
 4160 A$(1)=""
 4170 program_name$ = "BAR CODE ROUTE PLANNER"
 4180 REM keyboard INKEY values
 4190 uparrow    = -58 : forward    = 0
 4200 downarrow  = -42 : backward   = 5
 4210 leftarrow  = -26 : left       = 4
 4220 rightarrow = -122: right      = 1
 4230 space      = -99
 4240 nokey      = -129
 4250 REM other variables
 4260 speedcontrol= 15
 4270 bumpers = 192
 4280 card       =  1
 4290 end        =  0  : fault      = 0
 4300 black      =  1  : white      = 0
 4310 maxwidth   = 100
 4320 instruction=  1  : crash      = 0
 4330 bumpers    = 192
 4340 @%=02            : REM print format 
 4350 ENDPROC
 4360 :
 4370 REM Utilities
 4380 :
 4390 DEF FNcentre (text$) =19-LEN(text$) DIV 2
 4400 :
 4410 DEF PROCcentre (text$,line%)
 4420 PRINT TAB(1,line%) SPC 38
 4430 PRINT TAB(FNcentre(text$),line%) text$
 4440 ENDPROC
 4450 :
 4460 DEF PROCcomplete
 4470 CLS
 4480 PROCdouble (CHR$ 131 +"Mission completed.",-1,10)
 4490 ENDPROC
 4500 :
 4510 DEF PROCdouble (text$,X,Y)
 4520 IF X<0 THEN X = FNcentre (text$)
 4530 PRINT TAB(X-1,Y  ) CHR$ 141; text$
 4540 PRINT TAB(X-1,Y+1) CHR$ 141; text$
 4550 ENDPROC
 4560 :
 4570 DEF PROCend
 4580 REM Switches motors off, resets cursor, EDIT & ESCAPE keys, buffers, and PRINT format
 4590 PROCmotors_off
 4600 PROCon
 4610 *FX 4
 4620 *FX 229
 4630 *FX 15
 4640 @% = 10
 4650 ENDPROC
 4660 :
 4670 DEF FNinput (length,allowed$)
 4680 LOCAL input$,ascii
 4690 PRINT STRING$(length,"."); STRING$(length,CHR$ 8);
 4700 PROCon:*FX 15
 4710 REPEAT ascii = ASC FNwait
 4720 IF ascii = 127 AND LEN(input$) >0 THEN input$ = LEFT$(input$,LEN(input$)-1) : VDU ascii
 4730 IF INSTR(allowed$,CHR$ ascii) AND LEN(input$)<length THEN input$ = input$ +CHR$ ascii ELSE IF ascii<>13 AND ascii<>127 THEN ascii = 7
 4740 IF ascii = 13 AND LEN(input$)<1 THEN ascii = 7
 4750 IF ascii = 127 THEN VDU 46,8 ELSE VDU ascii
 4760 UNTIL ascii = 13 : PRINT : PROCoff
 4770 =input$
 4780 :
 4790 DEF PROCline (X1,Y1,X2,Y2)
 4800 MOVE X1,Y1
 4810 DRAW X2,Y2
 4820 ENDPROC
 4830 :
 4840 DEF PROCoff VDU23;11,0;0;0;0:ENDPROC
 4850 DEF PROCon VDU23;11,255;0;0;0:ENDPROC
 4860 :
 4870 DEF PROCrectangle (X1,Y1,X2,Y2)
 4880 MOVE X1,Y1
 4890 DRAW X1,Y2
 4900 DRAW X2,Y2
 4910 DRAW X2,Y1
 4920 DRAW X1,Y1
 4930 ENDPROC
 4940 :
 4950 DEF PROCspace1 (line)
 4960 LOCAL I$
 4970 *FX 15
 4980 PROCcentre ("Press SPACE to continue",line)
 4990 REPEAT I$=FNwait : UNTIL INKEY(space)
 5000 PROCcentre (" ",line)
 5010 REPEAT UNTIL INKEY(nokey)
 5020 ENDPROC
 5030 :
 5040 :
 5050 DEF FNwait
 5060 LOCAL I$
 5070 *FX 4,1
 5080 REPEAT
 5090 I$=INKEY$(10000)
 5100 IF I$="" THEN PROCmotors_off ELSE PROCmotors_on
 5110 UNTIL I$<>""
 5120 *FX 4
 5130 =I$
 5140 :