100 REMark ============================================= 110 REMark *** ZERO_2 Control program *** 120 REMark version see below after CLEAR 130 REMark History 131 REMark ------- 132 REMark ver1.0, copyright  David Buckley, 11/1/86 133 REMark ver2.0, copyright  David Buckley, 31/1/86 134 REMark ver2.2, copyright  David Buckley, May 1988 135 REMark 2.4 02Jun94 penmtrcmd$ introduced, <20 too fast 136 REMark 2.5 07Aug06 get_cmnd_val gave 0 for cmnd_val$>'999' 137 REMark 2.6 09Dec06 get_cmnd_val test >9999 removed, range test put in FD,BK,RT,LT 138 REMark homing$, unwinding$ flags added, maxTurn, maxRange added 139 REMark PROC ErrorMsg added 140 REMark 2.7 20Apr08 screen1 updated, flsh, flht, hoot parameter added 141 REMark 13580 PRINT #help_win,'LIGHTS - ll n rl n ls n flsh n flht n' 142 REMark 13590 PRINT #help_win,'HORN - hh n hl n hn n ho hoot n' 170 REMark --------------------------------------------- 180 REMark * PROGRAM * 190 : 200 CLEAR 210 prog_version$ = '2.7' 214 REMark directory$ ='win3_' 215 REMark directory$ ='win1_zero2_' 216 directory$ ='dos2_QL_Z2_' :REMark drive D 217 REMark directory$ ='dos6_QL_Z2_' :REMark drive H 220 coldinit 230 : 240 REMark * END PROGRAM * 250 REMark ============================================== 260 : 270 REMark Area for USER procedures 280 REMark 290 REMark Just add imagination! 300 : 310 DEFine PROCedure demo 320 LOCal i 330 alert 340 nolearn 350 home 360 unwind 370 buzz 380 drg_screen_height = 400 390 drg_screen_x_origin = 200 400 drg_screen_y_origin = 300 410 cmap 420 flht 4 430 FOR i = 1 TO 3 440 ls i :hn i 450 ls 0 :hn 0 460 END FOR i 470 pd:pu:flht 4:pd:pu:flht 4 480 wiggle 490 squarish (200) 500 unwind 510 END DEFine 520 : 530 DEFine PROCedure wiggle 540 flht 4 550 ls 3 560 FD 50 570 flht 4 580 BK 50 590 RT 50 600 flht 4 610 LT 50 620 flht 4 630 LT 50 640 flht 4 650 RT 50 660 alert 670 END DEFine 680 : 690 DEFine PROCedure squarish (d) 700 LOCal i 710 FOR i = 1 TO 4 720 pd 730 FD d/2 740 flht 4 750 buzz 760 FD d/2 770 pu 780 RT 45 790 flht 4 800 RT 65 810 hn 3 :ls 3 820 LT 20 830 ho 840 END FOR i 850 END DEFine 860 DEFine PROCedure test 870 ls 0:wt 50:ls 3:wt 50:GO TO 870 880 END DEFine 890 REMark ============================================== 900 REMark *** Start of SYSTEM PROCEDURES AREA 910 REMark ============================================= 920 REMark *** INITIALISATION PROCEDURES *** 930 REMark --------------------------------------------- 940 DEFine PROCedure init_globals 950 REMark *** GLOBAL VARIABLES *** 960 LOCal L, r$ 970 baud_rate=4800 980 cmnd_win=0 :REMark various messages and INPUT 990 zchan=3 :REMark for serial port to robot seri1 1000 memchan=4 :REMark For saving to zmem 1010 namchan=5 :REMark For saving to zmem_names 1012 Zmem$=directory$ & 'Zmem' 1014 Zmem_names$=directory$ & 'Zmem_names' 1020 full_win=6 :title_win=7 :mode_win=8 :step_win=9 1030 inf_win=10 :list_win=11 :drg_win=12 :help_win=13 1040 edit_win=14 1050 black=0 1060 red=2 1070 green=4 1080 white=7 1090 : 1100 no=0 :n=0 :yes=3 :y=3 1110 : 1120 off=0 1130 son=3 :REMark set_on, because 'on' is a reserved word 1140 : 1150 long_term_memory$ = '' 1160 routine_names$ = '' 1170 routine_lengths$ = '' 1180 learned_moves$='' 1190 learned_moves_tail$='' :REMark used as pad by ralter 1200 : 1205 learning=0 1210 speedfac=4 1211 penspeedfac=20 1213 peninitmtrcmd$="" 1214 maxTravel=2000 :REMark don't drag out umbilical [2.6] 1215 maxTurn=360 :REMark don't windup umbilical [2.6] 1217 homing$='no' :REMark so we can turn off range check during homing [2.6] 1218 unwinding$='no' :REMark so we can turn off range check during unwinding [2.6] 1228 : 1229 RESTORE 1300 1230 FOR i=1 TO 4 1240 READ chr 1250 FOR j=1 TO penspeedfac 1260 peninitmtrcmd$=peninitmtrcmd$&CHR$(chr) 1270 NEXT j 1280 NEXT i 1300 DATA 17,16,18,19 :REMark pen 1310 penpos$='up' 1320 byte_hl=32 :REMark command byte for leds & horn, initialy OFF 1330 : 1340 robot_x_pos=0 1350 robot_y_pos=0 1360 robot_heading=0 :REMark ie QLturtle 0 ie -> 1370 heading_offset=0 1380 x_offset=0 1390 y_offset=0 1400 : 1410 drg_screen_height = 2000 1420 drg_screen_x_origin = 1000 1430 drg_screen_y_origin = 1000 1440 REMark mtrcmnd$(4,) set up by init 1450 : 1460 RESTORE 1540 1470 READ robot_name_table$ 1480 REPeat L 1490 READ r$ 1500 IF r$ = '********:' THEN EXIT L 1510 robot_name_table$ = robot_name_table$ & r$ 1520 END REPeat L 1530 : 1540 DATA 'FD :BK :LT :RT :pu :' 1550 DATA 'pd :ll :rl :ls :hh :' 1560 DATA 'hl :hn :ho :wt :sb :' 1570 DATA 'home :ihome :alert :buzz :unwind :' 1580 DATA 'hoot :flsh :flht :' 1590 DATA '********:' :REMark more:- spk - speak ;snd - sound 1600 : 1610 END DEFine 1620 REMark --------------------------------------------- 1630 DEFine PROCedure coldinit 1640 REMark cold initialisation 1650 init_globals 1660 init_windows 1670 cmap 1680 get_routines 1690 alert 1700 learning_screens off 1710 CLS #list_win 1720 help 1730 zinit 1740 END DEFine 1750 REMark --------------------------------------------- 1760 DEFine PROCedure zinit :REMark USER entry 1770 REMark robot initialisation routine 1780 LOCal chr, arryl, r$, row, col, i, get_speed 1790 OPEN #zchan,seri:BAUD baud_rate 1800 REPeat get_speed 1810 CLS #cmnd_win 1820 PRINT #cmnd_win; 'input Speed factor, 3 to 20, default is 4' 1830 PRINT #cmnd_win; '(3 quickest, 20 very slow)' 1840 INPUT #cmnd_win;r$ 1850 r$ = strip_spaces$( r$ ) 1860 IF r$="" THEN r$="4" 1870 IF r$>'0' AND r$<'21':EXIT get_speed 1880 END REPeat get_speed 1890 speedfac=r$ 1900 PRINT #cmnd_win;' Thinking' 1910 arryl=4*speedfac 1920 DIM mtrcmd$(4,arryl) 1930 RESTORE 2120 1940 FOR row=0 TO 4 1950 FOR col=1 TO arryl STEP speedfac 1960 READ chr 1970 FOR i=1 TO speedfac 1980 mtrcmd$(row)=mtrcmd$(row)&CHR$(chr) 1990 NEXT i 2000 NEXT col 2010 NEXT row 2020 CLS #cmnd_win :PRINT #0;'OK' 2030 r$='n' 2040 INPUT #cmnd_win; 'Initialise pen to UP ? (yes/no) ';r$ 2050 r$ = strip_spaces$( r$ ) 2060 IF r$ = '' THEN 2070 penpos$ = 'up' 2080 ELSE 2090 IF r$(1)=='y' THEN peninit :ELSE penpos$ = 'up' 2100 END IF 2110 CLS #cmnd_win 2120 DATA 5, 0,10,15 :REMark forward 2130 DATA 10, 0, 5,15 :REMark backward 2140 DATA 6, 0, 9,15 :REMark right 2150 DATA 9, 0, 6,15 :REMark left 2160 DATA 17,16,18,19 :REMark pen 2170 END DEFine 2180 REMark ============================================= 2190 REMark *** ERROR RECOVERY *** 2200 REMark ---------------------------------------------- 2210 DEFine PROCedure oops :REMark USER entry 2220 LOCal L 2230 REMark error recovery procedure 2240 REMark if super-basic halts with an error when processing 2250 REMark cmnd_value in any of the user robot control procedures 2260 REMark invoking oops will allow cmnd_value to be re-entered 2270 REMark and the user procedure restarted by RETRY 2280 LOCal r$ 2290 REPeat L 2300 PRINT #cmnd_win ,'oops' 2310 PRINT #cmnd_win ,'value for' ! cmnd_name$ ! ' not understood' 2320 INPUT #cmnd_win,'please re-enter '&value_name$ !! r$ 2330 r$ = strip_spaces$( r$ ) 2340 IF r$='n' THEN r$='0' 2350 IF r$='no' THEN r$='0' 2360 IF r$='y' THEN r$='3' 2370 IF r$='yes' THEN r$='3' 2380 IF r$='off' THEN r$='0' 2390 IF r$='son' THEN r$='3' 2400 IF r$>='0' AND r$<'9999' THEN EXIT L 2410 END REPeat L 2420 cmnd_value=r$ 2430 CLS #cmnd_win 2440 RETRY 2450 END DEFine 2460 REMark ============================================= 2470 REMark *** USER ASSISTANCE *** 2480 REMark --------------------------------------------- 2490 DEFine PROCedure QUIT :REMark USER entry 2500 REMark quit session and close files 2510 LOCal i 2520 FOR i=3 TO 14 :CLOSE #i 2530 END DEFine 2540 REMark --------------------------------------------- 2550 DEFine PROCedure help :REMark USER entry 2560 LOCal L, r$, msg$ 2570 msg$ = ' SPACE-BAR to return, ENTER for more...' 2580 help_scrn_1 2590 r$=fn_wait_key$(msg$) 2600 IF r$ = 'quit' THEN drg_scrn :exit_help :RETurn 2610 IF r$ = 'more' THEN help_scrn_2 2620 r$=fn_wait_key$(msg$) 2630 IF r$ = 'quit' THEN drg_scrn :exit_help :RETurn 2640 IF r$ = 'more' THEN help_scrn_2a 2650 r$=fn_wait_key$(msg$) 2660 IF r$ = 'quit' THEN drg_scrn :exit_help :RETurn 2670 IF r$ = 'more' THEN help_scrn_3 2680 r$=fn_wait_key$(msg$) 2690 IF r$ = 'quit' THEN drg_scrn :exit_help :RETurn 2700 IF r$ = 'more' THEN help_scrn_3a 2710 msg$ = ' SPACE-BAR to return' 2720 r$=fn_wait_key$(msg$) 2730 exit_help 2740 END DEFine 2750 REMark --------------------------------------------- 2760 DEFine PROCedure exit_help 2770 drg_scrn 2780 CLS #cmnd_win 2790 cmap 2800 END DEFine 2810 REMark --------------------------------------------- 2820 DEFine FuNction fn_wait_key$(msg$) 2830 LOCal L, r$ 2840 CLS #cmnd_win 2850 PRINT #cmnd_win,msg$ 2855 REPeat L 2857 IF KEYROW(1)=0 THEN EXIT L 2858 END REPeat L 2860 REPeat L 2870 IF KEYROW(1)=1 THEN r$ = 'more' :EXIT L 2880 IF KEYROW(1)=64 THEN r$ = 'quit' :EXIT L 2890 END REPeat L 2895 REPeat L 2897 IF KEYROW(1)=0 THEN EXIT L 2898 END REPeat L 2900 RETurn r$ 2910 END DEFine 2920 REMark --------------------------------------------- 2930 DEFine FuNction strip_spaces$ ( word$ ) 2940 REMark strip leading spaces 2950 LOCal L 2960 IF LEN(word$) = 0 THEN RETurn word$ 2970 REPeat L 2980 IF word$(1) <> ' ' THEN RETurn word$ 2990 IF LEN(word$) <2 THEN RETurn '' 3000 word$ = word$(2 TO) 3010 END REPeat L 3020 END DEFine 3030 REMark --------------------------------------------- 3040 DEFine PROCedure alert :REMark USER entry 3050 REMark also a learnable robot procedure 3060 BEEP 30000,200,5,2000,10,15 3070 processing_link 'alert', 18, 0 3080 END DEFine 3090 REMark --------------------------------------------- 3100 DEFine PROCedure buzz :REMark USER entry 3110 REMark also a learnable robot procedure 3120 BEEP 8000,100 3130 processing_link 'buzz', 19, 0 3140 END DEFine 3150 REMark ============================================= 3160 REMark *** PROCESSING LINK *** 3170 REMark --------------------------------------------- 3180 DEFine PROCedure processing_link (cmnd$,cmnd_code,cmnd_value) 3190 REMark link robot control procedures to other processes 3200 display_moves cmnd$, 3210 IF learning THEN remember_move cmnd$ 3220 draw_move cmnd_code, cmnd_value 3230 robot_whereabouts cmnd_code, cmnd_value 3240 print_robot_position 3250 draw_robot 3260 END DEFine 3270 REMark ============================================= 3280 REMark *** ROBOT-CONTROL PROCEDURES *** 3290 REMark --------------------------------------------- 3300 DEFine PROCedure robot_whereabouts (cmnd_code, cmnd_value) 3310 REMark calculate robots new co-ordinates 3320 LOCal X, y, robot_ang 3330 robot_ang = RAD(robot_heading + heading_offset) 3340 X=cmnd_value * COS(robot_ang) 3350 y=cmnd_value * SIN(robot_ang) 3360 SELect ON cmnd_code 3370 = 1 :robot_x_pos = robot_x_pos + X 3380 robot_y_pos = robot_y_pos + y 3390 = 2 :robot_x_pos = robot_x_pos - X 3400 robot_y_pos = robot_y_pos - y 3410 = 3 :robot_heading = robot_heading +cmnd_value 3420 = 4 :robot_heading = robot_heading -cmnd_value 3430 END SELect 3440 END DEFine 3450 REMark --------------------------------------------- 3460 REMark * USER PROCEDURES * 3470 REMark --------------------------------------------- 3480 DEFine PROCedure home :REMark USER entry 3490 REMark robot moves to initialised position 3500 LOCal home_angle, turn_angle, robot_angle, temp_learning 3510 IF robot_x_pos = 0 AND robot_y_pos = 0 THEN RETurn 3520 processing_link 'home', 16,0 3530 temp_learning = learning 3540 nolearn 3545 homing$ ='yes' :REMark [2.6] 3550 robot_angle = RAD(robot_heading + heading_offset) 3560 IF robot_x_pos = 0 THEN 3570 IF robot_y_pos > 0 THEN 3580 home_angle = PI/2 3590 ELSE 3600 home_angle = 3*PI/2 3610 END IF 3620 ELSE 3630 home_angle=ATAN (robot_y_pos/robot_x_pos) 3640 END IF 3650 turn_angle =PI + home_angle - robot_angle 3660 IF robot_x_pos < 0 THEN turn_angle = PI + turn_angle 3670 IF turn_angle < PI THEN 3680 LT INT(DEG(turn_angle) +.5) 3690 ELSE 3700 RT INT(360 - DEG(turn_angle) +.5) 3710 END IF 3720 dist=SQRT(robot_x_pos^2 + robot_y_pos^2) 3730 FD INT(dist +.5) 3735 homing$ ='no' :REMark [2.6] 3740 learning = temp_learning 3750 IF learning THEN learn 3760 END DEFine 3770 REMark --------------------------------------------- 3780 DEFine PROCedure unwind :REMark USER entry 3790 REMark unwind umbilical until robot_heading = 0 3800 LOCal temp_learning 3810 processing_link 'unwind',20,0 3820 temp_learning = learning 3830 nolearn 3835 unwinding$ ='yes' :REMark [2.6] 3840 IF robot_heading >0 THEN 3850 RT INT(robot_heading +.5) 3860 ELSE 3870 LT INT(-robot_heading +.5) 3880 END IF 3885 unwinding$ ='no' :REMark [2.6] 3890 print_robot_position 3900 learning = temp_learning 3910 IF learning THEN learn 3920 END DEFine 3930 REMark --------------------------------------------- 3940 DEFine PROCedure ihome :REMark USER entry 3950 REMark initialise home position 3960 heading_offset = heading_offset + robot_heading 3970 x_offset = x_offset + robot_x_pos 3980 y_offset = y_offset + robot_y_pos 3990 robot_x_pos = 0 4000 robot_y_pos = 0 4010 robot_heading = 0 4020 processing_link 'ihome',16,0 4030 END DEFine 4040 REMark ---------------------------------------------- 4050 DEFine PROCedure sb(cmnd_value) :REMark USER entry 4060 REMark send_byte to robot 4070 LOCal cmnd_name$, value_name$ 4080 cmnd_name$='sb' :value_name$ = 'byte' 4090 PRINT #zchan, CHR$( cmnd_value ); 4100 processing_link 'sb '&cmnd_value,15,cmnd_value 4110 END DEFine 4120 REMark --------------------------------------------- 4130 DEFine PROCedure jc :REMark USER entry 4140 REMark joystick_control 4150 REMark forward, back, right, left 4160 REMark space_bar QUITS 4165 REMark pause 1 added for Goldcard? or QPC? 4170 LOCal LOOP,X,k,f,b,r,L,cmnd$,n,cmnd_code 4180 f=0:b=1:r=2:L=3 4190 CLS#0 4200 PRINT #cmnd_win;'Joystick or cursor keys'\'Space Bar to QUIT' 4210 REPeat LOOP 4220 n=0 4230 k=KEYROW(1) 4240 SELect ON k 4250 ON k=64 :REMark space_bar QUITS 4260 EXIT LOOP 4270 ON k=4 :cmnd$='FD' :cmnd_code=1 :REMark forward 4280 REPeat X:PRINT#zchan,mtrcmd$(0);:n=n+1:PAUSE 1:IF KEYROW(1)<>4:EXIT X 4290 ON k=128 :cmnd$="BK" :cmnd_code=2 :REMark back 4300 REPeat X:PRINT#zchan,mtrcmd$(1);:n=n+1:PAUSE 1:IF KEYROW(1)<>128:EXIT X 4310 ON k=16 :cmnd$='RT' :cmnd_code=4 :REMark right 4320 REPeat X:PRINT#zchan,mtrcmd$(2);:n=n+1:PAUSE 1:IF KEYROW(1)<>16:EXIT X 4330 ON k=2 :cmnd$='LT' :cmnd_code=3 :REMark left 4340 REPeat X:PRINT#zchan,mtrcmd$(3);:n=n+1:PAUSE 1:IF KEYROW(1)<>2:EXIT X 4350 END SELect 4360 IF n>0 THEN 4370 processing_link cmnd$&' '&(n*2), cmnd_code, n*2 4380 END IF 4390 END REPeat LOOP 4400 CLS #cmnd_win 4410 END DEFine 4420 REMark --------------------------------------------- 4430 DEFine PROCedure FD(cmnd_value) :REMark USER entry 4440 REMark forward ( distance ) 4450 LOCal cmnd_name$, value_name$, s, n 4460 cmnd_name$='FD' :value_name$='distance ' 4470 IF cmnd_value <0 THEN 4480 BK -cmnd_value 4490 ELSE 4492 IF homing$='no' THEN 4493 IF cmnd_value>maxTravel THEN ErrorMsg 'Too far, max is ',maxTravel :cmnd_value=0 4499 END IF 4500 s=cmnd_value/2 :REMark 4 0.5mm steps =2mm so divide by 2 4510 FOR n=1 TO s:PRINT #zchan,mtrcmd$(0); 4520 processing_link 'FD '&cmnd_value, 1, cmnd_value 4530 END IF 4540 END DEFine 4550 REMark --------------------------------------------- 4560 DEFine PROCedure BK(cmnd_value) :REMark USER entry 4570 REMark back ( distance ) 4580 LOCal cmnd_name$, value_name$, s, n 4590 cmnd_name$='BK' :value_name$='distance ' 4600 IF cmnd_value <0 THEN 4610 FD -cmnd_value 4620 ELSE 4622 IF homing$='no' THEN 4623 IF cmnd_value>maxTravel THEN ErrorMsg 'Too far, max is ',maxTravel :cmnd_value=0 4624 END IF 4630 s=cmnd_value/2 :REMark 4 0.5mm steps =2mm so divide by 2 4640 FOR n=1 TO s:PRINT #zchan,mtrcmd$(1); 4650 processing_link 'BK '&cmnd_value, 2, cmnd_value 4660 END IF 4670 END DEFine 4680 REMark --------------------------------------------- 4690 DEFine PROCedure RT(cmnd_value) :REMark USER entry 4700 REMark right_turn ( angle ) 4710 LOCal cmnd_name$, value_name$, t, n 4720 cmnd_name$='RT' :value_name$='angle ' 4730 IF cmnd_value <0 THEN 4740 LT -cmnd_value 4750 ELSE 4752 IF unwinding$='no' THEN 4753 IF cmnd_value>maxTurn THEN ErrorMsg 'Too far, max is ',maxTurn :cmnd_value=0 4754 END IF 4760 t=cmnd_value/2 4770 FOR n=1 TO t:PRINT #zchan,mtrcmd$(2); 4780 processing_link 'RT '&cmnd_value, 4, cmnd_value 4790 END IF 4800 END DEFine 4810 REMark --------------------------------------------- 4820 DEFine PROCedure LT(cmnd_value) :REMark USER entry 4830 REMark left_turn ( angle ) 4840 LOCal cmnd_name$, value_name$, t, n 4850 cmnd_name$='LT' :value_name$='angle ' 4860 IF cmnd_value <0 THEN 4870 RT -cmnd_value 4880 ELSE 4882 IF unwinding$='no' THEN 4883 IF cmnd_value>maxTurn THEN ErrorMsg 'Too far, max is ',maxTurn :cmnd_value=0 4884 END IF 4890 t=cmnd_value/2 4900 FOR n=1 TO t:PRINT #zchan,mtrcmd$(3); 4910 processing_link 'LT '&cmnd_value, 3, cmnd_value 4920 END IF 4930 END DEFine 4940 REMark --------------------------------------------- 4950 DEFine PROCedure peninit :REMark USER entry 4960 REMark initialise pen to up 4970 LOCal L 4980 CLS #cmnd_win 4990 PRINT #cmnd_win; 'Hit ENTER when pen at highest' 5000 PAUSE 25 5010 REPeat L 5020 PRINT #zchan,peninitmtrcmd$; 5030 IF KEYROW(1)=1:EXIT L 5040 PAUSE 10 5050 END REPeat L 5060 penpos$='up' 5070 CLS #cmnd_win 5080 END DEFine 5090 REMark --------------------------------------------- 5100 DEFine PROCedure pd :REMark USER entry 5110 REMark pendown 5120 LOCal n 5130 IF penpos$ =='down' THEN RETurn 5140 FOR n=1 TO 6:PRINT #zchan,mtrcmd$(4); 5150 penpos$='down' 5160 processing_link 'pd', 6, 0 5170 END DEFine 5180 REMark --------------------------------------------- 5190 DEFine PROCedure pu :REMark USER entry 5200 REMark penup 5210 LOCal n 5220 IF penpos$=='up' :RETurn 5230 FOR n=1 TO 6:PRINT #zchan,mtrcmd$(4); 5240 penpos$='up' 5250 processing_link 'pu', 5, 0 5260 END DEFine 5270 REMark --------------------------------------------- 5280 DEFine PROCedure rl(cmnd_value) :REMark USER entry 5290 REMark right_led (on_off_state ) : 0=off 1=on 5300 LOCal cmnd_name$, value_name$, mask 5310 cmnd_name$='rl' :value_name$='state ' 5320 cmnd_value = cmnd_value MOD 2 5330 IF cmnd_value THEN 5340 mask=2^0 5350 byte_hl = byte_hl || mask 5360 ELSE 5370 mask=255-2^0 5380 byte_hl = byte_hl && mask 5390 END IF 5400 PRINT #zchan, CHR$( byte_hl ); 5410 processing_link 'rl '&cmnd_value, 8, cmnd_value 5420 END DEFine 5430 REMark --------------------------------------------- 5440 DEFine PROCedure ll(cmnd_value) :REMark USER entry 5450 REMark left_led ( on_off_state ) : 0=off 1=on 5460 LOCal cmnd_name$, value_name$, mask 5470 cmnd_name$='ll' :value_name$='state ' 5480 cmnd_value = cmnd_value MOD 2 5490 IF cmnd_value THEN 5500 mask=2^1 5510 byte_hl = byte_hl || mask 5520 ELSE 5530 mask=255-2^1 5540 byte_hl = byte_hl && mask 5550 END IF 5560 PRINT #zchan, CHR$( byte_hl ); 5570 processing_link 'll '&cmnd_value, 7, cmnd_value 5580 END DEFine 5590 REMark --------------------------------------------- 5600 DEFine PROCedure ls(cmnd_value) :REMark USER entry 5610 REMark leds ( bit_state ) : 0=off 1=rl_on 2=ll_on 3=both_on 5620 LOCal cmnd_name$, value_name$, mask 5630 cmnd_name$='ls' :value_name$='state ' 5640 cmnd_value = cmnd_value MOD 4 5650 mask=255-2^1-2^0 5660 byte_hl = byte_hl && mask 5670 byte_hl=byte_hl+cmnd_value 5680 PRINT #zchan, CHR$( byte_hl ); 5690 processing_link 'ls '&cmnd_value, 9, cmnd_value 5700 END DEFine 5710 REMark --------------------------------------------- 5720 DEFine PROCedure hl(cmnd_value) :REMark USER entry 5730 REMark horn_low_tone ( on_off ) : 0=off 1=on 5740 LOCal cmnd_name$, value_name$, mask 5750 cmnd_name$='hl' :value_name$='state ' 5760 cmnd_value = cmnd_value MOD 2 5770 IF cmnd_value THEN 5780 mask=2^2 5790 byte_hl = byte_hl || mask 5800 ELSE 5810 mask=255-2^2 5820 byte_hl = byte_hl && mask 5830 END IF 5840 PRINT #zchan, CHR$( byte_hl ); 5850 processing_link 'hl '&cmnd_value, 11, cmnd_value 5860 END DEFine 5870 REMark --------------------------------------------- 5880 DEFine PROCedure hh(cmnd_value) :REMark USER entry 5890 REMark horn_high_tone ( on_off ) : 0=off 1=on 5900 LOCal cmnd_name$, value_name$, mask 5910 cmnd_name$='hh' :value_name$='state ' 5920 cmnd_value = cmnd_value MOD 2 5930 IF cmnd_value THEN 5940 mask=2^3 5950 byte_hl = byte_hl || mask 5960 ELSE 5970 mask=255-2^3 5980 byte_hl = byte_hl && mask 5990 END IF 6000 PRINT #zchan, CHR$( byte_hl ); 6010 processing_link 'hh '&cmnd_value, 10, cmnd_value 6020 END DEFine 6030 REMark --------------------------------------------- 6040 DEFine PROCedure ho :REMark USER entry 6050 REMark horn_off : turns off both tones 6060 LOCal mask 6070 mask=255-2^3-2^2 6080 byte_hl = byte_hl && mask 6090 PRINT #zchan, CHR$( byte_hl ); 6100 processing_link 'ho', 13, 0 6110 END DEFine 6120 REMark --------------------------------------------- 6130 DEFine PROCedure hn(cmnd_value) :REMark USER entry 6140 REMark horn ( bit_state ) : 0=off 1=hl_on 2=hh_on 3=both_on 6150 LOCal cmnd_name$, value_name$, mask 6160 cmnd_name$='hn' :value_name$='state ' 6170 cmnd_value=cmnd_value MOD 4 6180 mask=255-2^3-2^2 6190 byte_hl = byte_hl && mask 6200 byte_hl = byte_hl + 4*cmnd_value 6210 PRINT #zchan, CHR$( byte_hl ); 6220 processing_link 'hn '&cmnd_value, 12, cmnd_value 6230 END DEFine 6240 REMark --------------------------------------------- 6250 DEFine PROCedure wt(cmnd_value) :REMark USER entry 6260 REMark wait ( period ) : period/50 seconds 6270 LOCal cmnd_name$, value_name$, mask 6280 cmnd_name$='wt' :value_name$='period ' 6290 PAUSE (cmnd_value) 6300 processing_link 'wt '&cmnd_value, 14, cmnd_value 6310 END DEFine 6320 REMark --------------------------------------------- 6330 DEFine PROCedure hoot( cmnd_value ) :REMark USER entry 6340 REMark cycle horn 6350 LOCal cmnd_name$, value_name$, horn_mask, temp, i, j 6360 cmnd_name$='hoot' :value_name$='times' 6370 temp = byte_hl 6380 horn_mask = 255-2^3-2^2 6390 byte_hl = byte_hl && horn_mask 6400 FOR i=1 TO cmnd_value 6410 FOR j= 0 TO 3 6420 PRINT #zchan, CHR$(byte_hl + 4*j); 6430 PAUSE 3 6440 END FOR j 6450 END FOR i 6460 byte_hl = temp 6470 PRINT #zchan, CHR$( byte_hl ); 6480 processing_link 'hoot '&cmnd_value, 21, cmnd_value 6490 END DEFine 6500 REMark --------------------------------------------- 6510 DEFine PROCedure flsh( cmnd_value ) :REMark USER entry 6520 REMark cycle lights, FLASH is a reserved word 6530 LOCal cmnd_name$, value_name$, lights_mask, temp, i, j 6540 cmnd_name$='flsh' :value_name$='times' 6550 temp = byte_hl 6560 lights_mask = 255-2^1-2^0 6570 byte_hl = byte_hl && lights_mask 6580 FOR i=1 TO cmnd_value 6590 FOR j= 0 TO 3 STEP 3 6600 PRINT #zchan, CHR$(byte_hl + j); 6610 PAUSE 2 6620 END FOR j 6630 END FOR i 6640 byte_hl = temp 6650 PRINT #zchan, CHR$( byte_hl ); 6660 processing_link 'flsh '&cmnd_value, 22, cmnd_value 6670 END DEFine 6680 REMark --------------------------------------------- 6690 DEFine PROCedure flht( cmnd_value ) :REMark USER entry 6700 REMark fast cycle lights and horn 6710 LOCal cmnd_name$, value_name$, temp, i, j 6720 cmnd_name$='flht' :value_name$='times' 6730 temp = byte_hl 6740 FOR i = 1 TO cmnd_value 6750 FOR j = 1 TO 3 6760 PRINT #zchan,CHR$(32+j+4*j); 6770 PAUSE 2 6780 END FOR j 6790 END FOR i 6800 byte_hl = temp 6810 PRINT #zchan, CHR$( byte_hl ); 6820 processing_link 'flht '&cmnd_value, 23, cmnd_value 6830 END DEFine 6840 REMark ============================================= 6850 REMark *** SHORT-TERM-MEMORY PROCEDURES *** 6860 REMark --------------------------------------------- 6870 DEFine PROCedure learn :REMark USER entry 6880 learning=1 6890 PAPER #list_win,red 6900 PRINT #list_win,'learn ' 6910 PAN #list_win,11,3 6920 learning_screens son :REMark set_on 6930 END DEFine 6940 REMark --------------------------------------------- 6950 DEFine PROCedure nolearn :REMark USER entry 6960 learning=0 6970 PAPER #list_win,red 6980 PRINT #list_win,'nolearn ' 6990 PAN #list_win,4,3 7000 learning_screens off 7010 END DEFine 7020 REMark --------------------------------------------- 7030 DEFine PROCedure forget :REMark USER entry 7040 learned_moves$='' 7050 nolearn 7060 CLS #list_win 7070 CLS #step_win 7080 print_robot_position 7090 END DEFine 7100 REMark --------------------------------------------- 7110 DEFine PROCedure remember_move (cmnd$) 7120 LOCal this_step$(8), steps 7130 this_step$ = cmnd$ 7140 learned_moves$=learned_moves$ & this_step$(1 TO 8) & ':' 7150 steps= (LEN(learned_moves$))/9 7160 PRINT #step_win,'step ' & steps 7170 END DEFine 7180 REMark --------------------------------------------- 7190 DEFine PROCedure rlist :REMark USER entry 7200 REMark list short term memory to help window 7210 list_cmnds 'Short-term Memory', learned_moves$ 7220 END DEFine 7230 REMark --------------------------------------------- 7240 DEFine PROCedure ralter :REMark USER entry 7250 REMark alter short-term memory at a particular step 7260 LOCal L, r$, max_steps$, step_num 7270 max_steps$ = (LEN(learned_moves$))/9 7280 PAPER #edit_win,white 7290 INK #edit_win,black 7300 BORDER #edit_win,1,red 7310 CLS #edit_win 7320 PRINT #edit_win;'altering' 7330 REPeat L 7340 CLS #cmnd_win 7350 INPUT #cmnd_win;'enter step number to alter after'!r$ 7360 r$ = strip_spaces$( r$ ) 7370 IF r$>='0' AND r$<=max_steps$ THEN EXIT L 7380 END REPeat L 7390 IF r$=max_steps$ THEN rfix :RETurn 7400 step_num = r$ 7410 learned_moves_tail$ = learned_moves$(step_num*9+1 TO ) 7420 learned_moves$ = learned_moves$(1 TO step_num*9) 7430 CLS #cmnd_win 7440 END DEFine 7450 REMark --------------------------------------------- 7460 DEFine PROCedure rfix :REMark USER entry 7470 REMark restore state of short_term memory after ralter 7480 learned_moves$ = learned_moves$ & learned_moves_tail$ 7490 learned_moves_tail$ = '' 7500 PAPER #edit_win,green 7510 BORDER #edit_win,0 7520 CLS #edit_win 7530 CLS #cmnd_win 7540 END DEFine 7550 REMark ============================================= 7560 REMark * SHORT-TERM MEMORY TESTING * 7570 REMark --------------------------------------------- 7580 DEFine PROCedure replay :REMark USER entry 7590 REMark replay learned commands, normal direction 7600 do_steps 'normal' 7610 END DEFine 7620 REMark --------------------------------------------- 7630 DEFine PROCedure bplay :REMark USER entry 7640 REMark replay learned commands, inverse direction 7650 do_steps 'inverse' 7660 END DEFine 7670 REMark --------------------------------------------- 7680 DEFine PROCedure do_steps ( direction ) 7690 REMark replay learned commands 7700 LOCal start_step, all_steps, cmnd$, r1$, r2$, t$, L 7710 LOCal first_step, last_step, step_dir, step_num 7720 all_steps= (LEN(learned_moves$))/9 7730 IF all_steps=0 THEN RETurn 7740 REPeat L 7750 CLS #cmnd_win 7760 INPUT #cmnd_win,'Enter start step and finish step '! r1$,r2$ 7770 r1$ = strip_spaces$( r1$ ) 7780 r2$ = strip_spaces$( r2$ ) 7790 IF r1$='' THEN r1$=1 7800 IF r2$='' THEN r2$=all_steps 7810 cond_r1= r1$>'0' AND r1$<= all_steps 7820 cond_r2= r2$>'0' AND r2$<= all_steps 7830 IF cond_r1 AND cond_r2 THEN CLS #cmnd_win :EXIT L 7840 END REPeat L 7850 CLS #step_win 7860 PAPER #list_win,red 7870 IF direction ='normal' THEN 7880 PRINT #list_win,' replay ' 7890 ELSE 7900 PRINT #list_win,'bplay' TO 8 7910 PAN #list_win,11,3 7920 END IF 7930 : 7940 IF direction ='inverse' THEN t$=r1$ :r1$=r2$ :r2$=t$ 7950 first_step =r1$ :last_step =r2$ 7960 PRINT #list_win,r1$ TO 4; r2$ TO 8 7970 learning_screens learning :REMark put paper back to before 7980 : 7990 IF r1$<=r2$ THEN step_dir=1 :ELSE step_dir=-1 8000 : 8010 FOR step_num = first_step TO last_step STEP step_dir 8020 cmnd$=learned_moves$(step_num*9-8 TO step_num*9) 8030 PRINT #step_win,'step ' & step_num 8040 : 8050 IF direction='normal' THEN 8060 exec_cmnd cmnd$ 8070 ELSE 8080 exec_reverse_cmnd cmnd$ 8090 END IF 8100 NEXT step_num 8110 CLS #cmnd_win 8120 END DEFine 8130 REMark --------------------------------------------- 8140 DEFine PROCedure rstep :REMark USER entry 8150 REMark single stepping of learned commands 8160 LOCal all_steps,all_stp$, step_num, cmnd$, r1$, r2$, L, stepping_loop 8170 all_steps= (LEN(learned_moves$))/9 8180 IF all_steps=0 THEN RETurn 8190 all_stp$ = all_steps 8200 REPeat L 8210 CLS #cmnd_win 8220 INPUT #cmnd_win,'Enter start step'!r1$,' and direction FD/BK '! r2$ 8230 r1$ = strip_spaces$( r1$ ) 8240 r2$ = strip_spaces$( r2$ ) 8250 IF r1$= '' THEN r1$='1' 8260 IF r2$= '' THEN r2$='FD' 8270 IF r2$<>'FD' THEN r2$='BK' 8280 IF r1$>'0' AND r1$<= all_stp$ THEN EXIT L 8290 END REPeat L 8300 CLS #cmnd_win 8310 step_num=r1$ 8320 PAPER #list_win,red 8330 PRINT #list_win,'sreplay ' 8340 PAN #list_win,4,3 :REMark shift msg to middle of line 8350 PRINT #list_win,r1$ TO 4; r2$ TO 8 8360 learning_screens learning :REMark put paper back to before 8370 REPeat stepping_loop 8380 PRINT #cmnd_win,'ENTER to step, SPACE-BAR to quit' 8390 PRINT #step_win,'step ' & step_num 8400 BEEP 3000,123,123,1,2 8410 REPeat L 8420 IF KEYROW(1)=1 THEN EXIT L :REMark ENTER 8430 IF KEYROW(1)=64 THEN 8440 CLS #step_win :EXIT stepping_loop 8450 END IF 8460 END REPeat L 8470 CLS #cmnd_win 8480 cmnd$=learned_moves$(step_num*9-8 TO step_num*9) 8490 exec_cmnd cmnd$ 8500 IF r2$=='FD' THEN 8510 step_num=step_num+1 8520 ELSE 8530 step_num=step_num-1 8540 END IF 8550 IF step_num<=0 OR step_num>all_steps THEN EXIT stepping_loop 8560 END REPeat stepping_loop 8570 CLS #cmnd_win 8580 END DEFine 8590 REMark --------------------------------------------- 8600 DEFine PROCedure unlearn :REMark USER entry 8610 REMark unlearn a command and if a move undo it 8620 LOCal step_num, cmnd$, temp_learning 8630 step_num= (LEN(learned_moves$))/9 8640 IF step_num<1 THEN RETurn 8650 step_num=step_num-1 8660 cmnd$=learned_moves$(step_num*9+1 TO ) 8670 learned_moves$=learned_moves$(1 TO step_num*9) 8680 PRINT #step_win;'step ' & step_num 8690 temp_learning=learning :learning = off 8700 learning_screens -1 :REMark inverse printing in list_win 8710 exec_reverse_cmnd cmnd$ 8720 learning = temp_learning 8730 learning_screens learning :REMark back to normal 8740 END DEFine 8750 REMark ============================================= 8760 REMark *** GENERAL MEMORY PROCEDURES *** 8770 REMark --------------------------------------------- 8780 DEFine PROCedure mlist :REMark USER entry 8790 REMark list a user robot routine to help window 8800 LOCal name$(9), cmnd_list 8810 name$ = '' 8820 CLS #cmnd_win 8830 INPUT #cmnd_win;'Enter Routine name'\name$ 8840 name$ = strip_spaces$( name$ ) 8850 name$(9) = ':' 8860 cmnd_list$ = get_cmnd_list$( name$ ) 8870 list_cmnds 'Memory routine ' & name$, cmnd_list$ 8880 END DEFine 8890 REMark --------------------------------------------- 8900 DEFine PROCedure list_cmnds (title_msg$, cmnd_list$) 8910 REMark list a robot command string to help window 8920 LOCal num_cmnds, cmnd, r$, line_count, msg$ 8930 num_cmnds = LEN(cmnd_list$)/9 8940 r$ = '' 8950 msg$ = ' SPACE-BAR to quit, ENTER for more...' 8960 CSIZE #help_win, 0,0 8970 CLS #help_win 8980 CLS #cmnd_win 8990 AT #help_win,0,20 9000 UNDER #help_win,1 9010 PRINT #help_win;title_msg$ 9020 UNDER #help_win,0 9030 line_count = 2 9040 FOR cmnd = 1 TO num_cmnds 9050 AT #help_win,line_count,2+((cmnd-1) MOD 5)*12 9060 PRINT #help_win;cmnd;')';cmnd_list$(cmnd *9-8 TO cmnd*9-1) 9070 IF 0 = cmnd MOD 5 THEN line_count = line_count +1 9080 IF line_count >=17 THEN 9090 r$ = fn_wait_key$(msg$) 9100 IF r$ = 'quit' THEN EXIT cmnd 9110 line_count = 2 9120 AT #help_win,1,0 9130 CLS #help_win,2 9140 END IF 9150 END FOR cmnd 9160 IF r$ <> 'quit' THEN 9170 CLS #cmnd_win 9180 msg$ = ' SPACE-BAR to quit' 9190 r$ = fn_wait_key$(msg$) 9200 END IF 9210 CLS #cmnd_win 9220 cmap 9230 END DEFine 9240 REMark --------------------------------------------- 9250 DEFine PROCedure exec_cmnd (cmnd_string$) 9260 REMark execute a command contained in first 8 chars 9270 REMark of a 9 char string 9280 LOCal cmnd$(9),name_len,cmnd_num,cmnd_val$, cmnd_val 9290 cmnd$=cmnd_string$ 9300 cmnd$(9)=' ' 9310 name_len=(' ' INSTR cmnd$(1 TO 9))-1 9320 : 9330 IF name_len=0 OR name_len=1 THEN RETurn 9340 : 9350 cmnd_num = get_cmnd_num ( cmnd$, name_len ) 9360 cmnd_val = get_cmnd_val ( cmnd$,cmnd_num, name_len ) 9370 : 9380 SELect ON cmnd_num 9390 =1 :FD cmnd_val 9400 =2 :BK cmnd_val 9410 =3 :LT cmnd_val 9420 =4 :RT cmnd_val 9430 =5 :pu 9440 =6 :pd 9450 =7 :ll cmnd_val 9460 =8 :rl cmnd_val 9470 =9 :ls cmnd_val 9480 =10 :hh cmnd_val 9490 =11 :hl cmnd_val 9500 =12 :hn cmnd_val 9510 =13 :ho 9520 =14 :wt cmnd_val 9530 =15 :sb cmnd_val 9540 =16 :home 9550 =17 :ihome 9560 =18 :alert 9570 =19 :buzz 9580 =20 :unwind 9590 =21 :hoot cmnd_val 9600 =22 :flsh cmnd_val 9610 =23 :flht cmnd_val 9620 ON cmnd_num = 1000 TO 10000 :REMark ie all from 1000 9630 exec_routine cmnd_num-1000 9640 END SELect 9650 END DEFine 9660 REMark --------------------------------------------- 9670 DEFine FuNction get_cmnd_num ( cmnd$, name_len ) 9680 REMark convert command name to command number 9690 cmnd_num = 0 9700 : 9710 cmnd_num=cmnd$(1 TO name_len) INSTR robot_name_table$ 9720 IF cmnd_num THEN cmnd_num=(cmnd_num+8)/9 9730 : 9740 IF cmnd_num THEN RETurn cmnd_num 9750 : 9760 cmnd_num=cmnd$(1 TO name_len) INSTR routine_names$ 9770 IF cmnd_num THEN cmnd_num=1000+(cmnd_num+8)/9 9780 : 9790 RETurn cmnd_num 9800 END DEFine 9810 REMark --------------------------------------------- 9820 DEFine FuNction get_cmnd_val (cmnd$,cmnd_num,name_len) 9830 REMark extract command value from command string 9840 LOCal cmnd_val$ 9850 cmnd_val$=cmnd$((name_len+2) TO 9) 9860 SELect ON cmnd_num 9870 ON cmnd_num= 1 TO 999 9880 IF cmnd_val$=FILL$(' ',(9-(name_len+1))) THEN cmnd_val$=0 9885 cmnd_val = cmnd_val$ 9890 REMark 2.6 IF cmnd_val<0 OR cmnd_val>9999 THEN cmnd_val$=0 9891 IF cmnd_val<0 THEN cmnd_val$=0 9900 ON cmnd_num = REMAINDER 9910 cmnd_val$ = 0 9920 END SELect 9930 cmnd_val = cmnd_val$ 9940 RETurn cmnd_val 9950 END DEFine 9960 REMark --------------------------------------------- 9970 DEFine PROCedure exec_reverse_cmnd (cmnd_string$) 9980 REMark execute the opposite of a command 9990 LOCal cmnd$(9),name_len,cmnd_num,cmnd_val 10000 cmnd$=cmnd_string$ 10010 name_len=(' ' INSTR cmnd$(1 TO 9))-1 10020 : 10030 IF name_len=0 OR name_len=1 THEN RETurn 10040 : 10050 cmnd_num = get_cmnd_num (cmnd$,name_len) 10060 cmnd_val = get_cmnd_val (cmnd$,cmnd_num,name_len) 10070 : 10080 : 10090 SELect ON cmnd_num 10100 =1 :BK cmnd_val 10110 =2 :FD cmnd_val 10120 =3 :RT cmnd_val 10130 =4 :LT cmnd_val 10140 =5 :pd 10150 =6 :pu 10160 =7 :ll NOT cmnd_val 10170 =8 :rl NOT cmnd_val 10180 =9 :PRINT #cmnd_win,' NOT ls - too hard' 10190 =10 :hh NOT cmnd_val 10200 =11 :hl NOT cmnd_val 10210 =12 :PRINT #cmnd_win,' NOT hn - too hard' 10220 =13 :PRINT #cmnd_win,' NOT ho - too hard' 10230 =16 :PRINT #cmnd_win,' NOT home - too hard' 10240 =17 :PRINT #cmnd_win,' NOT ihome - too hard' 10250 =18 :alert 10260 =19 :buzz 10270 =20 :PRINT #cmnd_win,' NOT unwind - too hard' 10280 =21 :hoot cmnd_val 10290 =22 :flsh cmnd_val 10300 =23 :flht cmnd_val 10310 END SELect 10320 END DEFine 10330 REMark ============================================= 10340 REMark *** LONG-TERM-MEMORY PROCEDURES *** 10350 REMark --------------------------------------------- 10360 DEFine PROCedure mnames :REMark USER entry 10370 REMark list routine names to help window 10380 list_cmnds 'Routine names', routine_names$ 10390 END DEFine 10400 REMark --------------------------------------------- 10410 DEFine PROCedure mexec :REMark USER entry 10420 REMark execute a routine in long term_memory 10430 LOCal cmnd_num, name_len, cmnd$(9), temp_learning, r$ 10440 CLS #cmnd_win 10450 INPUT #cmnd_win;'Enter command to be executed'!r$ 10460 r$ = strip_spaces$( r$ ) 10470 IF r$='' THEN CLS #cmnd_win :RETurn 10480 cmnd$ = r$ &' ' 10490 name_len = (' ' INSTR cmnd$) -1 10500 IF name_len = 0 THEN CLS #cmnd_win :RETurn 10510 cmnd_num = get_cmnd_num (cmnd$,name_len) 10520 cmnd_val = get_cmnd_val (cmnd$,cmnd_num,name_len) 10530 IF cmnd_num THEN 10540 processing_link cmnd$, cmnd_num, 0 10550 temp_learning = learning 10560 nolearn 10570 exec_cmnd cmnd$ 10580 learning = temp_learning 10590 IF learning THEN learn 10600 CLS #cmnd_win 10610 ELSE 10620 PRINT #cmnd_win,'no such routine as' ! cmnd$ 10625 END IF 10630 END DEFine 10640 REMark --------------------------------------------- 10650 DEFine PROCedure exec_routine (cmnd_num) 10660 REMark execute commands contained in a user routine 10670 LOCal start, length, cmnd$, step_num 10680 : 10690 IF cmnd_num=0 THEN RETurn 10700 : 10710 start = get_routine_start( cmnd_num ) 10720 length = get_routine_length( cmnd_num ) 10730 FOR step_num = start TO start + length -1 10740 cmnd$ = long_term_memory$( (step_num*9)-8 TO step_num*9 ) 10750 exec_cmnd cmnd$ 10760 END FOR step_num 10770 END DEFine 10780 REMark --------------------------------------------- 10790 DEFine FuNction get_routine_start ( cmnd_num ) 10800 REMark get start position of a routine in long term memory 10810 REMark ie step number, not byte position 10820 LOCal i, start 10830 IF cmnd_num =1 THEN RETurn 1 10840 start = 1 10850 FOR i=1 TO cmnd_num-1 10860 start = start + get_routine_length( i ) 10870 END FOR i 10880 RETurn start 10890 END DEFine 10900 REMark --------------------------------------------- 10910 DEFine FuNction get_routine_length (cmnd_num ) 10920 REMark get length in steps of a routine in long term memory 10930 LOCal length 10940 length = routine_lengths$( (cmnd_num*9)-8 TO cmnd_num*9 ) 10950 RETurn length 10960 END DEFine 10970 REMark --------------------------------------------- 10980 DEFine PROCedure mget :REMark USER entry 10990 LOCal r$ 11000 REMark put the commands of a long-term memory routine 11010 REMark into short-term memory 11020 CLS #cmnd_win 11030 INPUT #cmnd_win,'Enter the routine to be fetched' !! r$ 11040 r$ = strip_spaces$ ( r$ ) 11050 IF r$ INSTR routine_names$ THEN 11060 learned_moves$ = learned_moves$ & get_cmnd_list$ ( r$ ) 11070 CLS #cmnd_win 11080 ELSE 11090 PRINT #cmnd_win;'No such routine in memory' 11100 END IF 11110 END DEFine 11120 REMark --------------------------------------------- 11130 DEFine FuNction get_cmnd_list$ (name$) 11140 REMark get the list of commands for routine 'name$' 11150 LOCal start, length, start_byte, end_byte, cmnd$(9), cmnd_num 11160 cmnd$ = name$ 11170 cmnd$(9) = ' ' 11180 name_len = (' ' INSTR cmnd$(1 TO 9))-1 11190 cmnd_num = get_cmnd_num( cmnd$, name_len ) 11200 cmnd_num = cmnd_num -1000 11210 IF cmnd_num<1 THEN RETurn '' 11220 start = get_routine_start (cmnd_num) 11230 length = get_routine_length (cmnd_num) 11240 start_byte = (start*9)-8 11250 end_byte = (start+length-1)*9 11260 RETurn long_term_memory$(start_byte TO end_byte) 11270 END DEFine 11280 REMark --------------------------------------------- 11290 DEFine PROCedure rsave :REMark USER entry 11300 LOCal num_user_routines, cmnd, num_cmnds, num_cmnds$(9), name$(9), L 11310 REMark save_routine :- add the learned moves to long_term_memory$ 11320 REMark and add to long_term memory file 'zmem" on microdrive 1 11330 REMark add name and length of routine to name table arrays 11340 REMark and add to file 'zmem_names' on microdrive 1 11350 : 11360 num_cmnds = LEN(learned_moves$)/9 11370 IF num_cmnds = 0 THEN 11380 PRINT #cmnd_win;'Nothing to save!' 11390 RETurn 11400 END IF 11410 num_user_routines=(LEN(routine_names$))/9 11420 REPeat L 11430 CLS #cmnd_win 11440 PRINT #cmnd_win;'Enter name for learned sequence '; 11450 PRINT #cmnd_win;'Routine number '&(num_user_routines +1) 11460 INPUT #cmnd_win;'8 characters maximum ' ; name$ 11470 name$ = strip_spaces$( name$ ) 11480 IF name$<>'' THEN EXIT L 11490 END REPeat L 11500 FOR cmnd = 1 TO num_cmnds 11510 PRINT #memchan;learned_moves$(cmnd*9-8 TO cmnd*9) 11520 END FOR cmnd 11530 long_term_memory$ = long_term_memory$ & learned_moves$ 11540 learned_moves$='' 11550 name$(9)=':' 11560 num_cmnds$ = num_cmnds 11570 num_cmnds$(9)=':' 11580 routine_names$ = routine_names$ & name$(1 TO 9) 11590 routine_lengths$ = routine_lengths$ & num_cmnds$(1 TO 9) 11600 PRINT #namchan,name$(1 TO 9) 11610 PRINT #namchan,num_cmnds$(1 TO 9) 11620 CLS #cmnd_win 11630 PRINT #cmnd_win,'OK, saved' ! name$(1 TO 8) 11640 END DEFine 11650 REMark --------------------------------------------- 11660 DEFine PROCedure get_routines 11670 REMark read saved routines from microdrive 1 at start of session 11680 LOCal L, cmnd$(9), name$(9) 11690 OPEN #memchan,Zmem$ 11700 REPeat L 11710 IF EOF(#memchan) THEN EXIT L 11720 INPUT #memchan,cmnd$ 11730 long_term_memory$ = long_term_memory$ & cmnd$ 11740 END REPeat L 11750 OPEN #namchan,Zmem_names$ 11760 REPeat L 11770 IF EOF(#namchan) THEN EXIT L 11780 INPUT #namchan,name$ 11790 routine_names$ = routine_names$ & name$ 11800 INPUT #namchan,num_cmnds$ 11810 routine_lengths$ = routine_lengths$ & num_cmnds$ 11820 END REPeat L 11830 END DEFine 11840 REMark ============================================= 11850 REMark *** DISPLAY PROCESING PROCEDURES *** 11860 REMark --------------------------------------------- 11870 DEFine PROCedure init_windows 11880 REMark initialises windows 11890 LOCal ht, X ,y 11900 : 11910 MODE 4 11920 : 11930 OPEN #full_win,con_ 11940 WINDOW #full_win,512,256,0,0 11950 PAPER #full_win,green 11960 INK #full_win,black 11970 CSIZE #full_win,0,0 11980 CLS #full_win 11990 CURSOR #full_win,39,8 12000 PRINT #full_win, 'ver' 12010 CURSOR #full_win,39,18 12020 PRINT #full_win, prog_version$ 12030 : 12040 WINDOW #0,440,38,37,218 12050 BORDER #0,4,green 12060 CSIZE #0,1,0 12070 PAPER #0,green 12080 INK #0,black 12090 CLS #0 12100 : 12110 WINDOW #1,370,170,110,46 :REMark same as help_win 12120 CSIZE #1,1,0 12130 PAPER #1,white 12140 INK #1,black 12150 : 12160 WINDOW #2,370,170,110,46 :REMark same as help_win 12170 CSIZE #2,0,0 12180 PAPER #2,white 12190 INK #2,black 12200 : 12210 OPEN #title_win,con_ 12220 WINDOW #title_win,388,24,60,4 12230 BORDER #title_win,1,white 12240 CSIZE #title_win,3,1 12250 INK #title_win,red 12260 PAPER #title_win,black 12270 CLS #title_win 12280 PRINT #title_win,' ZERO 2 Control Program' 12290 : 12300 OPEN #mode_win,con_ 12310 WINDOW #mode_win,68,18,35,32 12320 CSIZE #mode_win,1,0 12330 CLS #mode_win 12340 : 12350 OPEN #step_win,con_ 12360 WINDOW #step_win,66,14,110,30 12370 BORDER #step_win,1,white 12380 CSIZE #step_win,1,0 12390 CLS #step_win 12400 : 12410 OPEN #inf_win,con_ 12420 WINDOW #inf_win,230,14,179,30 12430 BORDER #inf_win,1,white 12440 CSIZE #inf_win,1,0 12450 CLS #inf_win 12460 PRINT #inf_win;" enter 'help' for commands" 12470 : 12480 OPEN #edit_win,con_ 12490 WINDOW #edit_win,68,14,412,30 12500 BORDER #edit_win,1,white 12510 CSIZE #edit_win,1,0 12520 PAPER #edit_win,black 12530 CLS #edit_win 12540 : 12550 OPEN #list_win,con_ 12560 WINDOW #list_win,68,162,35,52 12570 INK #list_win,black 12580 CSIZE #list_win,1,0 12590 CLS #list_win 12600 : 12610 OPEN #drg_win,con_ 12620 WINDOW #drg_win,370,170,110,46 :REMark same as help_win 12630 BORDER #drg_win,2,red 12640 PAPER #drg_win,white 12650 INK #drg_win,green 12660 CSIZE #drg_win,0,0 12670 ht = drg_screen_height 12680 X = drg_screen_x_origin 12690 y = drg_screen_y_origin 12700 SCALE #drg_win,ht,-X,-y 12710 CLS #drg_win 12720 : 12730 OPEN #help_win,con_ 12740 WINDOW #help_win,370,170,110,46 12750 PAPER #help_win,white 12760 INK #help_win,black 12770 CSIZE #help_win,1,0 12780 CLS #help_win 12790 : 12800 END DEFine init_windows 12810 REMark --------------------------------------------- 12820 DEFine PROCedure display_moves(cmnd$) 12830 REMark list a move 12840 LOCal p$(8) 12850 p$=cmnd$ 12860 PRINT #list_win,p$(1 TO 8) 12870 END DEFine 12880 REMark --------------------------------------------- 12890 DEFine PROCedure learning_screens (state) 12900 REMark redefine some parameters for mode_win and list_win 12910 IF state > 0 THEN state = son 12920 SELect ON state 12930 ON state=son 12940 learning_msg :REMark do mode_win 12950 BORDER #list_win, 1, red 12960 PAPER #list_win, white 12970 INK #list_win, black 12980 ON state=off 12990 no_learning_msg :REMark do mode_win 13000 BORDER #list_win, 1, black 13010 PAPER #list_win, green 13020 INK #list_win, black 13030 ON state=-1 :REMark unlearn mode 13040 IF learning THEN 13050 PAPER #list_win, black : 13060 INK #list_win, white : 13070 ELSE :REMark ie invert 13080 PAPER #list_win, black : 13090 INK #list_win, green : 13100 END IF 13110 END SELect 13120 END DEFine 13130 REMark --------------------------------------------- 13140 DEFine PROCedure learning_msg 13150 BORDER #mode_win, 1,black 13160 PAPER #mode_win, white 13170 INK #mode_win, black 13180 CLS #mode_win 13190 CURSOR #mode_win, 0,3 13200 PRINT #mode_win; 'learning' 13210 END DEFine 13220 REMark --------------------------------------------- 13230 DEFine PROCedure no_learning_msg 13240 BORDER #mode_win,0 13250 PAPER #mode_win,green 13260 CLS #mode_win 13270 END DEFine 13280 REMark --------------------------------------------- 13290 DEFine PROCedure help_scrn 13300 REMark set up help screen 13310 BORDER #help_win,0,0 13320 PAPER #help_win,white :INK #help_win,black 13330 CLS #help_win 13340 END DEFine 13350 REMark --------------------------------------------- 13360 DEFine PROCedure help_scrn_1 13370 CLS #help_win 13380 CSIZE #help_win,1,0 13390 UNDER #help_win,1 13400 CURSOR#help_win, 14*8,5 13410 PRINT #help_win;'System Commands' 13420 UNDER #help_win,0 13430 AT #help_win, 2,0 13440 PRINT #help_win,'help oops zinit peninit imap cmap' 13450 PRINT #help_win,'forget learn nolearn unlearn replay rstep' 13460 PRINT #help_win,'bplay' 13470 PRINT #help_win,'rlist ralter rfix rsave' 13480 PRINT #help_win,'mlist mnames mexec mget quit' 13490 CURSOR#help_win, 14*8,8*10+5 13500 UNDER #help_win,1 13510 PRINT #help_win,'Robot Commands' 13520 UNDER #help_win,0 13530 AT #help_win,10,0 13540 PRINT #help_win,'MIND - ihome home unwind alert buzz' 13550 PRINT #help_win,' - jc wt n sb n' 13560 PRINT #help_win,'ROBOT - FD n BK n RT n LT n' 13570 PRINT #help_win,'PEN - pu pd (peninit)' 13580 PRINT #help_win,'LIGHTS - ll n rl n ls n flsh n flht n' 13590 PRINT #help_win,'HORN - hh n hl n hn n ho hoot n' 13595 PRINT #help_win,' [Ctrl]+[Space] to break' 13600 END DEFine 13610 REMark --------------------------------------------- 13620 DEFine PROCedure help_scrn_2 13630 CLS #help_win 13640 CSIZE #help_win, 0,0 13650 UNDER #help_win, 1 13660 AT #help_win, 1,15 13670 PRINT #help_win,'System Commands' 13680 UNDER #help_win, 0 13690 AT #help_win, 3,0 13700 PRINT #help_win,' help - display help screens' 13710 PRINT #help_win,' oops - recover from an error, if possible' 13720 PRINT #help_win,' zinit - initialise robot and serial channel' 13730 PRINT #help_win," peninit - adjust pen position to 'up'" 13740 PRINT #help_win,' imap - initialise map of displayed moves' 13750 PRINT #help_win,' cmap - clean map, rubout displayed moves' 13760 PRINT #help_win,' forget - commamds in short term memory are erased' 13770 PRINT #help_win,' learn - commands executed are learned' 13780 PRINT #help_win,' nolearn - commands executed are not learned' 13790 PRINT #help_win,' unlearn - command is executed in reverse and forgoten' 13800 PRINT #help_win,' replay - learned commands are executed in order' 13810 PRINT #help_win,' rstep - learned commands done one at a time' 13820 PRINT #help_win,' bplay - learned commands are executed in reverse order' 13830 END DEFine 13840 REMark --------------------------------------------- 13850 DEFine PROCedure help_scrn_2a 13860 CLS #help_win 13870 AT #help_win, 1,0 13880 PRINT #help_win,' rlist - list commamds in short term memory' 13890 PRINT #help_win,' ralter - alter routine in short term memory' 13900 PRINT #help_win,' rfix - end altering of short term memory' 13910 PRINT #help_win,' rsave - save a learned routine to long term memory' 13920 PRINT #help_win,' mlist - list a learned routine' 13930 PRINT #help_win,' mnames - list names of routines in long term memory' 13940 PRINT #help_win,' mexec - execute a routine from long term memory' 13950 PRINT #help_win,' mget - get commands from a routine in long-term memory' 13960 PRINT #help_win,' quit - quit program, updating and closing' 13970 PRINT #help_win,' memory files on mdv1_' 13980 END DEFine 13990 REMark --------------------------------------------- 14000 DEFine PROCedure help_scrn_3 14010 CLS #help_win 14020 CSIZE #help_win, 0,0 14030 UNDER #help_win, 1 14040 AT #help_win, 1,15 14050 PRINT #help_win,'Robot Commands'; 14060 UNDER #help_win, 0 14070 PRINT #help_win,' - Mind' 14080 AT #help_win, 3,0 14090 PRINT #help_win,' ihome - set present position to be the home position' 14100 PRINT #help_win," home - go to home position but don't unwind" 14110 PRINT #help_win,' unwind - unwind umbilical until heading is 0 deg.' 14120 PRINT #help_win,' alert - order computer to sound "alert"' 14130 PRINT #help_win,' buzz - order computer to sound "buzz"' 14140 PRINT #help_win,' jc - change to joystick control' 14150 PRINT #help_win," wt n - wait for 'n' 50'ths of a second" 14160 PRINT #help_win," sb n - send byte 'n' to robot, (direct control)" 14170 END DEFine 14180 REMark --------------------------------------------- 14190 DEFine PROCedure help_scrn_3a 14200 CLS #help_win 14210 CSIZE #help_win, 0,0 14220 UNDER #help_win, 1 14230 CURSOR#help_win, 14*8,5 14240 PRINT #help_win,'Robot Commands'; 14250 UNDER #help_win, 0 14260 PRINT #help_win,' - Body' 14270 AT #help_win, 2,0 14280 PRINT #help_win," FD n - forward 'n' BK n - back 'n' :millimetres" 14290 PRINT #help_win," LT n - left turn 'n' RT n - right turn 'n' :degrees" 14300 PRINT #help_win,' pu - pen up pd - pen down' 14310 CURSOR#help_win, 0,55 14320 PRINT #help_win," ll n - left light hh n - horn high tone :( logical" 14330 PRINT #help_win," rl n - right light hl n - horn low tone :( 0=>off" 14340 CURSOR#help_win, 0,80 14350 PRINT #help_win," ls n - lights state hn n - horn state :bit control" 14360 PRINT #help_win," 2^1, left light /high tone ; 2^0, right light /low tone" 14370 PRINT #help_win," logical 1=>on 0=>off" 14380 CURSOR#help_win, 0,115 14390 PRINT #help_win," flsh n - flash lights 'n' times" 14400 PRINT #help_win," hoot n - cycle horn 'n' times" 14410 PRINT #help_win," flht n - flash lights, and cycle horn 'n' times" 14420 END DEFine 14430 REMark --------------------------------------------- 14440 DEFine PROCedure imap :REMark USER entry 14450 REMark sets the scale of the drg window 14460 LOCal r$, ht$, X$, X, y$, p$, L 14470 CLS #cmnd_win 14480 REPeat L 14490 CLS #cmnd_win 14500 INPUT #cmnd_win,'input new scale factors for screen drawing'\'height (100 to 2000)'! ht$ 14510 ht$ = strip_spaces$( ht$ ) 14520 IF ht$='' THEN ht$='2000' 14530 INPUT #cmnd_win,'new origin y (0 to '&ht$&')'! y$ 14540 y$ = strip_spaces$( y$ ) 14550 IF y$ ='' THEN y$ =ht$/2 14560 X=1.5*ht$ 14570 INPUT #cmnd_win,'new origin x (0 to '&X&')'! X$ 14580 X$ = strip_spaces$( X$ ) 14590 IF X$ ='' THEN X$ =X/2 14600 cond_ht= ht$ >'99' AND ht$<='2000' 14610 cond_x = X$ >='0' AND X$<='3000' 14620 cond_y = y$ >='0' AND y$<='2000' 14630 IF cond_ht AND cond_x AND cond_y THEN EXIT L 14640 END REPeat L 14650 drg_screen_height = ht$ 14660 drg_screen_x_origin = X$ 14670 drg_screen_y_origin = y$ 14680 cmap 14690 CLS #cmnd_win 14700 END DEFine 14710 REMark --------------------------------------------- 14720 DEFine PROCedure cmap :REMark USER entry 14730 REMark clean map, ie clean drawing screen 14740 LOCal ll, llneg, ht ,X, y 14750 drg_scrn 14760 print_robot_position 14770 ht = drg_screen_height 14780 X = drg_screen_x_origin 14790 y = drg_screen_y_origin 14800 SCALE #drg_win,ht, -X, -y 14810 ll = drg_screen_height/50 14820 llneg = -(ll - drg_screen_height/100) 14830 LINE #drg_win, 0,llneg TO 0,ll 14840 LINE #drg_win, llneg,0 TO ll,0 14850 X = robot_x_pos + x_offset 14860 y = robot_y_pos + y_offset 14870 LINE #drg_win, X,y 14880 TURNTO #drg_win, robot_heading + heading_offset 14890 draw_robot 14900 END DEFine 14910 REMark --------------------------------------------- 14920 DEFine PROCedure drg_scrn 14930 REMark set up drg screen 14940 BORDER #drg_win,2,red 14950 CLS #drg_win 14960 END DEFine 14970 REMark --------------------------------------------- 14980 DEFine PROCedure draw_move (cmnd_code, cmnd_value) 14990 REMark draws robot moves on the drg screen 15000 PENDOWN #drg_win 15010 SELect ON cmnd_code 15020 =1 :MOVE #drg_win, cmnd_value 15030 =2 :MOVE #drg_win,-cmnd_value 15040 =3 :TURN #drg_win, cmnd_value 15050 =4 :TURN #drg_win,-cmnd_value 15060 =5 :INK #drg_win,green 15070 =6 :INK #drg_win,black 15080 END SELect 15090 END DEFine 15100 REMark --------------------------------------------- 15110 DEFine PROCedure print_robot_position 15120 REMark prints robot location in drg_win 15130 LOCal x%, y%, a%, pp$(4), ht% 15140 a%=robot_heading :x%=robot_x_pos :y%=robot_y_pos 15150 ht%=drg_screen_height 15160 CSIZE #drg_win,0,0 15170 AT #drg_win,0,0 15180 PRINT #drg_win;'Robot heading = '& a% &' deg. ' 15190 PRINT #drg_win;'at X ='& x% &' ' 15200 PRINT #drg_win;'at Y ='& y% &" " 15210 AT #drg_win,0,27 15220 pp$ = penpos$ 15230 PRINT #drg_win;'pen ';pp$(1 TO 4) 15240 AT #drg_win;0,40 15250 PRINT #drg_win;'map height = '; ht% 15260 END DEFine 15270 REMark --------------------------------------------- 15280 DEFine PROCedure draw_robot 15290 LOCal angle, X, y 15300 INK #drg_win, red 15310 PENUP #drg_win 15320 MOVE #drg_win, -10 15330 PENDOWN #drg_win 15340 angle = (heading_offset + robot_heading - 90 )*PI/180 15350 X = 20 * COS(angle) 15360 y = 20 * SIN(angle) 15370 ARC_R #drg_win, X,y TO -2*X,-2*y,PI 15380 MOVE #drg_win, -13 15390 X = 54 * COS(angle) 15400 y = 54 * SIN(angle) 15410 ARC_R #drg_win, 0,0 TO -X,-y,-PI 15420 MOVE #drg_win, 78 15430 X = 150 * COS(angle) 15440 y = 150 * SIN(angle) 15450 ARC_R #drg_win, 0,0 TO X,y,-PI 15460 MOVE #drg_win, -78 15470 X = 54 * COS(angle) 15480 y = 54 * SIN(angle) 15490 ARC_R #drg_win, 0,0 TO -X,-y,-PI 15500 MOVE #drg_win, 13 15510 IF penpos$ == 'up' THEN 15520 INK #drg_win, green 15530 ELSE 15540 INK #drg_win, black 15550 END IF 15560 X = robot_x_pos + x_offset 15570 y = robot_y_pos + y_offset 15580 POINT #drg_win, X,y 15590 END DEFine 15600 REMark --------------------------------------------- 15605 DEFine PROCedure ErrorMsg(errortxt$,errorval) :REMark [2.6] 15610 PRINT #cmnd_win; errortxt$;errorval 15620 END DEFine 15630 REMark =============================================