10 REM SUNSEEKER
   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 Buggy slower
  140 :
  150 REM MAIN PROGRAM
  160 ON ERROR IF ERR=17 THEN GOTO 450 ELSE PROCend:REPORT:PRINT" at line"ERL:END
  170 :
  180 MODE 7
  190 PROCsetup_general
  200 PROCsetup_program
  210 PROCintroduction
  220 IF (?port AND 32) THEN PROCnogo :PROCend :END :REM Check if Buggy connected
  230 PROCcheck_light
  240 :
  250 MODE 4
  260 PROCoff             :REM Cursor off
  270 REM Disable ESCAPE key
  280 *FX 229,1
  290 REPEAT
  300 VDU 26                :REM Reset text & graphics windows
  310 CLS
  320 VDU 19 , 1 , 7 ; 0 ;:REM White foreground
  330 VDU 19 , 0 , 1 ; 0 ;:REM Red background
  340 PROCscale
  350 PROCget_ready3
  360 UNTIL INKEY (space)
  370 REM Re-enable ESCAPE key
  380 *FX 229
  390 VDU 19 , 1 , 4 ; 0 ;:REM Blue foreground
  400 VDU 19 , 0 , 7 ; 0 ;:REM White background
  410 REM Disable edit keys
  420 *FX 4,1
  430 PROCgo_sun
  440 :
  450 MODE 7
  460 PROCmotors_off
  470 PROCerror
  480 END
  490 :
  500 REM PROCEDURES SPECIFICALLY FOR "SUNSEEKER"
  510 DEF PROCavoid_object (bumper)
  520 LOCAL firstturn,secondturn
  530 PROCcrash (bumper)
  540 IF (bumper AND leftbumper) <> 0 THEN firstturn = right : secondturn = left
  550 IF (bumper AND rightbumper) <> 0 THEN firstturn = left : secondturn = right
  560 PROCmove_buggy (firstturn,90,speedcontrol,bumpers)
  570 PROCmove_buggy (forwards,sidestep,speedcontrol,bumpers)
  580 PROCmove_buggy (secondturn,90,speedcontrol,bumpers)
  590 ENDPROC
  600 :
  610 DEF PROCcheck_light
  620 REPEAT UNTIL INKEY (nokey)
  630 CLS
  640 PROCcentre (CHR$134 +"CALIBRATE LIGHT SENSOR",2)
  650 PROCcentre ("Place the Buggy close to the light",8)
  660 PROCcentre ("to indicate its destination.",9)
  670 PRINT TAB(9,16) CHR$130 "Light value.." CHR$135
  680 PROCcentre ("Press the SPACE bar to continue.",22)
  690 PROCmotors_off
  700 REPEAT
  710 PROCmotors_off
  720 sunclose = ADVAL(1) DIV 100
  730 PRINT TAB(24,16) sunclose
  740 UNTIL INKEY (space)
  750 PROCmotors_on
  760 ENDPROC
  770 :
  780 DEF PROCerror
  790 LOCAL answer
  800 CLS
  810 PRINT TAB(0,1) CHR$130 +"BBC Buggy"
  820 PRINT TAB(7,10)"1. " +program_name$ +"."
  830 PRINT TAB(7,12)"2. Exit program."
  840 PRINT TAB(3,20)"Your choice: ";
  850 answer = VAL( FNinput (1,"12"))
  860 IF answer=1 THEN RUN
  870 PROCcomplete
  880 ENDPROC
  890 :
  900 DEF PROCget_ready3
  910 VDU 26                   :REM Reset text and graphics windows
  920 CLS
  930 PROCscreen               :REM Draw "Instrument panel"
  940 VDU 26                   :REM Reset text and graphics windows
  950 PROCcentre (program_name$,1)
  960 VDU 29,640-(horiz DIV 2*Xscale);320;:REM Set Graphics origin
  970 PROCboundary (0,0,horiz,vert)
  980 VDU 28,0,31,39,24        :REM Text window
  990 BGX = horiz DIV 2
 1000 BGY = BR + 2.5
 1010 PROCcalcpos
 1020 PROCcalcbug (GRX,GRY,0)
 1030 PROCdrawbug
 1040 oldX = GRX : oldY = GRY  :REM Save screen position
 1050 PROCcentre ("Press 'ESCAPE' to change scale",4)
 1060 PROCspace (6)
 1070 PROCcentre ("",4)
 1080 ENDPROC
 1090 :
 1100 DEF PROCgo_sun
 1110 LOCAL start_angle,arc
 1120 turn = 0
 1130 distance = 0
 1140 angle = 0
 1150 start_angle = 1
 1160 arc = 361
 1170 foundlight = FALSE
 1180 PROCcentre ("Press ESCAPE to stop the Buggy",6)
 1190 REPEAT
 1200 IF arc<>361 THEN PROCmove_buggy (backwards,safedistance,speedcontrol,nosensors)
 1210 PROCmove_buggy (left,start_angle,speedcontrol,nosensors)
 1220 PROCsunseek (arc)
 1230 start_angle = 45
 1240 arc = 90
 1250 PROCmove_buggy (forwards,seekdistance,speedcontrol,bumpers)
 1260 IF hit THEN PROCavoid_object (hit)
 1270 UNTIL foundlight
 1280 PROCcentre ("The Buggy has found the light source.",4):SOUND 1,-15,0,15
 1290 PROCspace (6)
 1300 REM Flush sound buffer
 1310 *FX 15
 1320 ENDPROC
 1330 :
 1340 DEF PROCintroduction
 1350 CLS
 1360 PROCoff
 1370 PROCdouble (CHR$ 130 +program_name$ +CHR$ 135,-1,5)
 1380 PROCcentre ("The Buggy will seek a light",12)
 1390 PROCcentre ("and head for it. Any obstacles",14)
 1400 PROCcentre ("will be negotiated",16)
 1410 PROCspace (21)
 1420 ENDPROC
 1430 :
 1440 DEF PROCscale
 1450 scale = 10               :REM Temporary values only
 1460 Xscale = scale * Xfactor
 1470 CLS
 1480 PROCcentre ("Place the Buggy in its area as shown,",2)
 1490 PROCcentre ("with the wheels 12 cms from the edge.",4)
 1500 PROCrectangle (226,288,1054,800)
 1510 PRINT TAB(19,8) "N" TAB(9,14) "W" TAB(30,14) "E"
 1520 VDU 29,0;288;     :REM Graphics origin
 1530 PROCcalcpos
 1540 PROCcalcbug (640,12*scale,0)
 1550 PROCdrawbug
 1560 VDU 28,1,30,38,24 :REM Make text window
 1570 VDU 29,0;0;       :REM Reset graphics origin
 1580 REPEAT
 1590 CLS
 1600 PROCedge
 1610 REM Re-enable ESCAPE key
 1620 *FX 229
 1630 PRINT TAB(36,1) "cm"
 1640 PRINT TAB(0,1) "Enter distance West to East     ";
 1650 horiz = VAL(FNinput (3,digit$))
 1660 PRINT TAB(36,3) "cm"
 1670 PRINT TAB(0,3) "Enter distance North to South   ";
 1680 vert = VAL(FNinput (3,digit$))
 1690 REM Disable ESCAPE key
 1700 *FX 229 , 1
 1710 IF FNmin (horiz,vert) < BW*6 THEN CLS : VDU 7 : PROCcentre ("Buggy space too cramped.",2) : PROCspace (4) : enoughspace = FALSE ELSE enoughspace = TRUE
 1720 UNTIL enoughspace
 1730 scale = 630/FNmax (horiz/1.77*Xfactor,vert)
 1740 Xscale = scale*Xfactor
 1750 VDU 26           :REM Text and graphics windows back to normal
 1760 ENDPROC
 1770 :
 1780 DEF PROCsetup_program
 1790 program_name$=  "SUNSEEK"
 1800 angle        = 0 :REM Buggy's compass bearing
 1810 turn         = 0 :REM temporary angle
 1820 distance     = 0 :REM default value
 1830 seekdistance = 400
 1840 light        = 0 :REM Light value
 1850 maxlight     = 0 :REM Maximum light level
 1860 sidestep = safedistance + BW / FWD
 1870 hit          = 0 :REM flag for bumpers
 1880 eyesopen = TRUE  :REM light reading flag
 1890 foundlight  = FALSE
 1900 scale    = 10    :REM default value
 1910 Xscale = scale * Xfactor :REM Xfactor set up in user area
 1920 ENVELOPE 3,1,5,-5,5,10,10,10,5,0,-1,-1,126,0
 1930 ENDPROC
 1940 :
 1950 DEF PROCsunseek (move)
 1960 LOCAL count,tempmax,backturn
 1970 count   = 0
 1980 tempmax = 0
 1990 REPEAT
 2000 count = count + 1
 2010 ?port = right      :PROCdelay (2)
 2020 ?port = right OR 2
 2030 light = ADVAL(1) DIV 100 : IF light >= sunclose THEN foundlight = TRUE
 2040 PROCupdate_light
 2050 IF light>tempmax THEN tempmax = light : backturn = count
 2060 UNTIL count >= move OR foundlight
 2070 turn = turn + count
 2080 PROCbug
 2090 PROCupdate
 2100 PROCmove_buggy (left,count-backturn,speedcontrol,nosensors)
 2110 ENDPROC
 2120 :
 2130 DEF PROCupdate_light
 2140 PRINT TAB(27,2) light
 2150 ENDPROC
 2160 :
 2170 REM UNIVERSAL BUGGY PROCEDURES
 2180 DEF PROCboundary (X1,Y1,X2,Y2)
 2190 X1 = X1 * Xscale
 2200 X2 = X2 * Xscale
 2210 Y1 = Y1 *  scale
 2220 Y2 = Y2 *  scale
 2230 PROCrectangle (X1,Y1,X2,Y2)
 2240 VDU 24,X1;Y1;X2;Y2;      :REM Graphics window
 2250 ENDPROC
 2260 :
 2270 DEF PROCbug
 2280 PROCdrawbug
 2290 PROCcalcpos
 2300 PROCcalcbug (GRX,GRY,angle)
 2310 PROCdrawbug
 2320 MOVE oldX,oldY
 2330 PLOT 29,GRX,GRY
 2340 oldX = GRX : oldY = GRY
 2350 IF FNlimit (BGX,BGY,BF,BF,horiz-BF,vert-BF) THEN PROCwarn ("The Buggy is going off the screen!") ELSE PROCcentre ("Press ESCAPE to exit program",4)
 2360 ENDPROC
 2370 :
 2380 DEF PROCcalcbug (X,Y,angle)
 2390 REM Accesses BF,BR,CW,BW,scale,Xscale
 2400 REM Alters Buggy screen co-ordinates
 2410 LOCAL SN,CS,leftoffset,rightoffset,frontoffset,rearoffset
 2420 frontoffset = RAD  angle
 2430 rearoffset  = RAD (angle-180)
 2440 leftoffset  = RAD (angle- 90)
 2450 rightoffset = RAD (angle+ 90)
 2460 REM Front middle of bumpers
 2470 FMX = X + BF * SIN frontoffset * Xscale
 2480 FMY = Y + BF * COS frontoffset * scale
 2490 REM Rear middle of chassis
 2500 RMX = X + BR * SIN rearoffset * Xscale
 2510 RMY = Y + BR * COS rearoffset * scale
 2520 REM Left side of buggy
 2530 SN = SIN leftoffset * Xscale
 2540 CS = COS leftoffset * scale
 2550 REM Left bumper
 2560 LBX = FMX + BW * SN
 2570 LBY = FMY + BW * CS
 2580 REM Front left corner
 2590 FLX = FMX + CW * SN
 2600 FLY = FMY + CW * CS
 2610 REM Rear left corner
 2620 RLX = RMX + CW * SN
 2630 RLY = RMY + CW * CS
 2640 REM Right side of buggy
 2650 SN = SIN rightoffset * Xscale
 2660 CS = COS rightoffset * scale
 2670 REM Right bumper
 2680 RBX = FMX + BW * SN
 2690 RBY = FMY + BW * CS
 2700 REM Front right corner
 2710 FRX = FMX + CW * SN
 2720 FRY = FMY + CW * CS
 2730 REM Rear right corner
 2740 RRX = RMX + CW * SN
 2750 RRY = RMY + CW * CS
 2760 ENDPROC
 2770 :
 2780 DEF PROCcalcpos
 2790 REM Updates Buggy co-ordinates
 2800 LOCAL A
 2810 angle = angle + turn
 2820 A = RAD angle
 2830 BGX = BGX + distance * FWD * SIN A
 2840 BGY = BGY + distance * FWD * COS A
 2850 GRX = BGX * Xscale
 2860 GRY = BGY * scale
 2870 distance = 0
 2880 turn = 0
 2890 ENDPROC
 2900 :
 2910 DEF PROCcrash (bumper)
 2920 IF (bumper AND  leftbumper)<>0 THEN MOVE LBX,LBY:PLOT 6,FMX,FMY:hit = -1
 2930 IF (bumper AND rightbumper)<>0 THEN MOVE RBX,RBY:PLOT 6,FMX,FMY:hit =  1
 2940 SOUND 0,-15,9+hit,4        :REM Different sound for each bumper
 2950 VDU 29,0;0;                :REM Graphics origin
 2960 VDU 24,510;220;800;700;    :REM Graphics window
 2970 MOVE 510,270 : MOVE 580,270
 2980 PLOT 86+hit,580,220        :REM Only the relevant triangle is filled
 2990 MOVE 730,270 : MOVE 800,270
 3000 PLOT 86-hit,730,220
 3010 VDU 29,640-horiz DIV 2 * Xscale;320;:REM Graphics origin
 3020 PROCboundary (0,0,horiz,vert)
 3030 PROCmove_buggy (backwards,safedistance,speedcontrol,nosensors)
 3040 VDU 29,0;0;                :REM Graphics origin
 3050 VDU 24,510;220;800;700;    :REM Graphics window
 3060 MOVE 510,270 : MOVE 580,270
 3070 PLOT 87,580,220            :REM Delete both triangles
 3080 MOVE 730,270 : MOVE 800,270
 3090 PLOT 87,730,220
 3100 VDU 29,640-horiz DIV 2 * Xscale;320;:REM Graphics origin
 3110 PROCboundary (0,0,horiz,vert)
 3120 ENDPROC
 3130 :
 3140 DEF PROCdrawbug
 3150 REM Ensures good corners at rear
 3160 MOVE    LBX,LBY
 3170 PLOT  6,RBX,RBY
 3180 MOVE    RLX,RLY
 3190 PLOT 30,FLX,FLY
 3200 MOVE    RLX,RLY
 3210 PLOT 30,RRX,RRY
 3220 PLOT 30,FRX,FRY
 3230 PLOT 70,RLX,RLY
 3240 ENDPROC
 3250 :
 3260 DEF PROCend
 3270 REM Switches motors off, resets cursor, EDIT & ESCAPE keys, buffers, and PRINT format
 3280 PROCmotors_off
 3290 PROCon
 3300 *FX 4
 3310 *FX 229
 3320 *FX 15
 3330 @% = 10
 3340 ENDPROC
 3350 :
 3360 DEF PROCmotors_off
 3370 ?port = 8
 3380 ENDPROC
 3390 :
 3400 DEF PROCmotors_on
 3410 ?port = 0
 3420 ENDPROC
 3430 :
 3440 DEF PROCmove_buggy (direction,move,speed,sensors)
 3450 count = 0
 3460 hit = 0
 3470 REPEAT
 3480 count = count + 1
 3490 ?port = direction     :PROCdelay (speed)
 3500 ?port = direction OR 2:PROCdelay (speed)
 3510 hit = (?port AND sensors)
 3520 IF eyesopen THEN light = ADVAL(1) DIV 100 :IF light >= sunclose-5 THEN foundlight = TRUE
 3530 UNTIL hit OR count>=move OR foundlight
 3540 ?port=0
 3550 IF direction = left      THEN turn     = turn     - count
 3560 IF direction = right     THEN turn     = turn     + count
 3570 IF direction = backwards THEN distance = distance - count
 3580 IF direction = forwards  THEN distance = distance + count
 3590 PROCbug
 3600 PROCupdate
 3610 PROCupdate_light
 3620 ENDPROC
 3630 :
 3640 DEF PROCnogo
 3650 PROCcentre ("Buggy not connected, END OF PROGRAM.",21)
 3660 PRINT
 3670 ENDPROC
 3680 :
 3690 DEF PROCscreen
 3700 REM "Instrument panel"
 3710 VDU 28,0,30,39,24     :REM Text window
 3720 CLS
 3730 RESTORE
 3740 FOR index = 1 TO 14
 3750 READ M1,M2,D1,D2
 3760 MOVE M1,M2
 3770 DRAW D1,D2
 3780 NEXT index
 3790 PRINT TAB(6,0)  "Position"
 3800 PRINT TAB(19,0) "Deg"
 3810 PRINT TAB(26,0) "Light"
 3820 DATA    6, 280,1270, 280,       6, 210, 500, 210,     590, 210, 720, 210
 3830 DATA  810, 210,1010, 210,       6, 140,1270, 140,    1070, 210,1270, 210
 3840 DATA  150, 280, 150, 140,     500, 280, 500, 140,      590, 280, 590, 140
 3850 DATA  720, 280, 720, 140,     810, 280, 810, 140,     1010, 280,1010, 140
 3860 DATA 1070, 280,1070, 140,    1170, 280,1170, 210
 3870 PROCedge
 3880 ENDPROC
 3890 :
 3900 DEF PROCsetup_general
 3910 REM Buggy dimensions are in centimetres
 3920 BF  = 3.9    :REM Buggy centre to bumper
 3930 BR  = 9      :REM Buggy centre to chassis rear
 3940 CW  = 6      :REM Half chassis width
 3950 BW  = 9      :REM Bumper width (1 side)
 3960 FWD = 0.1431944:REM Travel (cms/pulse)
 3970 safedistance = ( INT( SQR( BR*BR + CW*CW ) -BF )) / FWD +14
 3980 REM Values to compare with port
 3990 bumpers       = 192
 4000 leftbumper    = 128
 4010 rightbumper   = 64
 4020 nosensors     = 0
 4030 REM Keyboard control words
 4040 uparrow       = -58
 4050 downarrow     = -42
 4060 leftarrow     = -26
 4070 rightarrow    = -122
 4080 space         = -99
 4090 nokey         = -129
 4100 escape        = -113
 4110 REM Port values for Buggy movement
 4120 forwards      = 0
 4130 backwards     = 5
 4140 left          = 4
 4150 right         = 1
 4160 digit$ = "1234567890"  :REM Acceptable characters for numeric input
 4170 space$ = STRING$(36," ")
 4180 @%     = &303          :REM Print format
 4190 ENVELOPE 3,1,5,-5,5,10,10,10,5,0,-1,-1,126,0
 4200 ENDPROC
 4210 :
 4220 DEF PROCupdate
 4230 PRINT TAB(6,2) INT(BGX+0.5) "," INT(BGY+0.5)
 4240 angle = (360+angle) MOD 360
 4250 PRINT TAB(19,2) angle
 4260 ENDPROC
 4270 :
 4280 DEF PROCwarn (text$)
 4290 PROCcentre (text$,4)
 4300 SOUND &103,3,100,10
 4310 SOUND &102,3,117,10
 4320 ENDPROC
 4330 :
 4340 :
 4350 REM UTILITIES
 4360 DEF PROCcentre (text$,line)
 4370 PRINT TAB(1,line) SPC 38
 4380 PRINT TAB( FNcentre (text$),line) text$;
 4390 ENDPROC
 4400 :
 4410 DEF FNcentre (text$) =19-LEN(text$) DIV 2
 4420 :
 4430 DEF PROCcomplete
 4440 CLS
 4450 PROCdouble (CHR$ 131 +"Mission completed.",-1,10)
 4460 PROCend
 4470 ENDPROC
 4480 :
 4490 DEF PROCdelay (period)
 4500 LOCAL index
 4510 FOR index = 1 TO period : NEXT index
 4520 ENDPROC
 4530 :
 4540 DEF PROCdouble (text$,X,Y)
 4550 IF X<0 THEN X = FNcentre (text$)
 4560 PRINT TAB(X-1,Y  ) CHR$ 141;text$
 4570 PRINT TAB(X-1,Y+1) CHR$ 141;text$
 4580 ENDPROC
 4590 :
 4600 DEF PROCedge
 4610 PROCrectangle (6,6,1274,1018)
 4620 ENDPROC
 4630 :
 4640 DEF FNinput (length,allowed$)
 4650 LOCAL input$,ascii
 4660 PRINT STRING$(length,".");STRING$(length,CHR$ 8);
 4670 PROCon:*FX 15
 4680 REPEAT ascii = ASC FNwait
 4690 IF ascii=127 AND LEN(input$)>0 THEN input$ = LEFT$(input$,LEN(input$)-1):VDU ascii
 4700 IF INSTR(allowed$,CHR$ ascii) AND LEN(input$)<length THEN input$ = input$ +CHR$ ascii ELSE IF ascii<>13 AND ascii<>127 THEN ascii = 7
 4710 IF ascii=13 AND LEN(input$)<1 THEN ascii = 7
 4720 IF ascii=127 THEN VDU 46,8 ELSE VDU ascii
 4730 UNTIL ascii=13:PRINT:PROCoff
 4740 =input$
 4750 :
 4760 DEF FNlimit (X,Y,X1,Y1,X2,Y2)
 4770 IF X>X1 AND X<X2 AND Y>Y1 AND Y<Y2 THEN =FALSE ELSE =TRUE
 4780 :
 4790 DEF FNmax (A,B)
 4800 IF A>B THEN =A ELSE =B
 4810 :
 4820 DEF FNmin (A,B)
 4830 IF A<B THEN =A ELSE =B
 4840 :
 4850 DEF PROCoff VDU 23;11,0;0;0;0:ENDPROC
 4860 DEF PROCon  VDU 23;11,255;0;0;0:ENDPROC
 4870 :
 4880 DEF PROCrectangle (X1,Y1,X2,Y2)
 4890 MOVE X1,Y1
 4900 DRAW X1,Y2
 4910 DRAW X2,Y2
 4920 DRAW X2,Y1
 4930 DRAW X1,Y1
 4940 ENDPROC
 4950 :
 4960 DEF PROCspace (line)
 4970 PROCcentre ("Press the SPACE bar to continue.",line)
 4980 REPEAT I$ = FNwait : UNTIL INKEY (space) OR INKEY (escape)
 4990 ENDPROC
 5000 :
 5010 :
 5020 DEF FNwait
 5030 LOCAL I$
 5040 *FX 4,1
 5050 REPEAT
 5060 I$=INKEY$(10000)
 5070 IF I$="" THEN PROCmotors_off ELSE PROCmotors_on
 5080 UNTIL I$<>""
 5090 *FX 4
 5100 =I$
 5110 :