19-May-87 06:36:47-EDT,15905;000000000001 Return-Path: Received: from Cs.Ucl.AC.UK (TUNNEL.CS.UCL.AC.UK) by CU20B.COLUMBIA.EDU with TCP; Tue 19 May 87 06:34:34-EDT Received: from vax1.central.lancaster.ac.uk by mv1.Cs.Ucl.AC.UK via Janet with NIFTP id aa00523; 19 May 87 10:51 BST Date: 19-MAY-1987 10:48:17 From: SYSKERMIT%vax1.central.lancaster.ac.uk@Cs.Ucl.AC.UK To: "SY.FDC" <@Cs.Ucl.AC.UK:SY.FDC@cu20b.columbia.edu> Subject: File BBCPATCHER.BAS 10 REM *************************** 20 REM * KERMIT PARAMETER SETTER * 30 REM * BY DAVE M. WALKER * 40 REM * UNIVERSITY COLLEGE * 50 REM * CARDIFF * 60 REM *************************** 70 *TV255,1 80 MODE 7 90 IF PAGE>&2000 THEN ERM=1:PROCerror 100 BUFSIZE%=&2200-PAGE-1 110 HIMEM=HIMEM-BUFSIZE%-1 120 BUF%=HIMEM 130 ERM=0 140 ON ERROR PROCerror 150 PROCdecomp 160 VDU 28,1,24,39,19 170 PRINT " A PROGRAM TO DEHEX AND/OR SET THE " 180 PRINT " PARAMETERS OF KERMIT BEFORE USING " 190 PRINT " THE PROGRAM IN RAM OR ROM. " 200 REPEAT:A%=GET:UNTIL A%=32 210 VDU 23,1,1;0;0;0; 220 in$=FNfilenames("INPUT FILE") 230 in%=OPENIN(in$) 240 IF in%=0 THEN ERM=2:PROCerror 245 base%=FNrloadadd(in$) 250 IF base%<>0 THEN 330 260 PROCdehex 270 PRINT"DO YOU WISH TO SET PARAMETERS (Y/N) ?"; 280 REPEAT 290 A$=GET$ 300 UNTIL A$="Y" OR A$="N" 310 IF A$="N" THEN PRINT : GOTO 520 320 in%=OPENIN(in$) 330 FOR A%=BUF% TO BUF%+BUFSIZE% 340 ?A%=BGET#in% 350 NEXT A% 360 out$=FNfilenames("BINARY OUTPUT FILE WITH PARAMETERS SET") 370 out%=OPENOUT(out$) 380 PROCgetaddress 390 IF V=1.33 THEN READ ITEM$:READ A$ 400 IF V>=1.40 THEN READ A$:READ ITEM$ 410 FOR Q%=1 TO LEN(ITEM$) 420 Z$=MID$(ITEM$,Q%,1) 430 IF Z$="A" THEN PROCskiptog:GOTO 500 440 IF Z$="B" THEN PROCskipran:GOTO 500 450 IF Z$="M" THEN PROCmemory :GOTO 500 460 IF Z$="O" THEN PROComit :GOTO 500 470 IF Z$="R" THEN PROCranged :GOTO 500 480 IF Z$="S" THEN PROCsuffix :GOTO 500 490 IF Z$="T" THEN PROCtoggle :GOTO 500 500 NEXT Q% 510 PROCrunoff 520 VDU 26:END 530 : 540 REM ***** PROCEDURES & FUNCTIONS ***** 550 : 560 DEF PROCcheck 570 A%=GET:IF A%=13 THEN 610 580 A%=A%-48 590 IF A%<>0 AND A%<>1 THEN 630 600 ?AT%=A% 610 PROComit 620 GOTO 650 630 ERM=3:PROCerror 640 GOTO 570 650 ENDPROC 660 : 670 DEF PROCdecomp 680 LOCAL B%,C%,D%,E%,I%,J% 690 B%=&7C00 : C%=0 700 VDU 23,1,0;0;0;0; 710 FOR I%=0 TO 411 720 READ D% 730 IF D%<>&FF THEN 770 740 READ E%,D% 750 I%=I%+2 760 GOTO 780 770 E%=1 780 FOR J%=1 TO E% 790 B%?C%=D% : C%=C%+1 800 NEXT J% 810 NEXT I% 820 REPEAT:B%=GET:UNTIL B%=32 830 ENDPROC 840 : 850 DEF PROCdehex 860 LOCAL R% 870 out$=FNfilenames("BINARY OUTPUT FILE WITHOUT PARAMETERS SET") 880 out%=OPENOUT(out$) 890 R%=0 :AT%=0 900 VDU 28,1,24,39,19,12 910 PRINT CHR$(141);CHR$(133);"PLEASE WAIT - DEHEXING A FILE" 920 PRINT CHR$(141);CHR$(133);"PLEASE WAIT - DEHEXING A FILE" 930 VDU 28,1,23,39,22,12,23,1,0;0;0;0; 940 REPEAT 950 REPEAT 960 UNTIL (BGET#in%=ASC(":")) OR EOF#in% 970 IF EOF#in% THEN PROCsaverest:GOTO 990 ELSE PROCreadrecord 980 UNTIL FALSE 990 CLOSE#0 1000 in$=out$ 1010 PROCwloadadd(out$) 1020 VDU 23,1,1;0;0;0; 1030 VDU 28,1,24,39,19,12 1040 ENDPROC 1050 : 1060 DEF PROCdefault 1070 PRINT"THE DEFAULT VALUE IS";CHR$(131);?AT% 1080 PRINT"RETURN ENTERS"; 1090 IF L%=0 THEN PRINT CHR$(129);"ZERO" 1100 IF L%>0 THEN PRINT CHR$(134);"DEFAULT";CHR$(135);"VALUE" 1110 ENDPROC 1120 : 1130 DEF PROCerror 1140 CLS 1150 IF ERM>0 THEN 1300 1160 IF ERR=190 THEN 1280 1170 IF ERR=191 THEN 1280 1180 IF ERR=198 THEN 1280 1190 IF ERR=214 THEN 1230 1200 REPORT : PRINT " (error ";ERR;") at line ";ERL 1210 CLOSE#0 1220 VDU 26:END 1230 PRINT "FILE NOT FOUND: ENTER DATA DISK AND" 1240 PRINT "PRESS RETURN OR PRESS ANY OTHER KEY" 1250 PRINT "TO STOP." 1260 A%=GET:IF A%=13 THEN 230 1270 GOTO 1210 1280 PRINT "CAN NOT WRITE TO THIS DISK" 1290 VDU 26:END 1300 ON ERM GOTO 1320,1230,1350,1370,1390 1310 VDU 26:END 1320 PRINT "PAGE MUST BE EQUAL TO OR BELOW &2000" 1330 VDU 26:END 1340 CLS 1350 PRINT"INVALID VALUE, PLEASE RE-ENTER "; 1360 GOTO 1420 1370 PRINT"INVALID FILE NAME : RE-ENTER" 1380 GOTO 1420 1390 PRINT"Unknown record type ";T%;" detected" 1400 CLOSE#0 1410 VDU 26:END 1420 ERM=0 1430 ENDPROC 1440 : 1450 DEF FNfilenames(A$) 1460 LOCAL B$ 1470 VDU 28,1,24,39,19,12 1480 PRINT"ENTER NAME OF THE ";A$;" "; 1490 INPUT B$ 1500 IF LEN(B$)>0 AND LEN(B$)<8 THEN 1530 1510 ERM=4:PROCerror 1520 GOTO 1470 1530 =B$ 1540 : 1550 DEF PROCgetaddress 1560 LOCAL I% 1570 IF FNrloadadd(in$)=&8000 THEN1610 1580 AT%=BUF%?5+(BUF%?6)*&100+BUF%-FNrloadadd(in$) 1590 V=BUF%?3+(BUF%?4)/100 1600 GOTO 1650 1610 AT%=BUF%+BUF%?7+1 1620 REPEAT:PROComit:UNTIL ?AT%=0 1630 V=AT%?1+(AT%?2)/100 1640 AT%=AT%?3-&8000+BUF%+(AT%?4)*&100 1650 VDU 28,24,12,39,2 1660 FOR I%=1 TO 10:PRINT CHR$(135):NEXT I% 1670 ENDPROC 1680 : 1690 DEF FNgetbyte 1700 LOCAL V% 1710 V%=FNgetnibble*16 + FNgetnibble 1720 K% = (K% + V%) AND &FF 1730 =V% 1740 : 1750 DEF FNgetnibble 1760 =EVAL("&"+CHR$(BGET#in%)) 1770 : 1780 DEF PROChelp 1790 IF A%=1 THEN A%=ASC("`") 1800 IF A%=2 THEN A%=ASC("&") 1810 IF A%=3 THEN A%=ASC("/") 1820 IF A%=4 THEN A%=ASC("?") 1830 IF A%=5 THEN A%=ASC("@") 1840 ENDPROC 1850 : 1860 DEF FNhex(A%) 1870 LOCAL B%,B$ 1880 B$="" 1890 REPEAT 1900 B%=A% MOD &10 1910 IF B%<10 THEN B$=STR$(B%)+B$:GOTO 1930 1920 B$=CHR$(B%-10+ASC("A"))+B$ 1930 A%=A% DIV &10 1940 UNTIL A%=0 1950 IF LEN(B$)=1 THEN B$="0"+B$ 1960 IF LEN(B$)>2 THEN B$=RIGHT$(B$,2) 1970 =B$ 1980 : 1990 DEF PROCmemory 2000 LOCAL B%,C%,B$ 2010 VDU 28,25,12,39,2,12,28,1,24,39,19,12 2020 A%=?AT%+(AT%?1)*256 2030 READ A$ : PRINT A$ 2040 PRINT"THE DEFAULT VALUE IS ";~A% 2050 PRINT"PRESS";CHR$(134);"RETURN";CHR$(135);"TO EXIT" 2060 PRINT"PRESS";CHR$(129);"ANY OTHER KEY";CHR$(135);"TO CHANGE IT" 2070 B%=GET:IF B%=13 THEN 2130 2080 PRINT 2090 INPUT"INPUT NEW LOCATION IN HEX ";B$ 2100 IF LEFT$(B$,1)<>"&" THEN B$="&"+B$ 2110 A%=EVAL(B$) 2120 IF A%<0 OR A%>&FFFF THEN 2090 2130 ?AT%=A% MOD 256 2140 PROComit 2150 ?AT%=A% DIV 256 2160 PROComit 2170 ENDPROC 2180 : 2190 DEF PROComit 2200 LOCAL I% 2210 AT%=AT%+1 2220 IF AT%0 THEN PROCvalues 2410 VDU 28,1,24,39,19,12 2420 PROCdefault 2430 PRINT A$; : INPUT A% 2440 IF A%=0 AND L%>0 THEN 2510 2450 IF A$="SET HELP-TRIGGER" THEN 2490 2460 IF A%>=L% AND A%<=U% THEN 2500 2470 ERM=3:PROCerror 2480 GOTO 2430 2490 PROChelp 2500 ?AT%=A% 2510 PROComit 2520 ENDPROC 2530 : 2540 DEF PROCreaddata(L%) 2550 LOCAL I%,J% 2560 FOR I% = 1 TO L% 2570 BUF%?AT% = FNgetbyte 2580 M%=M%+1 : AT%=AT%+1 2590 IF BUF%+AT%<=BUF%+BUFSIZE% THEN 2640 2600 FOR J%=BUF% TO BUF%+BUFSIZE% 2610 BPUT#out%,?J% 2620 NEXT J% 2630 AT%=0 2640 NEXT I% 2650 ENDPROC 2660 : 2670 DEF PROCreadrecord 2680 LOCAL L%,M%,S%,T%,K% 2690 R%=R%+1:K%=0 2700 L%=FNgetbyte 2710 M%=FNgetbyte*256+FNgetbyte 2720 IF R%=1 THEN base%=M% 2730 PRINT TAB(0,0) "Record ";R%;" : Size ";L%;", address $";~M% 2740 T% = FNgetbyte 2750 IF T%<>0 AND T%<>1 THEN ERM=5:PROCerror 2760 IF T% <> 0 THEN ENDPROC 2770 PROCreaddata(L%) 2780 S% = FNgetbyte 2790 ENDPROC 2800 : 2810 DEF FNrloadadd(B$) 2820 LOCAL B%,C%,I% 2830 B$=B$+CHR$(13) 2840 DIM B% 18 , C% 8 2850 $C%=B$ 2860 B%?0=C% MOD 256:B%?1=C% DIV 256 2870 FOR I%=2 TO 17:B%?I%=0 : NEXT I% 2880 A%=5:X%=B% MOD 256:Y%=B% DIV 256 2890 CALL &FFDD 2900 = B%?2+B%?3*256 2910 : 2920 DEF PROCrunoff 2930 LOCAL I% 2940 VDU 28,25,12,39,2,12 2950 VDU 28,1,24,39,19,12 2960 PRINT CHR$(141);CHR$(133);"PLEASE WAIT - WRITING NEW FILE" 2970 PRINT CHR$(141);CHR$(133);"PLEASE WAIT - WRITING NEW FILE" 2980 VDU 23,1,0;0;0;0; 2990 FOR I%=BUF% TO BUF%+BUFSIZE% 3000 BPUT#out%,?I% 3010 NEXT I% 3020 IF EOF#in% THEN 3070 3030 REPEAT 3040 BPUT#out%,BGET#in% 3050 UNTIL EOF#in% 3060 VDU 23,1,1;0;0;0; 3070 CLOSE#0 3080 PROCwloadadd(out$) 3090 ENDPROC 3100 : 3110 DEF PROCsaverest 3120 LOCAL I% 3130 FOR I%=BUF% TO BUF%+AT%-1 3140 BPUT#out%,?I% 3150 NEXT I% 3160 ENDPROC 3170 : 3180 DEF PROCskipran 3190 LOCAL I%,L%,U%,A$ 3200 READ L%,U%,I%,A$ 3210 FOR L%=1 TO I%:READ A$:NEXT L% 3220 PROComit 3230 ENDPROC 3240 : 3250 DEF PROCskiptog 3260 READ L%,A$ 3270 PROComit 3280 ENDPROC 3290 : 3300 DEF PROCsuffix 3310 LOCAL I%,B$ 3320 CLS 3330 PRINT"THE PRESENT SUFFIX IS " 3340 B$="" 3350 FOR I%=0 TO 7 3360 B$=B$+CHR$(AT%?I%) 3370 NEXT I% 3380 PRINT B$ : READ A$ 3390 PRINT "PRESS RETURN FOR DEFAULT OR ANY OTHER" 3400 PRINT "KEY TO CHANGE IT "; 3410 I%=GET:IF I%<>13 THEN 3430 3420 A$=B$:PROComit:GOTO3520 3430 PRINT 3440 INPUT "ENTER NEW SUFFIX (<9 CHARS)" ;A$ 3450 IF LEN(A$)>8 THEN A$=LEFT$(A$,8) 3460 IF LEN(A$)=0 THEN 3430 3470 A%=LEN(A$):?AT%=A%:PROComit 3480 REPEAT 3490 IF LEN(A$)=8 THEN 3510 3500 A$=A$+" " 3510 UNTIL LEN(A$)=8 3520 I%=1 3530 REPEAT 3540 ?AT%=ASC(MID$(A$,I%,1)) 3550 PROComit 3560 I%=I%+1 3570 UNTIL I%=9 3580 ENDPROC 3590 : 3600 DEF PROCtoggle 3610 LOCAL L%,A$ 3620 PROConoff : PROCdefault 3630 READ L%,A$ : PRINT A$; 3640 PROCcheck 3650 ENDPROC 3660 : 3670 DEF PROCvalues 3680 LOCAL B%,B$ 3690 VDU 28,25,12,39,2,12 3700 IF I%=2 AND U%>1 THEN 3750 3710 FOR B%=1 TO I% 3720 READ B$ : PRINT B$ 3730 NEXT B% 3740 GOTO 3770 3750 PRINT "DECIMAL NUMBER" 3760 PRINT "RANGE ";STR$(L%);" TO "STR$(U%) 3770 ENDPROC 3780 : 3790 DEF PROCwloadadd(B$) 3800 LOCAL B%,C%,I% 3810 B$=B$+CHR$(13) 3820 DIM B% 18 , C% 8 3830 $C%=B$ 3840 B%?0=C% MOD 256:B%?1=C% DIV 256 3850 B$="" 3860 B$=B$+FNhex(base% MOD &100) 3870 B$=B$+FNhex(base% DIV &100) 3880 B$=B$+"FFFF" : B$=B$+B$ 3890 B$=B$+"0000000000000000" 3900 FOR I%=2 TO 17 3910 B%?I%=EVAL("&"+MID$(B$,I%*2-3,2)) 3920 NEXT I% 3930 A%=1:X%=B% MOD 256:Y%=B% DIV 256 3940 CALL &FFDD 3950 ENDPROC 3960 : 3970 REM ***** DATA STATEMENTS ***** 3980 : 3990 DATA255,127,32,146,56,111,127,124,127,127,124,126,127,125,124,124,48,255,25,32,146,104,35,105,107,255,8,127,39 4000 DATA114,52,255,24,32,146,34,60,38,106,255,8,127,42,112,53,255,24,32,146,106,127,124,127,127,127,123,127,127,123 4010 DATA127,127,116,122,52,255,23,32,146,104,43,255,13,127,61,255,23,32,146,126,117,136,35,35,47,47,111,127,63,47,47 4020 DATA47,35,137,121,255,22,32,146,106,127,63,47,127,127,124,124,116,112,120,124,124,124,119,115,123,116,48,255,19 4030 DATA32,146,120,119,124,126,255,16,127,48,255,18,32,146,255,20,127,53,255,17,32,146,127,127,127,47,47,47,115,59 4040 DATA111,255,6,127,119,115,124,43,127,127,53,255,17,32,146,127,127,127,111,255,13,127,63,32,127,127,125,255,16,32 4050 DATA146,104,127,127,127,34,111,255,11,127,63,33,96,126,127,127,255,16,32,146,106,127,127,127,32,34,47,255,4,127 4060 DATA63,47,47,47,96,124,124,124,255,4,127,131,255,15,32,146,106,255,4,127,125,124,60,36,255,7,32,35,35,32,123,63 4070 DATA35,33,130,255,14,32,146,120,127,63,39,111,127,125,52,131,255,30,32,146,127,55,32,32,32,35,33,255,33,32,131 4080 DATA141,75,69,82,77,73,84,133,32,68,69,72,69,88,69,82,32,38,32,80,65,82,65,77,69,84,69,82,32,83,69,84,84,73,78,71 4090 DATA32,32,32,131,141,75,69,82,77,73,84,133,32,68,69,72,69,88,69,82,32,38,32,80,65,82,65,77,69,84,69,82,32,83,69 4100 DATA84,84,73,78,71,255,7,32,134,66,89,32,68,65,86,69,32,87,65,76,75,69,82,44,32,85,46,67,46,32,67,65,82,68,73 4110 DATA70,70,46,255,53,32,80,82,69,83,83,136,129,83,80,65,67,69,135,137,84,79,32,67,79,78,84,73,78,85,69,255,71,32 4120 DATA "RRTOTORRTRRTRTRRRRRRRRRRRRMMRMMRRRRTRRSTRTRRTRRRRRBB" 4130 DATA "RRTOTORRTRRABTRRRRRRRRRRRRMMRMMRRRRTRRSTRTRRTRRRRRRR" 4140 DATA 1, 7,7,"ENTER TRANSMIT BAUD NUMBER " 4150 DATA"1. 75" 4160 DATA"2. 150" 4170 DATA"3. 300" 4180 DATA"4. 1200" 4190 DATA"5. 2400" 4200 DATA"6. 4800" 4210 DATA"7. 9600" 4220 DATA 1, 7,0,"ENTER RECEIVE BAUD NUMBER " 4230 DATA 1, "SET LOCAL ECHO " 4240 REM DATA HERE FOR BYTE 3 4250 DATA 1, "SET DEBUGGING " 4260 REM DATA HERE FOR BYTE 5 4270 DATA 0, 94,2,"SET SEND TIMEOUT " 4280 DATA 0,255,2,"SET RECEIVE TIMEOUT " 4290 DATA 1, "SET TIMER " 4300 DATA 0,255,2,"SET PAUSE " 4310 DATA 0,255,0,"SET DELAY " 4320 DATA 1, "SET VT52 " 4330 DATA 0, 1,2,"SET VDU-WIDTH " 4340 DATA"0. 80 char " 4350 DATA"1. 40 char " 4360 DATA 1, "SET KEY-CLICK " 4370 DATA33,126,2,"SET QUOTE " 4380 DATA33,126,0,"SET EIGHT-BIT-PREFIX " 4390 DATA 0, 31,2,"SET SEND END-OF-LINE " 4400 DATA 0, 31,0,"SET RECEIVE END-OF-LINE " 4410 DATA 0,255,2,"SET SEND PADCHAR " 4420 DATA 0,255,0,"SET SEND PADDING " 4430 DATA 0, 31,2,"SET RECEIVE PADCHAR " 4440 DATA 0, 94,2,"SET RECEIVE PADDING " 4450 DATA 0, 4,5,"SET PARITY " 4460 DATA"0. MARK" 4470 DATA"1. SPACE" 4480 DATA"2. EVEN" 4490 DATA"3. ODD" 4500 DATA"4. NONE" 4510 DATA 0, 1,2,"SET FILE TYPE " 4520 DATA"0. ASCII" 4530 DATA"1. BINARY" 4540 DATA 0, 3,4,"SET FILE TYPE ASCII " 4550 DATA"0. LFCR" 4560 DATA"1. CRLF" 4570 DATA"2. LF" 4580 DATA"3. CR" 4590 DATA 0, 1,2,"SET SOURCE MEMORY" 4600 DATA"0. FILE" 4610 DATA"1. MEMORY" 4620 DATA "SET SOURCE MEMORY (BASE) " 4630 DATA "SET SOURCE MEMORY (TOP) " 4640 DATA 0, 2,3,"SET DESTINATION MEMORY" 4650 DATA"0. FILE" 4660 DATA"1. MEMORY" 4670 DATA"2. PRINTER" 4680 DATA "SET DESTINATION MEMORY (BASE) " 4690 DATA "SET DESTINATION MEMORY (TOP) " 4700 DATA 0, 31,2,"SET SEND START-OF-PACKET " 4710 DATA 0, 31,0,"SET RECEIVE START-OF-PACKET " 4720 DATA35, 94,2,"SET RECEIVE PACKET-LENGTH " 4730 DATA 1, 64,2,"SET FILE BUFFER-SIZE " 4740 DATA 1, "SET FILE WARNING " 4750 DATA 0, 1,2,"SET INCOMPLETE " 4760 DATA"0. DELETE" 4770 DATA"1. KEEP" 4780 DATA 0, 1,2,"SET FLOW-CONTROL " 4790 DATA"0. XON/XOFF" 4800 DATA"1. CTS/RTS" 4810 DATA "SET FILE SUFFIX " 4820 DATA 1, "SET TAKE-ECHO " 4830 DATA 1, 7, 7,"SET VDU-COLOUR " 4840 DATA"1. RED" 4850 DATA"2. GREEN" 4860 DATA"3. YELLOW" 4870 DATA"4. BLUE" 4880 DATA"5.MAGENTA" 4890 DATA"6. CYAN" 4900 DATA"7. WHITE" 4910 DATA 1, "SET TV " 4920 DATA 0,255,2,"SET TV (FIRST NUMBER) " 4930 DATA 0,255,0,"SET TV (SECOND NUMBER) " 4940 DATA 1, "SET IGNORE " 4950 DATA 0,255,2,"SET IGNORE (CHAR) " 4960 DATA 0,255,0,"SET MUX-WAIT " 4970 DATA 1, 5,5,"SET HELP-TRIGGER " 4980 DATA"1. ` (=39)" 4990 DATA"2. & (=38)" 5000 DATA"3. / (=47)" 5010 DATA"4. ? (=63)" 5020 DATA"5. @ (=64)" 5030 DATA 1,255,2,"SET NUMBER OF RETRIES " 5040 DATA 0, 5,6,"SET HANDSHAKE " 5050 DATA"0. NONE" 5060 DATA"1. BELL" 5070 DATA"2. CR" 5080 DATA"3. LF" 5090 DATA"4. XON" 5100 DATA"5. XOFF" 5110 DATA 0, 6,7,"SET TERMINAL " 5120 DATA"0. TT40" 5130 DATA"1. TT80" 5140 DATA"2. VT52" 5150 DATA"3. VT100" 5160 DATA"4. TEK" 5170 DATA"5. Un-named A" 5180 DATA"6. Un-named B" 5190 DATA 0, 1,2,"SET ACTION ON REMOTE FILENAME " 5200 DATA"0. TRANSLATE" 5210 DATA"1. KEEP FILENAME"