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