10 REM MEMORY SWITCH
   20 REM Mike Bostock
   30 REM (c) CET 1983 Published by BBC Publications
   40 REM version 2.0
   50 :
   60 ?&FE62 = 15 : REM 0000111 (lines 0-3 output/ lines 4-7 input)
   70 port=&FE60:REM user port location
   80 PROCmotors_on
   90 :
  100 speedfactor = 10
  110 :
  120 REM Detect arrow keys
  130 *FX 4,1
  140 ON ERROR IF ERR=17 THEN PROCcomplete : PROCend : END ELSE REPORT : PRINT " at line "; ERL : END
  150 :
  160 MODE7
  170 PROCoff
  180 PROCsetup
  190 IF NOT FNbuggy_connected THEN PROCtitle : PROCnogo : PROCend : END
  200 :
  210 REPEAT
  220 end=0 : start=0 : total=0 : hit=0
  230 CLS
  240 PROCtitle (3)
  250 PROCdetails
  260 PROCbox (8,18,148,20,4)
  270 PROCmanual
  280 IF hit THEN PROCcollision
  290 PROCchoice
  300 REPEAT
  310 REM Flush buffers
  320 *FX 15,0
  330 PRINT TAB(14,24) " "; TAB(14,24); : answer$ = FNinput (1,"1234")
  340 IF answer$ = "1" THEN PROCremove : PROCgohome
  350 IF answer$ = "2" THEN PROCremove : PROCreplay
  360 IF answer$ = "3" THEN start=1
  370 IF answer$ = "4" THEN end=1
  380 IF hit THEN PROCcollision : hit = 0
  390 UNTIL end OR start
  400 UNTIL end
  410 PROCcomplete
  420 PROCend
  430 END
  440 :
  450 :
  460 DEF PROCbox (X,Y,colour,length,width)
  470 PRINT TAB(X,Y) CHR$(colour) CHR$(188);
  480 FOR I% = 2 TO length : PRINT TAB(X+I%,Y) CHR$(44); : NEXT:PRINT CHR$(108)
  490 PRINT TAB(X,Y+width) CHR$(colour) CHR$(45)
  500 FOR I% = 2 TO length : PRINT TAB(X+I%,Y+width) CHR$(44); : NEXT : PRINT CHR$(174)
  510 FOR I% = Y+1 TO Y+width-1 : PRINT TAB(X,I%) CHR$(colour) CHR$(53) CHR$(135) TAB(X+length,I%) CHR$(colour) CHR$(234) : NEXT
  520 ENDPROC
  530 :
  540 DEF FNbuggy_connected = NOT (?port AND 32)
  550 :
  560 DEF PROCchoice
  570 CLS : PROCtitle (3)
  580 PROCcode
  590 PRINT TAB(2,7); "Here are the Buggy's instructions"; TAB(0,8);SPC(39)
  600 IF hit THEN hit = FALSE : PRINT TAB(4,8) "up to the point of collision"
  610 PRINT TAB(1,20) CHR$ 134 "Units used:" CHR$ 135 "Length - centimetres" TAB(14,21) "Angle  - degrees"
  620 REM Flush buffers
  630 *FX 15
  640 PRINT TAB(10,24) "Press the SPACE bar."; : REPEAT UNTIL FNwait = " "
  650 PRINT TAB(0,20) SPC(39) TAB(10,20) "1  Return home     " ; TAB(10,21) "2  Replay route     "
  660 PRINT TAB(10,22) "3  New run     " ; TAB(10,23) ; "4  End         " ; TAB(1,24) ; SPC(38) ; TAB(1,24) CHR$(134) "Now choose: ";
  670 ENDPROC
  680 :
  690 DEF PROCcode
  700 LOCAL X,N
  710 X=0 : PRINT TAB(X,9)
  720 FOR N = 1 TO total
  730 PRINT A$(N);
  740 IF A$(N) = "R" OR A$(N) = "L" THEN PRINT TAB(X+1) ; B(N) ; ELSE PRINT TAB(X+1) ; (INT((B(N)*FWD)+0.5));
  750 PRINT TAB(X+5); :X = X + 5
  760 IF X>35 THEN X=0 : PRINT
  770 NEXT N
  780 ENDPROC
  790 :
  800 DEF PROCcollision
  810 SOUND 0,-15,4,30
  820 direction = backward
  830 pulse = (direction OR 2)
  840 FOR counter = 1 TO 10
  850 ?port = direction : PROCdelay (speedfactor)
  860 ?port = pulse : PROCdelay (2)
  870 NEXT counter
  880 ENDPROC
  890 :
  900 DEF PROCdelay (count)
  910 FOR delay=1 TO count : NEXT delay
  920 ENDPROC
  930 :
  940 DEF PROCdetails
  950 PROCcentre ("Use the arrow keys to drive the Buggy.",7)
  960 PROCcentre ("Distance is in centimetres,",9)
  970 PROCcentre ("Angle is in degrees.",11)
  980 PROCcentre ("Press the SPACE bar to see",14)
  990 PROCcentre ("the remembered route.",16)
 1000 ENDPROC
 1010 :
 1020 DEF PROCgohome
 1030 FOR N = total TO 1 STEP-1
 1040 IF A$(N) = "F" THEN PROCmove2 (backward)
 1050 IF A$(N) = "B" THEN PROCmove2 (forward)
 1060 IF A$(N) = "L" THEN PROCmove2 (right)
 1070 IF A$(N) = "R" THEN PROCmove2 (left)
 1080 IF hit THEN N = 1
 1090 PROCdelay (500)
 1100 NEXT 
 1110 ENDPROC
 1120 :
 1130 DEF PROCinstruction
 1140 IF turn = 1 THEN PRINT TAB(21,20) CHR$(135) INT(counter) ELSE PRINT TAB(21,20) CHR$(135) (INT((counter*FWD)+0.5))
 1150 turn=0
 1160 ENDPROC
 1170 :
 1180 DEF PROCmanual
 1190 N=1
 1200 REPEAT
 1210 I$ = FNwait
 1220 IF INKEY(uparrow)   THEN A$(N)="F":PROCmove(forward,uparrow,"FORWARD")
 1230 IF INKEY(downarrow) THEN A$(N)="B":PROCmove(backward,downarrow,"BACKWARD")
 1240 IF INKEY (leftarrow)THEN A$(N)="L":PROCmove (left,leftarrow,"LEFT")
 1250 IF INKEY(rightarrow)THEN A$(N)="R":PROCmove (right,rightarrow,"RIGHT")
 1260 UNTIL INKEY (space) OR N>40 OR hit
 1270 total=N-1
 1280 A$(N)="" : B(N)=0
 1290 ENDPROC
 1300 :
 1310 DEF PROCmotors_off
 1320 ?port = 8
 1330 ENDPROC
 1340 :
 1350 DEF PROCmotors_on
 1360 ?port = 0
 1370 ENDPROC
 1380 :
 1390 DEF PROCmove (direction,key,text$)
 1400 LOCAL counter,pulse,turn
 1410 counter = 0
 1420 pulse = (direction OR 2)
 1430 PRINT TAB(12,20) CHR$(135) text$ SPC(13-LEN(text$))
 1440 REPEAT
 1450 IF (?port AND 192)<>0 THEN hit=1
 1460 ?port = direction : PROCdelay (speedfactor)
 1470 ?port = pulse : PROCdelay (2)
 1480 counter = counter + 1
 1490 UNTIL INKEY(key) = FALSE OR hit
 1500 B(N) = counter
 1510 N=N+1
 1520 IF direction = left OR direction = right THEN turn = 1
 1530 PROCinstruction
 1540 ENDPROC
 1550 :
 1560 DEF PROCmove2 (direction)
 1570 counter = 0
 1580 pulse = (direction OR 2)
 1590 REPEAT
 1600 IF (?port AND 192) <> 0 THEN hit = 1
 1610 ?port = direction : PROCdelay (speedfactor)
 1620 ?port = pulse : PROCdelay (2)
 1630 counter = counter + 1
 1640 UNTIL counter = B(N) OR hit
 1650 ENDPROC
 1660 :
 1670 DEF PROCnogo
 1680 PROCcentre ("Buggy not connected, END OF PROGRAM.",21)
 1690 PRINT
 1700 ENDPROC
 1710 :
 1720 DEF PROCremove
 1730 LOCAL X,Y,N
 1740 X=0 : Y=11 : PRINT TAB(X,Y)
 1750 FOR N=1 TO total
 1760 PRINT TAB(X,Y) ;" "; :X = X + 5
 1770 IF X>35 THEN X=0 : Y=Y+2
 1780 NEXT
 1790 ENDPROC
 1800 :
 1810 DEF PROCreplay
 1820 X=0 : Y=11 : PRINT TAB(X,Y)
 1830 FOR N=1 TO total
 1840 PRINT TAB(X,Y) "_"; : X=X+5
 1850 IF X>35 THEN X=0 : Y=Y+2
 1860 IF A$(N) = "F" THEN PROCmove2 (forward)
 1870 IF A$(N) = "B" THEN PROCmove2 (backward)
 1880 IF A$(N) = "L" THEN PROCmove2 (left)
 1890 IF A$(N) = "R" THEN PROCmove2 (right)
 1900 IF hit THEN N=total
 1910 PROCdelay (500)
 1920 NEXT N
 1930 ENDPROC
 1940 :
 1950 DEF PROCsetup
 1960 DIM A$(42) : DIM B(42)
 1970 REM keyboard INKEY values
 1980 uparrow    = -58 : forward    = 0
 1990 downarrow  = -42 : backward   = 5
 2000 leftarrow  = -26 : left       = 4
 2010 rightarrow = -122: right      = 1
 2020 space      = -99 : nokey      = -129
 2030 bumpers    = 192
 2040 FWD = 0.1431944
 2050 @%=04
 2060 ENDPROC
 2070 :
 2080 DEF PROCtitle (line%)
 2090 PROCdouble (CHR$ 130 + "MEMORY SWITCH" + CHR$ 135,-1,line%)
 2100 ENDPROC
 2110 :
 2120 REM Utilities
 2130 DEF PROCcomplete
 2140 CLS
 2150 PROCdouble (CHR$ 131 +"Mission completed.",-1,10)
 2160 ENDPROC
 2170 :
 2180 DEF PROCdouble (text$,X,Y)
 2190 IF X<0 THEN X = FNcentre (text$)
 2200 PRINT TAB(X-1,Y  ) CHR$ 141; text$
 2210 PRINT TAB(X-1,Y+1) CHR$ 141; text$
 2220 ENDPROC
 2230 :
 2240 DEF PROCend
 2250 REM Switches motors off, resets cursor, EDIT & ESCAPE keys, buffers, and PRINT format
 2260 PROCmotors_off
 2270 PROCon
 2280 *FX 4
 2290 *FX 229
 2300 *FX 15
 2310 @% = 10
 2320 ENDPROC
 2330 :
 2340 DEF PROCoff VDU23;11,0;0;0;0;   :ENDPROC
 2350 DEF PROCon  VDU23;11,255;0;0;0; :ENDPROC
 2360 :
 2370 DEF PROCcentre (text$,line%)
 2380 PRINT TAB(FNcentre(text$),line%) text$
 2390 ENDPROC
 2400 :
 2410 DEF FNcentre (x$) = 19-LEN(x$) DIV 2
 2420 :
 2430 DEF FNinput (length,allowed$)
 2440 LOCAL input$,ascii
 2450 PRINT STRING$(length,".");STRING$(length,CHR$ 8);
 2460 PROCon:*FX 15
 2470 REPEAT ascii = ASC FNwait
 2480 IF ascii=127 AND LEN(input$)>0 THEN input$ = LEFT$(input$,LEN(input$)-1):VDU ascii
 2490 IF INSTR(allowed$,CHR$ ascii) AND LEN(input$)<length THEN input$ = input$ +CHR$ ascii ELSE IF ascii<>13 AND ascii<>127 THEN ascii = 7
 2500 IF ascii=13 AND LEN(input$)<1 THEN ascii = 7
 2510 IF ascii=127 THEN VDU 46,8 ELSE VDU ascii
 2520 UNTIL ascii=13:PROCoff
 2530 =input$
 2540 REPEAT key = ASC FNwait : UNTIL key = 127 OR key = 13 : VDU key
 2550 UNTIL key = 13 : PROCoff : =key$
 2560  :
 2570 DEF FNwait
 2580 LOCAL I$
 2590 *FX 4 1
 2600 REPEAT
 2610 *FX 15
 2620 I$=INKEY$(10000)
 2630 IF I$="" THEN PROCmotors_off ELSE PROCmotors_on
 2640 UNTIL I$<>""
 2650 *FX 4
 2660 =I$
 2670 :