10 REM ROUTE PLANNER
   20 REM Keith Anderson
   30 REM (c) CET 1983 Published by BBC Publications
   40 REM version 2.0
   50 :
   60 REM PORT SETUP
   70 port = &FE60        :REM User port (see manual for details).
   80 ?&FE62 = 15         :REM 00001111;  0 = input;  1 = output
   90 PROCmotors_on
  100 :
  110 REM USER AREA
  120 Xfactor = 1.175       :REM Adjust slightly on inaccurate TV sets
  130 speedcontrol = 2       :REM Higher values make the Buggy slower
  140 :
  150 REM MAIN PROGRAM
  160 ON ERROR IF ERR=17 THEN GOTO 250 ELSE PROCend :REPORT :PRINT" at line "ERL :END
  170 :
  180 MODE 7
  190 PROCoff
  200 PROCsetup_general
  210 PROCsetup_program
  220 PROCintroduction
  230 IF (?port AND 32) THEN PROCnogo : PROCend : END:REM Check if Buggy connected
  240 :
  250 PROCoff             :REM Cursor off
  260 REPEAT
  270 MODE 7
  280 PROCmenu
  290 IF option = 1 THEN MODE 4 : PROCroute_plan
  300 IF option = 2 THEN PROCdo_again
  310 IF option = 3 THEN PROCprint_route
  320 IF option = 4 THEN PROCchange_scale
  330 UNTIL option = 5
  340 :
  350 MODE 7
  360 PROCcomplete
  370 END
  380 :
  390 REM PROCEDURES SPECIFICALLY FOR "ROUTE PLANNER"
  400 DEF PROCchange_direction (turn,bearing)
  410 IF ABS (turn)= 270 THEN turn = SGN (turn) * -90
  420 IF turn < 0 THEN mem$(pointer) = "L" ELSE mem$(pointer) = "R"
  430 mem%(pointer) = ABS turn
  440 IF enough_room THEN PROCincrement_pointer
  450 ENDPROC
  460 :
  470 DEF PROCchange_scale
  480 LOCAL answer$
  490 CLS
  500 PROCdouble (CHR$130 +"Change Scale ",-1,5)
  510 PROCcentre (CHR$134 +"Current scale is  " +CHR$135 +STR$ (scale),8)
  520 REPEAT
  530 PROCcentre ("",13)
  540 PROCcentre ("",15)
  550 PROCcentre ("",17)
  560 PROCcentre ("New scale  ",11)
  570 scale = VAL (FNinput (3,digit$+"."))
  580 PROCcentre ("This will give you a maximum area",13)
  590 PROCcentre ("of approx " +STR$(INT(scale*185+23)) +" by " +STR$(INT(scale*100+23)) +" cms.",15)
  600 PROCcentre ("Accept? Y/N ",17)
  610 answer$ = FNinput (1,"YNyn")
  620 UNTIL answer$ = "Y" OR answer$= "y"
  630 ENDPROC
  640 :
  650 DEF PROCdo_again
  660 pointer = 0
  670 enough_room = TRUE
  680 IF mem%(pointer) = 0 THEN PROCno_mem ELSE PROCrepeat_route
  690 ENDPROC
  700 :
  710 DEF PROCincrement_pointer
  720 pointer = pointer + 1
  730 IF pointer >= array_size-1 THEN PROCno_space
  740 ENDPROC
  750 :
  760 DEF PROCintroduction
  770 CLS
  780 PROCdouble (CHR$130 +program_name$,-1,3)
  790 PROCcentre ("Plan a route on the screen,",8)
  800 PROCcentre ("select a scale, and the Buggy will",10)
  810 PROCcentre ("follow the route, staying inside",12)
  820 PROCcentre ("the scaled area. Choose a scale",14)
  830 PROCcentre ("to suit the area available.",16)
  840 PROCspace (20)
  850 ENDPROC
  860 :
  870 DEF PROCmenu
  880 CLS
  890 PRINT TAB(0,0) CHR$130 +"BBC Buggy"
  900 PROCdouble (CHR$130 +program_name$,-1,3)
  910 VDU 28,7,23,39,7
  920 PRINT "1. Plan a route.":PRINT
  930 PRINT "2. Drive Buggy.":PRINT
  940 PRINT "3. Print route.":PRINT
  950 PRINT "4. Change scale (currently " +STR$ scale +")":PRINT
  960 PRINT "5. Exit program."
  970 VDU 26
  980 PRINT TAB(3,20) "Your choice: ";
  990 option = VAL (FNinput (1,"12345"))
 1000 ENDPROC
 1010 :
 1020 DEF PROCno_mem
 1030 CLS
 1040 PROCdouble (CHR$130 +program_name$,-1,3)
 1050 PROCcentre (CHR$134 +"No route in memory.",12)
 1060 PROCspace (20)
 1070 ENDPROC
 1080 :
 1090 DEF PROCno_space
 1100 VDU 7
 1110 VDU 4
 1120 enough_room = FALSE
 1130 mem$(pointer) = "S"
 1140 mem%(pointer) =  0
 1150 ENDPROC
 1160 :
 1170 DEF PROCplot (bearing,count)
 1180 LOCAL X,Y
 1190 X = screenX +SIN (RAD (bearing)) * count
 1200 Y = screenY +COS (RAD (bearing)) * count
 1210 IF ABS(X) > horizontal OR ABS(Y-12) > vertical THEN off_screen = TRUE
 1220 MOVE X,Y
 1230 IF bearing = north THEN VDU 240
 1240 IF bearing = east  THEN VDU 241
 1250 IF bearing = south THEN VDU 242
 1260 IF bearing = west  THEN VDU 243
 1270 ENDPROC
 1280 :
 1290 DEF PROCprint_route
 1300 LOCAL direction,distance
 1310 CLS
 1320 pointer = 0
 1330 enough_room = TRUE
 1340 PROCdouble (CHR$130 +program_name$,-1,1)
 1350 PROCcentre (CHR$134 +"Current scale:" +CHR$135 +STR$(scale),4)
 1360 PROCcentre (CHR$134 +"Route now in memory:-",3)
 1370 PRINT TAB(0,5)
 1380 REPEAT
 1390 direction = INSTR(letter$,mem$(pointer))-1
 1400 distance  = mem%(pointer)
 1410 IF direction=forwards OR direction=backwards THEN distance = distance * scale
 1420 IF POS > 33 THEN PRINT
 1430 PRINT mem$(pointer);
 1440 IF direction=forwards OR direction=backwards THEN PRINT ;INT (distance * FWD +0.5),""; ELSE PRINT ;INT (distance+0.5),"";
 1450 IF enough_room THEN PROCincrement_pointer
 1460 UNTIL mem$(pointer-1) = "S" OR NOT enough_room
 1470 PROCspace (23)
 1480 ENDPROC
 1490 :
 1500 DEF PROCrecord (bearing,key)
 1510 LOCAL turn,count
 1520 turn = bearing - angle
 1530 IF turn <> 0 THEN PROCchange_direction (turn,bearing)
 1540 angle = bearing
 1550 mem$(pointer) = "F"
 1560 off_screen = FALSE
 1570 REPEAT
 1580 count = count + 1
 1590 IF count MOD plot_distance = 1 THEN PROCplot (bearing,count)
 1600 IF off_screen THEN count = count-plot_distance:off_screen = FALSE
 1610 UNTIL NOT INKEY (key)
 1620 PROCplot (bearing,count)
 1630 IF off_screen THEN count = count-plot_distance:off_screen = FALSE
 1640 screenX = screenX + SIN (RAD (bearing)) * count
 1650 screenY = screenY + COS (RAD (bearing)) * count
 1660 IF count < 0 THEN mem$(pointer) = "B"
 1670 mem%(pointer) = ABS count
 1680 IF enough_room THEN PROCincrement_pointer ELSE PROCcentre ("No more space for instructions.",28)
 1690 ENDPROC
 1700 :
 1710 DEF PROCrepeat_route
 1720 LOCAL direction,distance
 1730 CLS
 1740 PROCdouble (CHR$130 +"Drive Buggy",-1,1)
 1750 PROCcentre (CHR$133 +"Scale: " +CHR$135 +STR$(scale),3)
 1760 PRINT TAB(0,5)
 1770 REPEAT
 1780 IF POS > 33 THEN PRINT
 1790 direction = INSTR(letter$,mem$(pointer))-1
 1800 distance  = mem%(pointer)
 1810 IF direction = forwards OR direction = backwards THEN distance = distance * scale
 1820 PRINT mem$(pointer);
 1830 IF direction=forwards OR direction=backwards THEN PRINT ;INT (distance * FWD +0.5),""; ELSE PRINT ;INT (distance + 0.5),"";
 1840 PROCmove_buggy (direction,distance,speedcontrol,bumpers)
 1850 IF hit THEN PROCmove_buggy (backwards,safedistance,speedcontrol,nosensors)
 1860 IF enough_room THEN PROCincrement_pointer
 1870 UNTIL mem$(pointer) = "S" OR hit
 1880 PRINT"S0"
 1890 PROCspace (23)
 1900 ENDPROC
 1910 :
 1920 DEF PROCroute_plan
 1930 CLS
 1940 VDU 19,0,1,0,0,0           :REM Red background
 1950 VDU 19,1,7,0,0,0           :REM White foreground
 1960 PROCoff
 1970 PROCedge
 1980 MOVE 6,140
 1990 DRAW 1274,140
 2000 PROCcentre (program_name$,1)
 2010 PROCcentre ("Area is approx " +STR$(INT(scale*185+23)) +" by " +STR$(INT(scale*100+23)) +" cms.",2)
 2020 REPEAT
 2030 PROCcentre ("Use arrow keys to draw a path.",28)
 2040 PROCcentre ("Press SPACE to stop.",30)
 2050 VDU 29,640;536;:REM Set graphics origin
 2060 horizontal = 614
 2070 vertical   = 360
 2080 PROCrectangle (-horizontal,-vertical,horizontal,vertical)
 2090 horizontal = horizontal-15
 2100 vertical   = vertical  -15
 2110 VDU 24,-horizontal;-vertical;horizontal;vertical;
 2120 CLG
 2130 VDU 5
 2140 angle    = 0
 2150 screenX  = 0
 2160 screenY  = -324
 2170 pointer = 0
 2180 enough_room = TRUE
 2190 MOVE screenX,screenY
 2200 VDU 240
 2210 *FX 229,1
 2220 REM Disable ESCAPE
 2230 REPEAT
 2240 I$ = FNwait
 2250 IF INKEY (uparrow   ) THEN PROCrecord (north,uparrow   )
 2260 IF INKEY (downarrow ) THEN PROCrecord (south,downarrow )
 2270 IF INKEY (leftarrow ) THEN PROCrecord (west ,leftarrow )
 2280 IF INKEY (rightarrow) THEN PROCrecord (east ,rightarrow)
 2290 UNTIL INKEY (space) OR INKEY(escape) OR enough_room = FALSE
 2300 REPEAT UNTIL INKEY(nokey)
 2310 *FX 229
 2320 REM Re-enable ESCAPE
 2330 mem$(pointer)="S"
 2340 mem%(pointer)= 0
 2350 VDU 4
 2360 PROCcentre ("Accept (Y/N) ? ",30)
 2370 answer$ = FNinput (1,"YNyn")
 2380 UNTIL answer$="Y" OR answer$="y"
 2390 VDU4
 2400 ENDPROC
 2410 :
 2420 DEF PROCsetup_program
 2430 program_name$= "ROUTE PLANNER"
 2440 north        = 0
 2450 east         = 90
 2460 south        = 180
 2470 west         = 270
 2480 :
 2490 array_size   = 100
 2500 DIM mem$(array_size) , mem%(array_size)
 2510 pointer       = 0
 2520 mem$(0)       = "S"
 2530 mem%(0)       =  0
 2540 letter$       = "FR  LB"
 2550 scale         = .4
 2560 plot_distance = 24
 2570 VDU 23,240,0,0,0,64,160,0,0,0
 2580 VDU 23,241,0,0,128,64,128,0,0,0
 2590 VDU 23,242,0,0,160,64,0,0,0,0
 2600 VDU 23,243,0,0,32,64,32,0,0,0
 2610 @% = &606
 2620 ENDPROC
 2630 :
 2640 REM UNIVERSAL BUGGY PROCEDURES
 2650 DEF PROCboundary (X1,Y1,X2,Y2)
 2660 X1 = X1 * Xscale
 2670 X2 = X2 * Xscale
 2680 Y1 = Y1 *  scale
 2690 Y2 = Y2 *  scale
 2700 PROCrectangle (X1,Y1,X2,Y2)
 2710 VDU 24,X1;Y1;X2;Y2;      :REM Graphics window
 2720 ENDPROC
 2730 :
 2740 DEF PROCend
 2750 REM Switches motors off, resets cursor, EDIT & ESCAPE keys, buffers, and PRINT format
 2760 PROCmotors_off
 2770 PROCon
 2780 *FX 4
 2790 *FX 229
 2800 *FX 15
 2810 @% = 10
 2820 ENDPROC
 2830 :
 2840 DEF PROCmotors_off
 2850 ?port = 8
 2860 ENDPROC
 2870 :
 2880 DEF PROCmotors_on
 2890 ?port = 0
 2900 ENDPROC
 2910 :
 2920 DEF PROCmove_buggy (direction,move,speed,sensors)
 2930 count = 0
 2940 hit = 0
 2950 REPEAT
 2960 count = count + 1
 2970 ?port = direction     :PROCdelay (speed)
 2980 ?port = direction OR 2:PROCdelay (speed)
 2990 hit = (?port AND sensors)
 3000 UNTIL hit OR count>=move
 3010 ?port=0
 3020 IF direction = left      THEN turn     = turn     - count
 3030 IF direction = right     THEN turn     = turn     + count
 3040 IF direction = backwards THEN distance = distance - count
 3050 IF direction = forwards  THEN distance = distance + count
 3060 ENDPROC
 3070 :
 3080 DEF PROCnogo
 3090 PROCcentre ("Buggy not connected, END OF PROGRAM.",21)
 3100 PRINT
 3110 ENDPROC
 3120 :
 3130 DEF PROCsetup_general
 3140 REM Buggy dimensions are in centimetres
 3150 BF  = 3.9    :REM Buggy centre to bumper
 3160 BR  = 9      :REM Buggy centre to chassis rear
 3170 CW  = 6      :REM Half chassis width
 3180 BW  = 9      :REM Bumper width (1 side)
 3190 FWD = 0.1431944:REM Travel (cms/pulse)
 3200 safedistance = ( INT( SQR( BR*BR + CW*CW ) -BF )) / FWD +14
 3210 REM Values to compare with port
 3220 bumpers       = 192
 3230 leftbumper    = 128
 3240 rightbumper   = 64
 3250 nosensors     = 0
 3260 REM Keyboard control words
 3270 uparrow       = -58
 3280 downarrow     = -42
 3290 leftarrow     = -26
 3300 rightarrow    = -122
 3310 space         = -99
 3320 nokey         = -129
 3330 escape        = -113
 3340 REM Port values for Buggy movement
 3350 forwards      = 0
 3360 backwards     = 5
 3370 left          = 4
 3380 right         = 1
 3390 digit$ = "1234567890"  :REM Acceptable characters for numeric input
 3400 space$ = STRING$(36," ")
 3410 @%     = &303          :REM Print format
 3420 ENVELOPE 3,1,5,-5,5,10,10,10,5,0,-1,-1,126,0
 3430 ENDPROC
 3440 :
 3450 REM UTILITIES
 3460 DEF PROCcentre (text$,line)
 3470 PRINT TAB(1,line) SPC 38
 3480 PRINT TAB( FNcentre (text$),line) text$;
 3490 ENDPROC
 3500 :
 3510 DEF FNcentre (text$) =19-LEN(text$) DIV 2
 3520 :
 3530 DEF PROCcomplete
 3540 CLS
 3550 PROCdouble (CHR$ 131 +"Mission completed.",-1,10)
 3560 PROCend
 3570 ENDPROC
 3580 :
 3590 DEF PROCdelay (period)
 3600 LOCAL index
 3610 FOR index = 1 TO period : NEXT index
 3620 ENDPROC
 3630 :
 3640 DEF PROCdouble (text$,X,Y)
 3650 IF X<0 THEN X = FNcentre (text$)
 3660 PRINT TAB(X-1,Y  ) CHR$ 141;text$
 3670 PRINT TAB(X-1,Y+1) CHR$ 141;text$
 3680 ENDPROC
 3690 :
 3700 DEF PROCedge
 3710 PROCrectangle (6,6,1274,1018)
 3720 ENDPROC
 3730 :
 3740 DEF FNinput (length,allowed$)
 3750 LOCAL input$,ascii
 3760 PRINT STRING$(length,".");STRING$(length,CHR$ 8);
 3770 PROCon:*FX 15
 3780 REPEAT ascii = ASC FNwait
 3790 IF ascii=127 AND LEN(input$)>0 THEN input$ = LEFT$(input$,LEN(input$)-1):VDU ascii
 3800 IF INSTR(allowed$,CHR$ ascii) AND LEN(input$)<length THEN input$ = input$ +CHR$ ascii ELSE IF ascii<>13 AND ascii<>127 THEN ascii = 7
 3810 IF ascii=13 AND LEN(input$)<1 THEN ascii = 7
 3820 IF ascii=127 THEN VDU 46,8 ELSE VDU ascii
 3830 UNTIL ascii=13:PRINT:PROCoff
 3840 =input$
 3850 :
 3860 DEF FNlimit (X,Y,X1,Y1,X2,Y2)
 3870 IF X>X1 AND X<X2 AND Y>Y1 AND Y<Y2 THEN =FALSE ELSE =TRUE
 3880 :
 3890 DEF PROCoff VDU 23;11,0;0;0;0:ENDPROC
 3900 DEF PROCon  VDU 23;11,255;0;0;0:ENDPROC
 3910 :
 3920 DEF PROCrectangle (X1,Y1,X2,Y2)
 3930 MOVE X1,Y1
 3940 DRAW X1,Y2
 3950 DRAW X2,Y2
 3960 DRAW X2,Y1
 3970 DRAW X1,Y1
 3980 ENDPROC
 3990 :
 4000 DEF PROCspace (line)
 4010 PROCcentre ("Press the SPACE bar to continue.",line)
 4020 REPEAT I$ = FNwait : UNTIL INKEY (space) OR INKEY (escape)
 4030 ENDPROC
 4040 :
 4050 :
 4060 DEF FNwait
 4070 LOCAL I$
 4080 *FX 4,1
 4090 REPEAT
 4100 I$=INKEY$(10000)
 4110 IF I$="" THEN PROCmotors_off ELSE PROCmotors_on
 4120 UNTIL I$<>""
 4130 *FX 4
 4140 =I$
 4150 :