100 ! ------------------------------------------------!
110 ! *         K E R M I T . 8 0 0                   !
120 ! *         ===================                   !
130 ! * BASIC-II Version for ABC-80x ABC-klubben      !
140 ! * Torbj|rn Alm, ABC-116     83-11-17  V2.0      !
150 ! * Per Lindberg QZ, ABC-816  83-11-24  V2.1      !
151 ! *                           84-05-08  V2.2      !
160 ! * Version for ABC-800 follows UNIX-version in   !
170 ! * KERMIT Protocol Manual closely exept for user !
180 ! * interaction, which uses a more interactive    !
190 ! * Dialogue and for connect.                     !
200 ! * Packet size is limited to 78 chars due to     !
210 ! * Receive interrupt buffer in the system        !
220 ! * Debug printout on pr: device                  !
230 ! *                                               !
240 ! * Basic dialect similar to Microsoft Basic      !
250 ! * All variables are integers exept for strings  !
260 ! ------------------------------------------------!
270 INTEGER : EXTEND 
280 Maxpack=78 : Soh=1 : Brkchr=192 : Maxtry=5 : Myquote=ASCII('#') : Mypad=0 : Mypchar=0 : Myeol=13 : Mytime=5
290 Maxtim=20 : Mintim=2 : True=-1 : False=0 : Fd=4 : Remfd=1 : Sp=32 : Del=127 : Brf=7 : Ctrc=193 : Eol=13
300 DIM Recpkt$=80,Packet$=80,Inbuff$=160,Q$=100,Sp$=25,Version$=12
310 Sp$=SPACE$(25)
320 Version$="Version 2.2"
330 OPEN 'v24:vsa24b30.'+CHR$(Brf+48,Brf+48,65) AS FILE Remfd
340 WHILE True : ON FNHead GOTO 350,370,420,490,510,570
350   H=FNConnect : GOTO 330 ! Dumb terminal until PF1
360   ! -----  Receive files from remote ------------
370   IF FNRecsw ; CUR(15,0) 'OK ' Sp$ ELSE ; CUR(15,0) 'Received failed ' Sp$
380   IF Debug IF FNRecsw ; #17 'OK ' Sp$ ELSE ; #17 'Received failed ' Sp$
390   ; "<Push any key to continue>"; : GET A$
400   GOTO 590
410   ! -----  Send file to remote ------------------
420   Nfiles=FNFiles(0) : IF Nfiles<=0 THEN 590
430   Ifile=1
440   Filnam$=File$(Ifile)
450   IF FNSendsw ; CUR(15,0) 'OK' Sp$; ELSE ; CUR(15,0) ' Send failed' Sp$
460   ; "<Push any key to continue>"; : GET A$
470   GOTO 590
480   ! -----  Set Baud rate ------------------------
490   INPUT 'Baud rate: ';Baud : Brf=FNBaud(Baud) : IF Brf THEN 330 ELSE GOTO 590
500   ! -----  Set debug mode on/off each time ------
510   IF Debug Debug=False : CLOSE 17 ELSE Debug=True : OPEN 'pr:' AS FILE 17
520   IF Debug ; CUR(12,0) 'D e b u g  m o d e' ELSE ; CUR(12,0) 'N o t  d e b u g   m o d e';
530   IF Debug ; #17 'D e b u g  m o d e'
540   H=FNDelay
550   GOTO 590
560   ! ------ End of KERMIT Session ----------------
570   ; CUR(15,20) 'E N D   o f  K E R M I T   s e s s i o n'
580   STOP 
590 WEND 
600 STOP 
610 ! ---------------------------------------------
620 ! *   Kermit subroutines, standard from UNIX
630 ! ---------------------------------------------
640 ! * FNSpar$ = spar(data)
650 ! send my parameters to other end
660 ! ---------------------------------------------
670 DEF FNSpar$=CHR$(Maxpack+32,Mytime+32,Mypad+32,Mypchar XOR 64,Myeol+32,Myquote) 
680 ! ----------------------------------------------
690 ! * FNRpar = rpar
700 ! * Unpack data from other end
710 ! ----------------------------------------------
720 DEF FNRpar(S$) LOCAL Pp,Ss$=6
730   Spsiz=ASCII(S$)-32 : Timint=ASCII(MID$(S$,2,1))-32
740   Pad=ASCII(MID$(S$,3,1))-32 : Padchar=ASCII(MID$(S$,4,1)) : Padchar=Padchar XOR 64
750   Eol=ASCII(MID$(S$,5,1))-32 : Quote=ASCII(MID$(S$,6,1))
760   RETURN 0
770 FNEND 
780 ! ----------------------------------------------
790 ! * FNBufemp(buf,fd,len) 
800 ! * unpack a packet to file
810 ! * Buf    Packet buffer pointer, VARPTR(BUF$)
820 ! * fd     file number
830 ! * lgd    Packet length (redundant, only for compatibility)
840 ! ______________________________________________
850 DEF FNBufemp(Buf,Fd,Lgd) LOCAL I,T,Pp
860   I=1 : Pp=Buf
870   WHILE I<=Lgd : T=PEEK(Pp) : IF T=Myquote GOSUB 900 ELSE ; #Fd CHR$(T); : Krad=Krad+1
880   I=I+1 : Pp=Pp+1 : WEND 
890   RETURN Lgd
900   ! Unquote function
910   I=I+1 : Pp=Pp+1 : T=PEEK(Pp)
920   IF T=Myquote ; #Fd CHR$(T); : Krad=Krad+1 : RETURN ! ## = #
930   T=T XOR 64 : IF T=Myeol Krad=0 ! End-of-line
940   IF T=9 ; #Fd SPACE$(8*((Krad+8)/8)-Krad); : Krad=8*((Krad+8)/8) : RETURN ! HT
950   ; #Fd CHR$(T); : RETURN 
960 FNEND 
970 ! -------------------------------------------------
980 ! * BUF$= Fnbufill$
990 ! * Fill buffer, return size
1000 ! --------------------------------------------------
1010 DEF FNBufill$ LOCAL B$=90,I,T
1020   B$=''
1030   WHILE True
1040     IF LEN(Inbuff$)=0 ON ERROR GOTO 1090 : INPUT LINE #2,Inbuff$
1050     T=ASCII(Inbuff$) AND 127
1060     IF T<Sp OR T=Myquote OR T=Del IF LEN(B$)>Spsiz-9 RETURN B$ ELSE B$=B$+FNQ$(T) ELSE B$=B$+CHR$(T)
1070     Inbuff$=RIGHT$(Inbuff$,2) : IF LEN(B$)>=Spsiz-8 RETURN B$
1080   WEND 
1090   RESUME 1100
1100   RETURN B$
1110 FNEND 
1120 ! ---------------------------------------------------
1130 ! * FNSpack(type,num,length,data$)
1140 ! * Send packet to other end - call by name!
1150 ! ---------------------------------------------------
1160 DEF FNSpack(Type,Num,Length,Data$) LOCAL Chksum,Buffer$=90,I
1170   Buffer$=STRING$(Padchar,Pad)+CHR$(Soh,Length+35,Num+32,Type)+Data$
1180   Chksum=Length+Num+Type+67
1190   I=1 : WHILE I<=Length : Chksum=Chksum+ASCII(MID$(Data$,I,1)) : I=I+1 : WEND 
1200   Chksum=(Chksum+(Chksum AND 192)/64) AND 63
1210   Buffer$=Buffer$+CHR$(Chksum+32,Eol,10)
1220   ; #Remfd Buffer$; : ; CUR(15,0) 'Send packet ';N ' ' CHR$(Type) '  ' Numtry '   ';
1230   IF Debug ; #17 'Send packet ';N ' ' CHR$(Type) '  ' Numtry
1240   IF Debug ; #17 Buffer$
1250   RETURN LEN(Buffer$)
1260 FNEND 
1270 ! -----------------------------------------------------
1280 ! * FNRpack(&len,&num,&data$) - return type
1290 ! * Receive packet - store into data$ update varoot
1300 ! * Store len, num via pointers, return type
1310 ! -----------------------------------------------------
1320 DEF FNRpack(Length,Num,Datax) LOCAL T,Chksum,L,Pdata,Done,Type
1330   ! RETURN FNQrpack(Length,Num,Datax)
1340   IF Timint>Maxtim OR Timint<Mintim THEN Timint=Mytime
1350   T=0 : WHILE T<>Soh : T=FNGetch : IF T<0 RETURN False
1360   WEND : Done=False
1370   WHILE Done=False
1380     T=FNGetch : IF T<0 RETURN False ELSE IF T=Soh GOTO 1460
1390     Chksum=T : L=T-35 : POKE Length,L,SWAP%(L) : T=FNGetch : IF T<0 RETURN False ELSE IF T=Soh GOTO 1460
1400     Chksum=Chksum+T : POKE Num,T-32,0 : T=FNGetch : IF T<0 RETURN False ELSE IF T=Soh GOTO 1460
1410     Chksum=Chksum+T : Type=T : Pp=PEEK2(Datax+2) : POKE Datax+4,0,0 ! VAROOT=maxsiz,pointer,len
1420     I=0 : WHILE I<L : T=FNGetch : IF T<0 RETURN False ELSE IF T=Soh GOTO 1460
1430     Chksum=Chksum+T : POKE Pp,T : Pp=Pp+1 : I=I+1 : WEND 
1440     T=FNGetch : IF T<0 RETURN False ELSE IF T=Soh GOTO 1460
1450     Done=True
1460   WEND 
1470   Chksum=(Chksum+(Chksum AND 192)/64) AND 63
1480   IF Chksum<>T-32 RETURN False
1490   ; CUR(15,40) ' Receive packet ' PEEK2(Num) ' ' N ' ' CHR$(Type) '   ' L '  ';
1500   IF Debug ; #17 ' Receive packet ' PEEK2(Num) ' ' N ' ' CHR$(Type) ' Len=' L
1510   POKE Datax+4,L,0 : IF NOT Debug RETURN Type
1520   POKE VAROOT(Q$)+2,PEEK(Datax+2),PEEK(Datax+3),PEEK(Datax+4),PEEK(Datax+5)
1530   ; #17 CHR$(L+35,PEEK(Num)+32)+Q$+CHR$(T+32)
1540   RETURN Type
1550 FNEND 
1560 ! ---------------------------------------------------
1570 ! * FNSendsw       Send supervisor
1580 ! ---------------------------------------------------
1590 DEF FNSendsw
1600   State=ASCII('S') : N=0 : Numtry=0 : WHILE True
1610     ON INSTR(1,'DFZSBCA',CHR$(State))+1 GOTO 1620,1630,1640,1650,1660,1670,1680,1690
1620     RETURN False ! unknown state - fail
1630     State=FNSdata : GOTO 1700 ! Data-Send state
1640     State=FNSfile : GOTO 1700 ! File-Send state
1650     State=FNSeof : GOTO 1700 ! End-of-file
1660     State=FNSinit : GOTO 1700 ! Send-Init
1670     State=FNSbreak : GOTO 1700 ! Break-Send
1680     RETURN True ! Complete
1690     RETURN False ! Abort
1700   WEND 
1710 FNEND 
1720 ! --------------------------------------------
1730 ! fnsinit  -  Send initiate
1740 ! Send my parameters, get other side's back
1750 ! --------------------------------------------
1760 DEF FNSinit LOCAL Num,Length,Type
1770   IF Debug ; CUR(14,0) 'Sinit                 '
1780   IF Numtry>Maxtry RETURN ASCII('A') ! Too many retries, give up
1790   Numtry=Numtry+1
1800   Packet$=FNSpar$
1810   IF Debug ; #17 'Packet #' N
1820   H=FNSpack(ASCII('S'),N,6,Packet$) ! Send an S-packet
1830   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) ! What was the reply?
1840   IF Type=ASCII('N') RETURN State ! NAK
1850   IF Type=0 RETURN State ! Receive failure, stay in S
1860   IF Type<>ASCII('Y') RETURN ASCII('A') ! Somethin bad - abort
1870   ! Type = 'Y'
1880   IF N<>Num RETURN State ! Wrong ACK stay S
1890   H=FNRpar(Recpkt$) ! Get other side's info
1900   IF Eol=0 Eol=13 ! Check and set defaults
1910   IF Quote=0 Quote=ASCII('#') ! Control prefix quote
1920   Numtry=0 : N=(N+1) AND 63 : IF Debug ; #17 'Opening ' Filnam$ ! Open file to be sent
1930   OPEN Filnam$ AS FILE 2 : Host=False : ; CUR(14,0) 'Sending  ' Filnam$ '      ';
1940   RETURN ASCII('F') ! Switch state to F
1950 FNEND 
1960 ! -----------------------------------------
1970 ! FNSfile     -       Send file header
1980 ! -----------------------------------------
1990 DEF FNSfile LOCAL Num,Length,H,Type
2000   IF Debug ; #17 ' Sfile'
2010   IF Numtry>Maxtry RETURN ASCII('A') ! Too many retries, give up
2020   Numtry=Numtry+1
2030   Length=LEN(Filnam$) : H=FNSpack(ASCII('F'),N,Length,Filnam$) ! Send an F Packet
2040   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) ! What was the reply?
2050   ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 GOTO 2110,2060,2070,2100
2060   Num=((Num-1) AND 63) : IF N<>Num RETURN State ! NAK Stay in state
2070   IF N<>Num RETURN State ! Wrong ACK - stay in F state
2080   Numtry=0 : N=(N+1) AND 63 : Packet$=FNBufill$ : Size=LEN(Packet$)
2090   RETURN ASCII('D') ! Switch state to D
2100   RETURN State ! Receive failure - stay in F
2110   RETURN ASCII('A') ! Something else, just abort
2120 FNEND 
2130 ! -----------------------------------------
2140 ! FNSData  -  Send Data File
2150 ! -----------------------------------------
2160 DEF FNSdata LOCAL Num,Length,H
2170   IF Numtry>Maxtry RETURN ASCII('A') ! Too many tries - give up
2180   Numtry=Numtry+1
2190   H=FNSpack(ASCII('D'),N,Size,Packet$) ! send a D packet
2200   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) ! What was the reply?
2210   ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 GOTO 2280,2220,2230,2270
2220   Num=((Num-1) AND 63) : IF N<>Num RETURN State ! unless NAK for next packet
2230   IF N<>Num RETURN State
2240   Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : Pktnum=Pktnum+1 ! Bump packet count
2250   Packet$=FNBufill$ : Size=LEN(Packet$) : IF Size=0 RETURN ASCII('Z') ! EOF
2260   RETURN ASCII('D') ! Good data, stay in D
2270   RETURN State ! Receive failure
2280   RETURN ASCII('A') ! Unknown reply, Abort
2290 FNEND 
2300 ! -----------------------------------------
2310 ! FNSeof  -  Send End-of-file
2320 ! -----------------------------------------
2330 DEF FNSeof LOCAL Num,Length,H
2340   IF Debug ; #17 'Seof'
2350   IF Numtry>Maxtry RETURN ASCII('A') ! Too many tries - give up
2360   Numtry=Numtry+1
2370   H=FNSpack(ASCII('Z'),N,0,'') ! send a Z packet
2380   IF Debug ; #17 'Seof1   '
2390   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) ! Check reply
2400   ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 GOTO 2520,2410,2420,2510
2410   Num=((Num-1) AND 63) : IF N<>Num RETURN State ! NAK, stay in state
2420   IF Debug ; #17 'Seof2'
2430   IF N<>Num RETURN State ! If wrong ACK, hold out
2440   Numtry=0 : N=(N+1) AND 63 ! reset try-counter and bump counter
2450   IF Debug ; #17 'Closing ' Filnam$
2460   CLOSE 2 : IF Debug ; #17 'OK, Getting next file'
2470   Ifile=Ifile+1 : IF Ifile>Nfiles RETURN ASCII('B') ! EOT - all done
2480   Filnam$=File$(Ifile) : IF Debug ; #17 'New file is ' Filnam$
2490   OPEN Filnam$ AS FILE 2
2500   RETURN ASCII('F') ! More files, switch to F
2510   RETURN State ! Receive failure, stay in state Z
2520   RETURN ASCII('A') ! Something else, Abort
2530 FNEND 
2540 ! ------------------------------------------
2550 ! FNSbreak -  Send Break (EOT)
2560 ! ------------------------------------------
2570 DEF FNSbreak LOCAL Num,Length,H,Type
2580   IF Debug ; #17 'Sbreak'
2590   IF Numtry>Maxtry RETURN ASCII('A')
2600   Numtry=Numtry+1
2610   H=FNSpack(ASCII('B'),N,0,'') ! send a B packet
2620   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
2630   ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 GOTO 2680,2640,2650,2670
2640   Num=((Num-1) AND 63) : IF N<>Num RETURN State
2650   IF N<>Num RETURN State ! If wrong ACK, fail
2660   Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('C') ! Switch State to Complete
2670   RETURN State
2680   RETURN ASCII('A')
2690 FNEND 
2700 ! --------------------------------------------
2710 ! FNRecsw  -  State table switcher for receive files
2720 ! --------------------------------------------
2730 DEF FNRecsw
2740   Nfiles=FNFiles(1) : File=0 ! Assign local file names if necessary
2750   State=ASCII('R') : N=0 : Numtry=0 : WHILE True
2760     ON INSTR(1,'DFRCA',CHR$(State)) GOTO 2770,2780,2790,2800,2810
2770     State=FNRdata : GOTO 2820 ! Data Receive State
2780     State=FNRfile : GOTO 2820 ! File Receive State
2790     State=FNRinit : GOTO 2820 ! Send initiate State
2800     RETURN True ! Complete state
2810     RETURN False ! Abort State
2820   WEND 
2830 FNEND 
2840 ! ----------------------------------------------
2850 ! FNRinit  -  Receive Initialization
2860 ! ----------------------------------------------
2870 DEF FNRinit LOCAL Num,Length,Type
2880   IF Numtry>Maxtry RETURN ASCII('A') ! Too many tries - abort
2890   Numtry=Numtry+1
2900   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
2910   IF Type=False RETURN State ! Did not get a packet, keep waiting
2920   IF Type<>ASCII('S') RETURN ASCII('A') ! Some unexpected packet - abort
2930   H=FNRpar(Packet$) : Packet$=FNSpar$
2940   H=FNSpack(ASCII('Y'),N,6,Packet$) : Oldtry=Numtry
2950   Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('F')
2960 FNEND 
2970 ! -----------------------------------------------
2980 ! FNRfile  -  Receive File Header
2990 ! -----------------------------------------------
3000 DEF FNRfile LOCAL Lengh,Num,Type,H,Filename$=20
3010   IF Numtry>Maxtry RETURN ASCII('A') ! Too many tries, abort
3020   Numtry=Numtry+1
3030   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
3040   ON INSTR(1,'SZFB'+CHR$(0),CHR$(Type))+1 GOTO 3050,3060,3110,3140,3230,3260
3050   RETURN ASCII('A') ! Default  -  Abort , unknown packet
3060   Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A') ! Too many tries - abort
3070   IF Num<>((N-1) AND 63) RETURN ASCII('A') ! Not previous packet, abort
3080   Packet$=FNSpar$ : H=FNSpack(ASCII('Y'),Num,6,Packet$)
3090   Numtry=0 : RETURN State
3100   ! Case Z - End-of-file
3110   Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
3120   IF Num<>((N-1) AND 63) RETURN ASCII('A') ! Not previous packet, abort
3130   H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State
3140   ! Case F  -  File headre
3150   File=File+1 ! Another file to receive
3160   IF Num<>N RETURN ('A') ! Wrong sequence-right block type
3170   IF FNGetfil(Packet$)=False ; CUR(15,0) 'Could not create' Packet$ : RETURN ('A')
3180   IF File<=Nfiles THEN Filename$=File$(File) ELSE Filename$=Packet$
3190   IF Host=False ; CUR(14,0) ' Receiving ' Filename$ '       ';
3200   IF Debug ; #17 ' Receiving ' Filename$
3210   H=FNSpack(ASCII('Y'),N,0,'') ! Acknowledge file header
3220   Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D') ! Switch to Data State
3230   ! Case B  -  End-of-Trashmission
3240   IF Num<>N RETURN ('A') ! Need right packet number here
3250   H=FNSpack(ASCII('Y'),N,0,'') : RETURN ASCII('C') ! Goto Complete State
3260   RETURN State ! Case FALSE
3270 FNEND 
3280 ! -----------------------------------------------
3290 ! FNRdata  -  Receive Data
3300 ! -----------------------------------------------
3310 DEF FNRdata LOCAL Num,Length,H,Type
3320   IF Numtry>Maxtry RETURN ASCII('A') ! Too many tries - abort
3330   Numtry=Numtry+1
3340   Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
3350   IF Debug ; #17 ' Rx: ' Length Num Packet$
3360   ON INSTR(1,'DFZ'+CHR$(0),CHR$(Type))+1 GOTO 3370,3380,3430,3460,3490
3370   RETURN ASCII('A') ! Default - some other packet, abort
3380   IF Num=N GOTO 3400 ELSE Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ('A')
3390   IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,6,Packet$) : Numtry=0 : RETURN State ELSE RETURN ASCII('A')
3400   H=FNBufemp(VARPTR(Packet$),Fd,LEN(Packet$)) : H=FNSpack(ASCII('Y'),N,0,'')
3410   Oldtry=Numtry : Numtry=0 : N=(N+1) AND 63 : RETURN ASCII('D')
3420   ! Case F  - File header
3430   Oldtry=Oldtry+1 : IF Oldtry>Maxtry RETURN ASCII('A')
3440   IF Num=((N-1) AND 63) H=FNSpack(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State ELSE RETURN ASCII('A')
3450   ! Case Z - End-of-file
3460   IF Num<>N RETURN ASCII('A')
3470   H=FNSpack(ASCII('Y'),N,0,'') : CLOSE Fd : N=(N+1) AND 63 : RETURN ASCII('F')
3480   H=FNSpack(ASCII('N'),N,0,'') ! Nacka N{sta
3490   RETURN State
3500 FNEND 
3510 ! -------------------------------------------------
3520 ! FNConnect  -  Establish virtual terminal to remote host
3530 ! -------------------------------------------------
3540 DEF FNConnect LOCAL Dummy$=1
3550   IF Host ; CUR(15,0) 'Kermit: nothing to connect in Host mode ' CHR$(7,7,7) : RETURN 
3560   ; CUR(15,0) 'Kermit: connected - terminal mode with host - Push PF1 to exit'
3570   ON ERROR GOTO 3600
3580   OPEN 'V24:TSA30B24.'+CHR$(Brf+48,Brf+48,65) AS FILE 1 : GET #1,A$
3590   RETURN 0
3600   RESUME 3610
3610   ON ERROR GOTO : ; 'Kermit: disconnected' : H=FNDelay : RETURN 0
3620 FNEND 
3630 ! -------------------------------------------------
3640 ! FNInchr$ - get char from remote line
3650 ! -------------------------------------------------
3660 DEF FNInchr$ LOCAL Dummy$=1
3670   GET #Remfd Dummy$ : RETURN CHR$(ASCII(Dummy$) AND 127) ! strip parity bit
3680 FNEND 
3690 ! ----------------------------------------------------
3700 ! FNBaud%(B%) - set up baud rate
3710 ! Input : Baud rate
3720 ! Output: Port setting
3730 ! ----------------------------------------------------
3740 DEF FNBaud(B) LOCAL I,Nb,K
3750   I=1 : RESTORE 3760 : READ Nb
3760   DATA 8,110,300,600,1200,2400,4800,9600,19200
3770   WHILE I<=Nb : READ K : IF B=K RETURN I
3780     I=I+1
3790   WEND 
3800   ; CUR(13,0) '**** Bad Baud rate =' B ' Not permitted  ****' CHR$(7,7,7) : RETURN 0
3810 FNEND 
3820 ! --------------------------------------------
3830 ! FNFiles - input file names - check files
3840 ! --------------------------------------------
3850 DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,I
3860   Nfile=0 : ; CUR(12,0) 'Specify File names                  '
3870   ; SPACE$(162) CUR(13,0); : INPUT LINE Aa$ : Aa$=LEFT$(Aa$,LEN(Aa$)-2) : IF LEN(Aa$)=0 RETURN 0
3880   Nfile=Nfile+1
3890   K=INSTR(1,Aa$,',')
3900   IF K File$(Nfile)=LEFT$(Aa$,K-1) : Aa$=RIGHT$(Aa$,K+1) : GOTO 3880
3910   File$(Nfile)=Aa$
3920   IF Rsw RETURN Nfile ! Receive mode, no file name check
3930   ON ERROR GOTO 3960
3940   I=1 : WHILE I<=Nfile : OPEN File$(I) AS FILE 2 : CLOSE 2 : I=I+1 : WEND 
3950   ON ERROR GOTO : RETURN Nfile
3960   RESUME 3970
3970   ; CUR(14,0) 'File ' File$(I) '  does not exist - abort !!!!!!' : GET A$ : ON ERROR GOTO : RETURN -1
3980 FNEND 
3990 ! --------------------------------------------
4000 ! FNGetch - Get line char one by one
4010 ! Basic BASIC - version, for level 1.0
4020 ! --------------------------------------------
4030 DEF FNGetch LOCAL Sec,I,Dummy$=1
4040   Sec=PEEK(65524)+Timint+1 : IF Sec>59 Sec=Sec-60
4050   IF PEEK2(PEEK2(65500)+6) RETURN ASCII(FNInchr$)
4060   IF Sec=PEEK(65524) RETURN -1 ELSE 4050
4070 FNEND 
4080 ! ---------------------------------------------
4090 ! FNHead  -  Print Meny - input command
4100 ! ---------------------------------------------
4110 DEF FNHead LOCAL F,F$=1,Baud
4120   RESTORE 3760 : READ Baud
4130   IF Brf THEN FOR I=1 TO Brf : READ Baud : NEXT I ELSE Baud=0
4140   ON ERROR GOTO 4270
4150   ; CHR$(12) '    K E R M I T   f o r   A B C 8 0 0';SPACE$(20);Version$
4160   ; 
4170   ; 
4180   ; 
4190   ; 'c   Connect to host computer'
4200   ; 'r   Receive files from host'
4210   ; 's   Send files to host'
4220   ; 'b   Specify Baud Rate (now';Baud;'baud)'
4230   ; 'd   Turn on debug mode'
4240   ; 'e   Exit Kermit' : ; 
4250   ; CUR(11,0) 'Specify function: ' CHR$(8,7); : GET F$ : ; F$
4260   F=(INSTR(1,'CcRrSsBbDdEe',F$)+1)/2 : IF F ON ERROR GOTO : RETURN F ELSE 4250
4270   RESUME 
4280 FNEND 
4290 ! -------------------------------------------
4300 ! FNGetfil(A$)  -  Create new file
4310 ! -------------------------------------------
4320 DEF FNGetfil(Aa$) LOCAL A$=30
4330   A$=Aa$ : IF File<=Nfiles A$=File$(File)
4340   ON ERROR GOTO 4360 : PREPARE A$ AS FILE Fd : Krad=0 : RETURN True
4350   ! sorry pal - bad name
4360   RESUME 4370
4370   ON ERROR GOTO : ; CUR(14,0) 'File ' A$ ' Illegal file name'; : RETURN False
4380 FNEND 
4390 ! ---------------------------------
4400 ! FNQ$(T)  -  Quote a char
4410 ! ---------------------------------
4420 DEF FNQ$(T)
4430   IF T=Myquote RETURN CHR$(Myquote,Myquote) ! # is sent as ##
4440   RETURN CHR$(Myquote,T XOR 64) ! <32 or DEL toggle control bit
4450 FNEND 
4460 ! ----------------------------------------------------
4470 ! FNQrpack(&len,&num,&data$) - Emulate Rpack from keyboard
4480 ! ----------------------------------------------------
4490 DEF FNQrpack(Length,Num,Datax) LOCAL Typ,Pp,Ll,Nn,Dd$=90,Typ$=1
4500   ; CUR(22,0) SPACE$(79) CUR(22,0) 'Typ,num,text: '; : INPUT Typ$,Nn,Dd$
4510   Typ=ASCII(Typ$) : Ll=LEN(Dd$) : POKE Length,Ll,SWAP%(Ll) : POKE Num,Nn,SWAP%(Nn)
4520   Pp=PEEK2(Datax+2) : POKE Datax+4,Ll,SWAP%(Ll)
4530   I=1 : WHILE I<=Ll : POKE Pp,ASCII(MID$(Dd$,I,1))
4540   I=I+1 : Pp=Pp+1 : WEND 
4550   ; CUR(15,40) ' Receive packet ' N ' ' CHR$(Typ) Sp$;
4560   IF Debug ; #17 ' Receive packet ' PEEK2(Num) ' ' N ' ' CHR$(Typ)
4570   RETURN Typ
4580 FNEND 
4590 ! ----------------------------------------
4600 ! FNDelay  delay 2 seconds
4610 ! ----------------------------------------
4620 DEF FNDelay LOCAL X.
4630   X.=1. : WHILE X.<1500. : X.=X.+1. : WEND 
4640   RETURN 0
4650 FNEND