1 REM Ins{nd av Mikael Lid`n <5651> 1986-04-24 09.49.22 1 1000 ! KERMIT / Mikael Lid`n 1010 ! 1020 INTEGER : EXTEND 1030 ! 1040 ! ATTRIBUTE 1 / skall anv{ndas vid k|rning p} ABC806 1050 ! 1060 DEF FNKermit LOCAL A$=10,Mval,Flf 1070 Maxpack=78 : Soh=1 : Brkchr=192 : Maxtry=5 : Myquote=ASCII('#') : Mypad=0 : Mypchar=0 : Myeol=13 : Mytime=5 1080 Maxtim=20 : Mintim=2 : True=-1 : False=0 : Fd=4 : Remfd=9 : Sp=32 : Del=127 : Brf=7 : Ctrc=193 : Eol=13 1090 DIM Recpkt$=80,Packet$=160,Inbuff$=160,Q$=100,Sp$=25,V24buf$=1024,Sbuf$=170 1100 POKE PEEK2(65500)+2,VAROOT(V24buf$),SWAP%(VAROOT(V24buf$)) 1110 Sp$=SPACE$(25) 1120 IF FNF|rbindelse RETURN E9 1130 WHILE True 1140 Mval=FNHead 1150 IF Mval=1 H=FNConnect 1160 WHILE Mval=2 1170 IF FNRecsw ; CUR(15,0) FNF$(WHT) 'OK' SPACE$(78) ELSE ; CUR(15,0) FNF$(RED) 'Mottagningen misslyckades' SPACE$(53) 1180 ; FNF$(WHT) ''; : A$=FNTkn$(WHT) 1190 Mval=0 1200 WEND 1210 WHILE Mval=3 1220 Nfiles=FNFiles(0) : Flf=-1 1230 WHILE Nfiles>0 AND Flf 1240 Ifile=1 1250 Filnam$=File$(Ifile) 1260 IF FNSendsw ; CUR(15,0) FNF$(WHT) 'OK' SPACE$(78) ELSE ; CUR(15,0) FNF$(RED) 'S{ndningen misslyckades' SPACE$(55) 1270 ; FNF$(WHT) ''; : A$=FNTkn$(WHT) 1280 Flf=0 1290 WEND 1300 Mval=0 1310 WEND 1320 IF Mval=4 RETURN 0 1330 WEND 1340 FNEND 1350 DEF FNSpar$=CHR$(Maxpack+32,Mytime+32,Mypad+32,Mypchar XOR 64,Myeol+32,Myquote) 1360 DEF FNRpar(S$) LOCAL Pp,Ss$=6 1370 Spsiz=ASCII(S$)-32 : Timint=ASCII(MID$(S$,2,1))-32 1380 Pad=ASCII(MID$(S$,3,1))-32 : Padchar=ASCII(MID$(S$,4,1)) 1390 Padchar=Padchar XOR 64 1400 Eol=ASCII(MID$(S$,5,1))-32 : Quote=ASCII(MID$(S$,6,1)) 1410 RETURN 0 1420 FNEND 1430 DEF FNBufemp(Buf,Fd,Lgd) LOCAL I,T,Pp 1440 I=1 : Pp=Buf 1450 WHILE I<=Lgd 1460 T=PEEK(Pp) 1470 IF T=Myquote I=I+1 : Pp=Pp+1 : Z=FNUnquote(PEEK(Pp)) ELSE ; #Fd CHR$(T); : Krad=Krad+1 1480 I=I+1 : Pp=Pp+1 1490 WEND 1500 RETURN Lgd 1510 FNEND 1520 DEF FNUnquote(T) 1530 IF T=Myquote ; #Fd CHR$(T); : Krad=Krad+1 : RETURN 0 1540 T=T XOR 64 : IF T=Myeol Krad=0 1550 IF T=9 ; #Fd SPACE$(8*((Krad+8)/8)-Krad); : Krad=8*((Krad+8)/8) : RETURN 0 1560 ; #Fd CHR$(T); : RETURN 0 1570 FNEND 1580 DEF FNBufill$ LOCAL B$=90,I,T 1590 B$='' 1600 WHILE True 1610 IF LEN(Inbuff$)=0 ON ERROR GOTO 1660 : INPUT LINE #2,Inbuff$ 1620 T=ASCII(Inbuff$) AND 127 1630 IF TSpsiz-9 RETURN B$ ELSE B$=B$+FNQ$(T) ELSE B$=B$+CHR$(T) 1640 Inbuff$=RIGHT$(Inbuff$,2) : IF LEN(B$)>=Spsiz-8 RETURN B$ 1650 WEND 1660 RESUME 1670 1670 RETURN B$ 1680 FNEND 1690 DEF FNSpack(Type,Num,Length,Data$) LOCAL Chksum,Buffer$=170,I 1700 Buffer$=STRING$(Padchar,Pad)+CHR$(Soh,Length+35,Num+32,Type)+Data$ 1710 Chksum=Length+Num+Type+67 1720 I=1 1730 WHILE I<=Length : Chksum=Chksum+ASCII(MID$(Data$,I,1)) : I=I+1 : WEND 1740 Chksum=(Chksum+(Chksum AND 192)/64) AND 63 1750 Buffer$=Buffer$+CHR$(Chksum+32,Eol,10) 1760 ; #Remfd Buffer$; 1770 ; CUR(15,0) FNF$(GRN); 1780 ; 'S{nder packet ';N ' Typ: ' CHR$(Type) ' F|rs|k: ' Numtry ' '; 1790 RETURN LEN(Buffer$) 1800 FNEND 1810 DEF FNRpack(Length,Num,Datax) LOCAL T,Chksum,L,Pdata,Done,Type,J 1820 IF Timint>Maxtim OR TimintSoh : T=FNGetch : IF T<0 RETURN False 1850 WEND 1860 WHILE J<4+L 1870 T=FNGetch : IF T<0 RETURN -9 ELSE IF T=Soh J=-1 1880 IF J=0 Chksum=T : L=T-35 : POKE Length,L,SWAP%(L) 1890 IF J=1 Chksum=Chksum+T : POKE Num,T-32,0 1900 IF J=2 Chksum=Chksum+T : Type=T : Pp=PEEK2(Datax+2) : POKE Datax+4,0,0 1910 IF J>2 AND J-3T-32 RETURN False 1960 ; CUR(15,41) FNF$(GRN); 1970 ; 'Mottaget packet ' PEEK2(Num) ' ' N ' ' CHR$(Type) ' ' L ' ' 1980 POKE Datax+4,L,0 1990 RETURN Type 2000 FNEND 2010 DEF FNSendsw 2020 State=ASCII('S') : N=0 : Numtry=0 2030 WHILE True 2040 IF INSTR(1,'DFZSBCA',CHR$(State))=0 RETURN False 2050 IF State=68 State=FNSdata 2060 IF State=70 State=FNSfile 2070 IF State=90 State=FNSeof 2080 IF State=83 State=FNSinit 2090 IF State=66 State=FNSbreak 2100 IF State=67 RETURN True 2110 IF State=65 RETURN False 2120 WEND 2130 FNEND 2140 DEF FNSinit LOCAL Num,Length,Type 2150 IF Numtry>Maxtry RETURN ASCII('A') 2160 Numtry=Numtry+1 2170 Packet$=FNSpar$ 2180 H=FNSpack(ASCII('S'),N,6,Packet$) 2190 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 2200 IF Type=ASCII('N') RETURN State 2210 IF Type=0 RETURN State 2220 IF Type<>ASCII('Y') RETURN ASCII('A') 2230 IF N<>Num RETURN State 2240 H=FNRpar(Recpkt$) 2250 IF Eol=0 Eol=13 2260 IF Quote=0 Quote=ASCII('#') 2270 Numtry=0 : N=(N+1) AND 63 2280 OPEN Filnam$ AS FILE 2 : ; CUR(14,0) FNF$(GRN) 'S{nder ' Filnam$ ' '; 2290 RETURN ASCII('F') 2300 FNEND 2310 DEF FNSfile LOCAL Num,Length,H,Type 2320 IF Numtry>Maxtry RETURN ASCII('A') 2330 Numtry=Numtry+1 2340 Length=LEN(Filnam$) : H=FNSpack(ASCII('F'),N,Length,Filnam$) 2350 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 2360 IF Type=0 RETURN State 2370 IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A') 2380 IF Type=ASCII('N') Num=((Num-1) AND 63) 2390 IF N<>Num RETURN State 2400 Numtry=0 : N=(N+1) AND 63 : Packet$=FNBufill$ : Size=LEN(Packet$) 2410 RETURN ASCII('D') 2420 FNEND 2430 DEF FNSdata LOCAL Num,Length,H 2440 IF Numtry>Maxtry RETURN ASCII('A') 2450 Numtry=Numtry+1 2460 H=FNSpack(ASCII('D'),N,Size,Packet$) 2470 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 2480 IF Type=0 RETURN State 2490 IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A') 2500 IF Type=ASCII('N') Num=((Num-1) AND 63) 2510 IF N<>Num RETURN State 2520 Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : Pktnum=Pktnum+1 2530 Packet$=FNBufill$ : Size=LEN(Packet$) : IF Size=0 RETURN ASCII('Z') 2540 RETURN ASCII('D') 2550 FNEND 2560 DEF FNSeof LOCAL Num,Length,H 2570 IF Numtry>Maxtry RETURN ASCII('A') 2580 Numtry=Numtry+1 2590 H=FNSpack(ASCII('Z'),N,0,'') 2600 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 2610 IF Type=0 RETURN State 2620 IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A') 2630 IF Type=ASCII('N') Num=((Num-1) AND 63) 2640 IF N<>Num RETURN State 2650 Numtry=0 : N=(N+1) AND 63 2660 CLOSE 2 2670 Ifile=Ifile+1 : IF Ifile>Nfiles RETURN ASCII('B') 2680 Filnam$=File$(Ifile) 2690 OPEN Filnam$ AS FILE 2 2700 RETURN ASCII('F') 2710 FNEND 2720 DEF FNSbreak LOCAL Num,Length,H,Type 2730 IF Numtry>Maxtry RETURN ASCII('A') 2740 Numtry=Numtry+1 2750 H=FNSpack(ASCII('B'),N,0,'') 2760 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 2770 IF Type=0 RETURN State 2780 IF INSTR(1,'NY',CHR$(Type))=0 RETURN ASCII('A') 2790 IF Type=ASCII('N') Num=((Num-1) AND 63) 2800 IF N<>Num RETURN State 2810 Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('C') 2820 FNEND 2830 DEF FNRecsw 2840 Nfiles=FNFiles(1) : File=0 2850 State=ASCII('R') : N=0 : Numtry=0 2860 WHILE True 2870 IF State=ASCII('D') State=FNRdata 2880 IF State=ASCII('F') State=FNRfile 2890 IF State=ASCII('R') State=FNRinit 2900 IF State=ASCII('C') RETURN True 2910 IF State=ASCII('A') RETURN False 2920 WEND 2930 FNEND 2940 DEF FNRinit LOCAL Num,Length,Type 2950 IF Numtry>Maxtry RETURN ASCII('A') 2960 Numtry=Numtry+1 2970 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$)) 2980 IF Type=False RETURN State 2990 IF Type<>ASCII('S') RETURN ASCII('A') 3000 H=FNRpar(Packet$) : Packet$=FNSpar$ 3010 H=FNSpack(ASCII('Y'),N,6,Packet$) : Oldtry=Numtry 3020 Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('F') 3030 FNEND 3040 DEF FNRfile LOCAL Lengh,Num,Type,H,Filename$=20 3050 IF Numtry>Maxtry RETURN ASCII('A') 3060 Numtry=Numtry+1 3070 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$)) 3080 IF Type=0 RETURN State 3090 WHILE Type=ASCII('S') 3100 Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A') 3110 IF Num<>((N-1) AND 63) RETURN ASCII('A') 3120 Packet$=FNSpar$ : H=FNSpack(ASCII('Y'),Num,6,Packet$) 3130 Numtry=0 : RETURN State 3140 WEND 3150 WHILE Type=ASCII('Z') 3160 Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A') 3170 IF Num<>((N-1) AND 63) RETURN ASCII('A') 3180 H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State 3190 WEND 3200 WHILE Type=ASCII('F') 3210 File=File+1 3220 IF Num<>N RETURN ('A') 3230 IF FNGetfil(Packet$)=False ; CUR(15,0) FNF$(RED) 'Kan inte skapa: ' Packet$ : RETURN ASCII('A') 3240 IF File<=Nfiles THEN Filename$=File$(File) ELSE Filename$=Packet$ 3250 ; CUR(14,0) FNF$(GRN) 'Tar emot: ' Filename$ ' '; 3260 H=FNSpack(ASCII('Y'),N,0,'') 3270 Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D') 3280 WEND 3290 WHILE Type=ASCII('B') 3300 IF Num<>N RETURN ('A') 3310 H=FNSpack(ASCII('Y'),N,0,'') : RETURN ASCII('C') 3320 WEND 3330 RETURN ASCII('A') 3340 FNEND 3350 DEF FNRdata LOCAL Num,Length,H,Type 3360 IF Numtry>Maxtry RETURN ASCII('A') 3370 Numtry=Numtry+1 3380 Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$)) 3390 IF Type=0 RETURN State 3400 WHILE Type=ASCII('D') 3410 WHILE Num<>N 3420 Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A') 3430 IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,6,Packet$) : Numtry=0 : RETURN State 3440 RETURN ASCII('A') 3450 WEND 3460 H=FNBufemp(VARPTR(Packet$),Fd,LEN(Packet$)) : H=FNSpack(ASCII('Y'),N,0,'') 3470 Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D') 3480 WEND 3490 WHILE Type=ASCII('F') 3500 Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A') 3510 IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State 3520 RETURN ASCII('A') 3530 WEND 3540 WHILE Type=ASCII('Z') 3550 IF Num<>N RETURN ASCII('A') 3560 H=FNSpack(ASCII('Y'),N,0,'') : CLOSE Fd : N=(N+1) AND 63 : RETURN ASCII('F') 3570 H=FNSpack(ASCII('N'),N,0,'') 3580 RETURN State 3590 WEND 3600 RETURN ASCII('A') 3610 FNEND 3620 DEF FNConnect LOCAL Dummy$=1 3630 ; CUR(15,0) FNF$(GRN) 'Kermit: uppkopplad - terminal mod - PF1 till meny.' 3640 FOR I.=1 TO 1000 : NEXT I. 3650 ; CHR$(12); 3660 Z=FNTerm 3670 RETURN 0 3680 FNEND 3690 DEF FNInchr$ LOCAL Dummy$=1 3700 GET #Remfd Dummy$ : RETURN CHR$(ASCII(Dummy$) AND 127) 3710 FNEND 3720 DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,I 3730 Nfile=0 : ; CUR(12,0) FNF$(YEL) 'Specifiera filnamn ' 3740 ; SPACE$(162) 3750 Aa$=FNSpbort$(FNInmata$('',13,0,1,2,70,GRN+CHR$(138))) 3760 ; CUR(13,0) FNF$(WHT) Aa$+SPACE$(72-LEN(Aa$)) 3770 IF Aa$='' RETURN 0 3780 Nfile=Nfile+1 3790 K=INSTR(1,Aa$,',') 3800 WHILE K 3810 File$(Nfile)=LEFT$(Aa$,K-1) : Aa$=RIGHT$(Aa$,K+1) 3820 Nfile=Nfile+1 3830 K=INSTR(1,Aa$,',') 3840 WEND 3850 File$(Nfile)=Aa$ 3860 IF Rsw RETURN Nfile 3870 ON ERROR GOTO 3900 3880 I=1 : WHILE I<=Nfile : OPEN File$(I) AS FILE 2 : CLOSE 2 : I=I+1 : WEND 3890 ON ERROR GOTO : RETURN Nfile 3900 RESUME 3910 3910 Z=FNFel('Fil '+File$(I)+' finns inte - avbryter !') : ON ERROR GOTO : RETURN -1 3920 FNEND 3930 DEF FNGetch LOCAL Sec,I,Dummy$=1 3940 Sec=PEEK(65524)+Timint+1 : IF Sec>59 Sec=Sec-60 3950 WHILE Sec<>PEEK(65524) 3960 IF PEEK2(PEEK2(65500)+6) RETURN ASCII(FNInchr$) 3970 WEND 3980 RETURN -1 3990 FNEND 4000 DEF FNHead LOCAL F,F$=1,Baud 4010 ON ERROR GOTO 4140 4020 Z=FNClr 4030 ; CUR(0,25) FNF$(YEL) 'KERMIT - fil|verf|ringsprogram' 4040 ; CUR(4,0); 4050 ; 'K Koppla upp terminalf|rbindelse' 4060 ; 'M Mottag filer fr}n v{rddator' 4070 ; 'S S{nd filer till v{rddator' 4080 ; 4090 ; 'A Avsluta KERMIT' 4100 WHILE F=0 4110 ; CUR(11,0) FNF$(YEL) 'V{lj funktion: ' CHR$(8); : F$=FNTkn$(YEL) 4120 F$=CHR$(ASCII(F$) AND 223) : ; F$ 4130 F=INSTR(1,'KMSA',F$) : IF F RETURN F 4140 WEND 4150 FNEND 4160 DEF FNGetfil(Aa$) LOCAL A$=30 4170 A$=Aa$ : IF File<=Nfiles A$=File$(File) 4180 ON ERROR GOTO 4190 : PREPARE A$ AS FILE Fd : Krad=0 : RETURN True 4190 ; CUR(14,0) FNF$(RED) 'Fil: ' A$ ' Felaktigt filnamn'; : RETURN False 4200 FNEND 4210 DEF FNQ$(T) 4220 IF T=Myquote RETURN CHR$(Myquote,Myquote) 4230 RETURN CHR$(Myquote,T XOR 64) 4240 FNEND 4250 DEF FNDelay LOCAL X. 4260 X.=1. : WHILE X.<1500. : X.=X.+1. : WEND 4270 RETURN 0 4280 FNEND 4290 DEF FNTerm 4300 ; CHR$(12); 4310 Cu=PEEK2(SYS(10)+64)+6 4320 Eko=-1 4330 Slut=0 4340 WHILE NOT Slut 4350 IF PEEK2(PEEK2(65500)+6)<>0 Z=FNV24in 4360 IF SYS(5)=128 OR S{nd Z=FNTeckin 4370 WEND 4380 Slut=0 4390 RETURN 0 4400 FNEND 4410 DEF FNTeckin 4420 IF S{nd Z=FNS{ndtkn ELSE GET A$ 4430 IF NOT Eko ; A$; : IF Dump ; #30,A$; 4440 IF ASCII(A$)=192 Slut=-1 : RETURN FNMeny 4450 PUT #9,A$ 4460 RETURN 0 4470 FNEND 4480 DEF FNV24in LOCAL A 4490 A=PEEK2(PEEK2(65500)+6) : IF A>80 A=80 4500 GET #9,A$ COUNT A 4510 Z=FNSk{rm 4520 RETURN 0 4530 FNEND 4540 DEF FNCursor LOCAL Rad,Kol 4550 Rad=PEEK(Cu+1) : Kol=PEEK(Cu) 4560 OUT 56,14,57,SWAP%(30720+Rad*80+Kol) 4570 OUT 56,15,57,30720+Rad*80+Kol 4580 OUT 56,10,57,104 4590 RETURN 0 4600 FNEND 4610 DEF FNSk{rm 4620 Z=FNCursor 4630 FOR J=1 TO LEN(A$) 4640 C$=CHR$(ASCII(RIGHT$(A$,J)) AND 127) 4650 IF C$=CHR$(27) Esc=-1 4660 IF NOT Esc ; C$; : IF Dump ; #30 C$; 4670 IF Esc IF LEN(B$)=3 ; B$+C$; : B$='' : Esc=0 ELSE B$=B$+C$ 4680 NEXT J 4690 Z=FNCursor 4700 RETURN 0 4710 FNEND 4720 DEF FNMeny LOCAL B$=5,A$=2048,Sk{rm$=0,Rad,Kol 4730 POKE VAROOT(Sk{rm$),0,8,30720,SWAP%(30720),0,8 4740 Rad=PEEK(Cu+1) : Kol=PEEK(Cu) 4750 A$=Sk{rm$ 4760 ; CHR$(12) FNF$(WHT) 4770 ; CUR(0,0) FNF$(CHR$(138)) SPACE$(25) '** Terminal meny **' CUR(0,59) FNF$(CHR$(138)) TIME$ 4780 ; : ; : ; 4790 ; '1. Dumpa fil till v{rddator.' 4800 ; '2. Dumpa data till lokal fil.' 4810 ; '3. Avbryt dumpning till lokal fil.' 4820 ; '4. Eko' 4830 ; '5. Ej eko' 4840 ; '9. Till kermit meny' 4850 ; 4860 ; '0. Ingenting' 4870 ; 4880 ; 'Ange val: '; 4890 GET B$ 4900 ; B$ 4910 ; : ; 4920 IF B$='9' CLOSE 20,30 : ; CHR$(12) : RETURN 0 4930 IF S{nd=0 IF B$='1' Z=FNSfil 4940 IF Dump=0 IF B$='2' Z=FNRfil 4950 IF B$='3' Dump=0 : CLOSE 30 4960 IF B$='4' Eko=-1 4970 IF B$='5' Eko=0 4980 Sk{rm$=A$ 4990 POKE Cu,Kol,Rad 5000 Sfl=0 : Slut=0 5010 RETURN 0 5020 FNEND 5030 DEF FNSfil 5040 ; 5050 INPUT 'Fil: 'Fil$ 5060 ON ERROR GOTO 5090 5070 OPEN Fil$ AS FILE 20 5080 S{nd=-1 5090 RETURN 0 5100 FNEND 5110 DEF FNRfil 5120 ; 5130 INPUT 'Fil: 'Fil$ 5140 ON ERROR GOTO 5170 5150 PREPARE Fil$ AS FILE 30 5160 Dump=-1 5170 RETURN 0 5180 FNEND 5190 DEF FNS{ndtkn 5200 ON ERROR GOTO 5250 5210 IF LEN(Sbuf$)<1 FOR I=1 TO 5000 : NEXT I : INPUT LINE #20,Sbuf$ : Sbuf$=LEFT$(Sbuf$,LEN(Sbuf$)-1) 5220 A$=CHR$(ASCII(Sbuf$)) 5230 Sbuf$=RIGHT$(Sbuf$,2) 5240 RETURN A 5250 S{nd=0 : CLOSE 20 5260 RETURN 0 5270 FNEND 5280 DEF FNF|rbindelse LOCAL A$=50,Tel$=30,J 5290 Z=FNClr 5300 ; CUR(0,25) FNF$(YEL) 'KERMIT - fil|verf|ringsprogram' 5310 ; CUR(4,0) FNF$(WHT) 'A 300 baud' : ; 'B 1200/75 baud' 5320 ; 'C 75/1200 baud' : ; 'D 1200 baud' : ; 'E 2400 baud' 5330 ; 'F 4800 baud' : ; 'G 9600 baud' : ; 'H 19200 baud' 5340 ; CUR(15,0) FNF$(YEL) 'V{lj kommunikations hastiget (A-H): '; 5350 A$=CHR$(ASCII(FNInmata$('',15,40,1,2,1,GRN+CHR$(138))) AND 223) 5360 WHILE A$<'A' OR A$>'H' : A$=CHR$(ASCII(FNInmata$('',15,40,1,2,1,GRN+CHR$(138))) AND 223) : WEND 5370 ; CUR(15,40) FNF$(WHT) A$ 5380 OPEN 'V24:VSA30A01.'+MID$('2240044455667788',2*(ASCII(A$)-65)+1,2)+'A' AS FILE Remfd 5390 PUT #Remfd,'TGC'+CHR$(13) 5400 ; CUR(17,0) FNF$(YEL) 'Tele Nr: ' 5410 Tel$=FNSpbort$(FNInmata$('',17,10,1,2,18,GRN+CHR$(138))) 5420 ; CUR(17,10) FNF$(WHT) Tel$ SPACE$(20) 5430 IF Tel$='' RETURN 0 5440 PUT #Remfd,CHR$(2,67)+Tel$+CHR$(3) 5450 J=0 5460 WHILE J<30000 5470 WHILE PEEK2(PEEK2(65500)+6)<>0 5480 GET #Remfd,A$ : A$=CHR$(ASCII(A$) AND 127) 5490 IF A$='C' A$='Linjen uppkopplad' 5500 IF A$='E' A$='Kommando fel' 5510 IF A$='I' A$='Ingen linjesignal' 5520 IF A$='U' A$='Numret saknas' 5530 IF A$='A' A$='Inget svar' 5540 IF A$='B' A$='Numret upptaget' 5550 IF A$='N' A$='Ingen b{rv}g' 5560 IF A$='R' A$='Fel kommando' 5570 ; CUR(19,0) FNF$(CYA) A$ ' !' 5580 FOR I.=1 TO 1000 : NEXT I. 5590 IF ASCII(A$)=ASCII('L') RETURN 0 ELSE RETURN -1 5600 WEND 5610 J=J+1 5620 WEND 5630 RETURN -1 5640 FNEND 5650 DEF FNClose(Fil) 5660 ON ERROR GOTO 5690 5670 IF Fil=-1 CLOSE ELSE CLOSE Fil 5680 RETURN 0 5690 E9=ERRCODE 5700 RETURN E9 5710 FNEND 5720 DEF FNClr 5730 ; CUR(1,0) FNF$(GYEL) STRING$(80,127); 5740 ; CUR(21,0) FNF$(GYEL) STRING$(80,127); 5750 ; CUR(0,22) SPACE$(36) 5760 ; CUR(0,0) Huvud$ ' ' FNF$(GYEL) '' 5770 ; CUR(2,0) SPACE$(1520); 5780 RETURN 0 5790 FNEND 5800 DEF FNF$(F{rg$) 5810 IF Mtyp=0 RETURN F{rg$ 5820 RETURN '' 5830 FNEND 5840 DEF FNSpbort$(In$) LOCAL A$=100,I,A 5850 I=1 5860 WHILE I<=LEN(In$) 5870 A=ASCII(RIGHT$(In$,I)) 5880 IF A<>32 A$=A$+CHR$(A) 5890 I=I+1 5900 WEND 5910 RETURN A$ 5920 FNEND 5930 DEF FNFeltext(In$) 5940 ; CUR(21,0) CHR$(7) FNF$(RED+NWBG+WHT+FLSH) '<' FNF$(NRML+STDY) In$ FNF$(FLSH) '>' SPACE$(78-LEN(In$)) FNF$(CHR$(128)+NWBG+WHT); 5950 RETURN 0 5960 FNEND 5970 DEF FNFelt$ LOCAL F$=80,F 5980 ON ERROR GOTO 6060 5990 OPEN Prog$+'FELTEXT.TXT' AS FILE 99 6000 INPUT #99,F : INPUT LINE #99,F$ : F$=LEFT$(F$,LEN(F$)-2) 6010 WHILE F<>255 6020 IF F=E9 RETURN F$ 6030 INPUT #99,F : INPUT LINE #99,F$ : F$=LEFT$(F$,LEN(F$)-2) 6040 WEND 6050 CLOSE 99 6060 RETURN '\vriga fel (Nr:'+NUM$(E9)+')' 6070 FNEND 6080 DEF FNFel(In$) LOCAL A$=1 6090 Z=FNFeltext(In$+' Kvittera med Ce ') 6100 ; CUR(21,LEN(In$)+22); : A$=FNTkn$(RED) 6110 WHILE A$<>CHR$(24) 6120 A$=FNTkn$(RED) 6130 WEND 6140 ; CUR(21,0) FNF$(GYEL) STRING$(80,127) 6150 RETURN 0 6160 FNEND 6170 DEF FNTkn$(F{rg$) LOCAL B$=1,Rad,Kol,Cu 6180 Cu=PEEK2(SYS(10)+64)+6 6190 Rad=PEEK(Cu+1) : Kol=PEEK(Cu) 6200 IF Mtyp=0 ; F{rg$ CHR$(PEEK(30720+Rad*80+Kol)); 6210 OUT 56,14,57,SWAP%(30720+Rad*80+Kol) 6220 OUT 56,15,57,30720+Rad*80+Kol 6230 OUT 56,10,57,104 6240 ; CUR(0,59) FNF$(CHR$(139)+NRML+GYEL) ' ' FNF$(YEL) TIME$ 6250 WHILE SYS(5)=0 : ; CUR(0,59) FNF$(CHR$(139)+NRML+GYEL) ' ' FNF$(YEL) TIME$ : WEND 6260 GET B$ : IF (ASCII(B$)=215 AND Key99=0) OR (ASCII(B$)=130 AND Key99) Z=FNDump 6270 POKE Cu,Kol,Rad 6280 RETURN B$ 6290 FNEND 6300 DEF FNPropen(Fil) 6310 WHILE -1 6320 ON ERROR GOTO 6350 6330 OPEN Printer$ AS FILE Fil 6340 RETURN 0 6350 Z=FNFel('Skrivaren ej p}slagen, kontrollera ! ') 6360 WEND 6370 FNEND 6380 DEF FNInmata$(In$,Rad,Kol,Inpos,Pa,Max,F{rg$) LOCAL Ut$=100,L{ngd,Pos,Fval,A,Ins,M1$=1,M2$=1,M3$=10 6390 Ut$=In$ : Pos=Inpos : Fval=Pa AND 15 : Z=FNKom99(9) 6400 WHILE -1 6410 ; CUR(Rad,Kol) FNF$(F{rg$) Ut$ STRING$(Max-LEN(Ut$),32-63*(Mtyp<>0)); 6420 IF Pos>Max Pos=Max 6430 L{ngd=LEN(Ut$) 6440 ; CUR(Rad,Kol+Pos-1); 6450 A=ASCII(FNTkn$(F{rg$+CHR$(138))) 6460 Z=INSTR(1,CHR$(128,161,163,177,179,172,164,127),CHR$(A)) 6470 IF Z A=ASCII(RIGHT$(CHR$(193,196,198,212,214,8,9,194),Z)) 6480 Tfunk=A : IF A=24 Ut$='' : Pos=1 6490 IF Pa>15 OR A=13 IF INSTR(1,CHR$(192,193,196,197,198,199,212,214,240,208,13),CHR$(A)) Z=FNKom99(9) : RETURN Ut$ 6500 IF A=8 IF Pos>1 Pos=Pos-1 ELSE IF Pa>15 Z=FNKom99(9) : RETURN Ut$ 6510 IF A=9 IF Pos15 Z=FNKom99(9) : RETURN Ut$ 6520 WHILE A=194 6530 IF Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+RIGHT$(Ut$,Pos+1) 6540 IF L{ngd0 IF Pos-L{ngd=1 Ut$=LEFT$(Ut$,L{ngd-1) : Pos=Pos-1 ELSE Pos=L{ngd+1 6550 A=0 6560 WEND 6570 IF A=132 Ins=(Ins=0) : Z=FNKom99(9-128*Ins) 6580 IF Fval=3 A=A AND 223 6590 IF A=195 AND Pos<=L{ngd Ut$=LEFT$(Ut$+' ',Pos-1)+' '+RIGHT$(Ut$,Pos) : IF LEN(Ut$)>Max Ut$=LEFT$(Ut$,Max) 6600 RESTORE 6690 6610 FOR O8=0 TO Fval : READ M1$,M2$,M3$ : NEXT O8 6620 WHILE ((A>=ASCII(M1$) AND A<=ASCII(M2$)) OR INSTR(1,M3$,CHR$(A))>0) AND Pos<=Max 6630 IF L{ngdMax Ut$=LEFT$(Ut$,Max) 6660 Pos=Pos+1 : A=0 6670 WEND 6680 WEND 6690 DATA 0,9,' ',0,9,' .-',' ',~,' ',A,],' ',J,J,JjNn,A,],A 6700 FNEND 6710 DEF FNKom99(K) 6720 IF Key99 OUT 34,K 6730 RETURN 0 6740 FNEND 6750 ! * 6760 ! 6770 ! Test om ABC806,ABC802 el ABC800 6780 ! 6790 DEF FNMtest LOCAL A 6800 A=INP(53) : OUT 53,4 6810 IF INP(53)=4 OUT 53,A : RETURN 0 6820 ON ERROR GOTO 6860 6830 PREPARE 'MEM:' AS FILE 99 6840 CLOSE 99 6850 RETURN 1 6860 RETURN 2 6870 FNEND 6880 DEF FNDump LOCAL Rad$=0,Ready 6890 Z=FNPropen(8) 6900 ; #8 6910 ; #8 6920 ; #8 6930 ; #8 6940 POKE VAROOT(Rad$),80,0,30720,SWAP%(30720),80,0 : ; #8 Rad$ 6950 ; #8 STRING$(80,61) 6960 FOR I=30880 TO 32320 STEP 80 6970 POKE VAROOT(Rad$),80,0,I,SWAP%(I),80,0 : ; #8 Rad$ 6980 NEXT I 6990 ; #8 STRING$(80,61) 7000 FOR I=32480 TO 32560 STEP 80 7010 POKE VAROOT(Rad$),80,0,I,SWAP%(I),80,0 : ; #8 Rad$ 7020 NEXT I 7030 ; #8 CHR$(12); 7040 RETURN FNClose(8) 7050 Ready=-1 7060 FNEND 7070 ! * 7080 ! 7090 ! Test om ABC99 anslutet 7100 ! 7110 DEF FNKey99 LOCAL A$=40,S$=10 7120 S$=CHR$(0,0,0,0,0,0,0) 7130 A$=CHR$(62,24,211,34,6,7,33,226,255,197,1,232,3,126,246,0) 7140 A$=A$+CHR$(32,7,11,120,177,32,246,193,201,193,35,126,18,19,43,62) 7150 A$=A$+CHR$(0,119,16,229,201) 7160 Z=CALL(VARPTR(A$),VARPTR(S$)) 7170 IF (ASCII(RIGHT$(S$,3)) AND 35)=35 RETURN -1 7180 RETURN 0 7190 FNEND 7200 Huvud$=FNF$(CYA)+'KERMIT' 7210 Mtyp=FNMtest 7220 Key99=FNKey99 7230 Z=FNKermit