1 REM Ins{nd av Bernt Johansson <3384>    1986-01-14 16.33.52
1000 ! * ASCBAU  .BAC *
1010 ! * ASCII and BAUDOT communication for amateur radio.
1020 ! *
1030 ! * Ver date / VerRev / Sign / Note
1040 ! * 83-09-18 /  2.00  /  BJ  / Orig. ASCBAU for ABC80 by
1050 ! *                            Bernt Johansson. First release 1979.
1060 ! * 83-12-16 /  2.01  /  BJ  / Use of alt. CH.A. and CH.B.
1070 ! * 85-08-25 /  2.02  /  BJ  / Bug killed. TX'ed empty lines occ.
1080 ! * 85-09-17 /  2.02  /  BJ  / Auto CQ with listen pause
1090 ! * 85-11-03 /  2.03  /  BJ  / Automatic wrapping of lines from keyboard
1100 ! * 85-11-10 /  2.04  /  BJ  / Bug fix in ASCII TX
1110 ! * 85-11-12 /  2.04  /  BJ  / Log QSO on file
1120 ! * 85-11-12 /  2.04  /  BJ  / Send text from file
1130 ! *
1140 ! ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** ** **
1150 ! *
1160 INTEGER : EXTEND 
1170 ! *
1180 ! ***********************************************************************
1190 ! *
1200 ! *                    M A I N   P R O G R A M
1210 ! *
1220 ! ***********************************************************************
1230 ! *
1240 Q7=FNInit
1250 Q7=FNReceive
1260 ! *
1270 IF Fdlog$<>'' THEN Fidlog=Finlog : Q7=FNCllog ! * Close log file
1280 OUT Sioctrl,24 ! * Reset SIO to disable interrupts
1290 ! *
1300 END 
1310 ! ***********************************************************************
1320 ! *
1330 ! *          F U N C T I O N   D E C L A R A T I O N   P A R T
1340 ! *
1350 ! ***********************************************************************
1360 ! *
1370 ! * Initialization
1380 ! *
1390 DEF FNInit
1400   ! *
1410   ! * Global constants
1420   ! *
1430   False=0 : True=-1
1440   ! *
1450   DIM Nul$=1,Etx$=1,Bel$=1,Bs$=1,Ht$=1,Lf$=1,Ff$=1,Cr$=1,Esc$=1 ! * Some ASCII char's
1460   Nul$=CHR$(0) : Etx$=CHR$(3) : Bel$=CHR$(7)
1470   Bs$=CHR$(8) : Ht$=CHR$(9) : Lf$=CHR$(10) : Ff$=CHR$(12) : Cr$=CHR$(13)
1480   Esc$=CHR$(27)
1490   ! *
1500   Head$=Ff$+' ASCII - BAUDOT  Amateur radio communication  Ver. 2.04             SM5LWR '+STRING$(80,ASCII('='))
1510   ; Head$;
1520   ! *
1530   Finlog=1 ! * File number of log file
1540   Fidlog=Finlog
1550   ! >
1560   ON ERROR GOTO 3050
1570   ; CUR(8,0) SPACE$(80) CUR(8,0);
1580   INPUT 'Log file: 'Fdlog$
1590   IF Fdlog$='' THEN Fidlog=0 ELSE PREPARE Fdlog$ AS FILE Fidlog
1600   ON ERROR GOTO 
1610   ! *
1620   Finsend=2 ! * File number of file to send
1630   ! *
1640   Txbufmax=1024 ! * Max size of TX buffer
1650   DIM Tx$=Txbufmax+256 ! * Make room for text from file
1660   DIM Txbufsiz$=0 ! * String allocated inside videoRAM
1670   POKE VAROOT(Txbufsiz$),5,0,0,120
1680   ! *
1690   DIM Ab$=130 ! * ASCII -> BAUDOT convertion table
1700   Ab$=CHR$(0,31,27,0,0,0,0,43,0,0,2,0,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0) ! * 0-31
1710   Ab$=Ab$+CHR$(4,0,0,0,0,0,0,37,47,50,0,49,44,35,60,0,54,55,51,33,42,48,53,39,38,56,46,0,0,62,0,57) ! * 32-63
1720   Ab$=Ab$+CHR$(0,3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,7,30,19,29,21,17,58,52,45,0,0) ! * 64-95
1730   Ab$=Ab$+CHR$(0,3,25,14,9,1,13,26,20,6,11,15,18,28,12,24,22,23,10,5,16,7,30,19,29,21,17,58,52,45,0,0) ! * 96-127
1740   Ab$=Ab$+CHR$(31,27) ! * Let nr 128, 129 mean BAUDOT ls, fs.
1750   ! *
1760   DIM Ba$=64 ! * BAUDOT -> ASCII convertion table
1770   Ba$=Nul$+"E"+Lf$+"A SIU"+Cr$+"DRJNFCKTZLWHYPQOBG"+Nul$+"MXV"+Nul$ ! * 0-31
1780   Ba$=Ba$+Nul$+"3"+Lf$+"- '87"+Cr$+"$4"+Bel$+",]:(5+)2\6019?["+Nul$+"./="+Nul$ ! * 32-63
1790   ! *
1800   Logrec$=SPACE$(253) ! * Record buffer for log file
1810   Logrecptr=1
1820   ! *
1830   Mxtxwidnb=7
1840   DIM Txwid(Mxtxwidnb)
1850   RESTORE 1890
1860   FOR Txwidnb=0 TO Mxtxwidnb
1870     READ Txwid(Txwidnb)
1880   NEXT Txwidnb 
1890   DATA 0,21,31,39,63,64,79,80
1900   ! *
1910   Iso=1 : Isonp=2 : Baudot=3
1920   DIM Charset$(Iso:Baudot)=6
1930   DIM Datab(Iso:Baudot) ! * Number of data bits in char
1940   DIM Parity(Iso:Baudot) ! * 0 = none, 3 = even, 1 = odd
1950   DIM Hstopb(Iso:Baudot) ! * Number of half stop bits in char
1960   DIM Txini$(Iso:Baudot)=16
1970   ! *
1980   Charset$(Iso)='ASCII ' : Datab(Iso)=7 : Parity(Iso)=3 : Hstopb(Iso)=4
1990   Txini$(Iso)=CHR$(0,0,0,0,0,0,0,0)+Cr$+Lf$
2000   ! *
2010   Charset$(Isonp)='ASC NP' : Datab(Isonp)=8 : Parity(Isonp)=0 : Hstopb(Iso)=4
2020   Txini$(Isonp)=CHR$(0,0,0,0,0,0,0,0)+Cr$+Lf$
2030   ! *
2040   Charset$(Baudot)='BAUDOT' : Datab(Baudot)=5 : Parity(Baudot)=0 : Hstopb(Baudot)=3
2050   Txini$(Baudot)=CHR$(0,128,0,128,0,128,0,128)+Cr$+Lf$
2060   ! *
2070   ! *  Default parameters
2080   ! *
2090   Txwidnb=4 : Mxtcol=Txwid(Txwidnb)
2100   Charset=Iso
2110   Baudrate=6
2120   ! *
2130   ! * BASIC strings in VIDEO RAM
2140   ! *
2150   DIM Upscr0$=0
2160   POKE VAROOT(Upscr0$),64,6,0,120,64,6 ! * 1600 bytes beginning at line 0
2170   DIM Upscr1$=0
2180   POKE VAROOT(Upscr1$),64,6,80,120,64,6 ! * 1600 bytes beginning at line 1
2190   DIM Echolin$=0
2200   POKE VAROOT(Echolin$),80,0,64,126,80,0 ! * 80 bytes beginning at line 20
2210   Rxtab=0 ! * Column number
2220   ! *
2230   DIM Loscr0$=0
2240   POKE VAROOT(Loscr0$),160,0,224,126,160,0 ! * 160 bytes beginning at line 22
2250   DIM Loscr1$=0
2260   POKE VAROOT(Loscr1$),160,0,48,127,160,0 ! * 160 bytes beginning at line 23
2270   DIM Keyinline$=0
2280   POKE VAROOT(Keyinline$),80,0,128,127 ! * 80 bytes beginning at line 24
2290   Keyinline$=SPACE$(80)
2300   OUT 56,6,57,25 ! * Make line 24 visible
2310   Txtab=1 ! * Column number
2320   ! *
2330   DIM Timedisp$=0 ! * TIME$ display
2340   POKE VAROOT(Timedisp$),19,0,144+54,126 ! * Line 26, tab 54
2350   ! *
2360   DIM Txbufsiz$=0 ! * Display buffer size
2370   POKE VAROOT(Txbufsiz$),5,0,144+76,126 ! * Line 21, tab 76
2380   ! *
2390   ! * Z80 code for interrupt driven reception
2400   ! *
2410   POKE 64000,195,14,250,195,97,250,0,0,0,0,0,248,0,248,243,42
2420   POKE 64016,6,250,17,29,250,235,1,8,0,237,176,251,201,94,250,94
2430   POKE 64032,250,37,250,78,250,245,197,213,229,58,8,250,79,237,120,33
2440   POKE 64048,9,250,166,42,10,250,119,35,17,0,250,229,237,82,225,32
2450   POKE 64064,3,33,0,248,34,10,250,225,209,193,241,251,237,77,245,197
2460   POKE 64080,58,8,250,79,62,48,12,237,121,13,237,120,193,241,251,237
2470   POKE 64096,77,243,42,10,250,235,42,12,250,167,237,82,33,255,255,40
2480   POKE 64112,23,42,12,250,126,35,17,0,250,229,237,82,225,32,3,33
2490   POKE 64128,0,248,34,12,250,38,0,111,251,201
2500   ! *
2510   Setup=64000
2520   Cget=64003
2530   Vecad=64006
2540   Datach=64008
2550   Bitmsk=64009
2560   ! *
2570   ! * I/O addressing
2580   ! *
2590   Chb=False ! * Use CH.A
2600   IF Chb THEN Ctcchrx=97 ELSE Ctcchrx=98
2610   IF Chb THEN Ctcchtx=96 ELSE Ctcchtx=98
2620   ! *
2630   IF Chb THEN Siodata=64 ELSE Siodata=32
2640   Sioctrl=Siodata+1
2650   ! *
2660   IF Chb THEN Vectoradr=65480 ELSE Vectoradr=65464
2670   IF Chb THEN Vector=198 ELSE Vector=182
2680   ! *
2690   OUT Sioctrl OR 2,2,Sioctrl OR 2,Vector ! * Vector register exists in SIO Channel B only
2700   POKE Vecad,Vectoradr,SWAP%(Vectoradr),Siodata,127
2710   Q7=CALL(Setup) ! * Initialize interrupt vectors
2720   ! *
2730   DIM Ctrlchar$=7
2740   Ctrlchar$=CHR$(ASCII('A') AND 31,ASCII('F') AND 31,ASCII('K') AND 31,ASCII('R') AND 31,ASCII('S') AND 31,ASCII('T') AND 31,ASCII('[') AND 31)
2750   ! *
2760   ! *
2770   DIM C$=6
2780   C$='SM5LWR'
2790   T3$=' de '+C$+' '+Cr$+Lf$+'ar pse '+Bel$+'k'+Bel$+Cr$+Lf$
2800   Txautocq$='CQ cq CQ cq de '+C$+' CQ cq CQ cq de '+C$+' pse k k k k'+Cr$+Lf$
2810   ! *
2820   ! *
2830   ; Head$;
2840   ; 
2850   ; 'Commands:'
2860   ; 
2870   ; 'CTRL+[ (ESC) starts command mode.'
2880   ; '        <- and -> changes command field.'
2890   ; '        A, B and N changes code set when in that field.'
2900   ; '        + and - changes baudrate and TX width.'
2910   ; '        TX width >0 means automatic line wrapping on TX'
2920   ; '        RETURN makes exit from command mode.'
2930   ; 
2940   ; 'CTRL+T starts transmit mode'
2950   ; '        CTRL+A TX on CQ, TX off for 5 s until key is pressed.'
2960   ; '        CTRL+F transmits "de", call and "pse k" and exits TX mode.'
2970   ; '        CTRL+K transmits current time.'
2980   ; '        CTRL+R exits transmit mode'
2990   ; 
3000   ; 'CTRL+B forces letter shift if code set is Baudot.'
3010   ; 
3020   ; 'CTRL+Q quits all'
3030   RETURN False
3040   ! *
3050   ! >  Error when opening log file
3060   ; 'Error' ERRCODE
3070   RESUME 1550
3080   ! *
3090 FNEND 
3100 ! ***************************************
3110 ! *
3120 ! * Reception from air
3130 ! *
3140 DEF FNReceive LOCAL Key,Rxchar$=1
3150   ! >
3160   Txmod=False
3170   Q7=FNChange(True)
3180   Tx$=''
3190   Bshift=0
3200   ! *
3210   WHILE Key<>17 ! * Not ctrl Q
3220     Key=FNFlyget
3230     IF Key=20 THEN Q7=FNTransmit : GOTO 3150
3240     IF Key=27 THEN Q7=FNChange(False) : GOTO 3150
3250     IF Key=2 THEN Bshift=0
3260     ! *
3270     Q7=CALL(Cget) : IF Q7>-1 THEN Rxchar$=CHR$(Q7) : IF Charset=Baudot THEN Q7=FNBaconv(Rxchar$) ELSE Q7=FNEcho(Rxchar$)
3280   WEND 
3290   RETURN False
3300   ! *
3310 FNEND 
3320 ! ************************************
3330 ! *
3340 ! * Transmit
3350 ! *
3360 DEF FNTransmit LOCAL Key
3370   ! >
3380   Txmod=True
3390   Q7=FNChange(True)
3400   Tx$=Txini$(Charset)+Tx$
3410   ! *
3420   WHILE True
3430     IF LEN(Tx$) THEN Txchar$=LEFT$(Tx$,1) : Tx$=RIGHT$(Tx$,2) ELSE Txchar$=''
3440     IF FNCtrlcmd(Txchar$) THEN RETURN False ! * Command was: Ctrl R
3450     Key=FNFlyget
3460     WHILE FNTxbusy
3470       Key=FNFlyget ! * Poll keyboard while waiting for SIO
3480     WEND 
3490     IF FNTxcharout(Txchar$) THEN Q7=FNEcho(Txchar$)
3500     IF Key=27 THEN Q7=FNChange(False)
3510   WEND 
3520   ! *
3530 FNEND 
3540 ! ***************************************
3550 ! *
3560 ! * Set up SIO and CTC
3570 ! * Print out current parameters
3580 ! *
3590 DEF FNSetv24(Baudr,Dbits,Parity,Halfsbits,Transmit) LOCAL Baudrate$=4,Ctcr1,Ctcr2,Dbitsx,Wr1,Wr3,Wr4,Wr5
3600   IF NOT Transmit THEN WHILE FNTxbusy : WEND : Q7=FNDelay(250)
3610   ! *
3620   ON Baudr RESTORE 3920,3950,3980,4010,4040,4070,4100,4130,4160,4190,4220,4250
3630   READ Baudrate$,Ctcr1,Ctcr2,Wr4
3640   OUT Ctcchtx,Ctcr1,Ctcchtx,Ctcr2 ! * CTC TX clock
3650   OUT Ctcchrx,Ctcr1,Ctcchrx,Ctcr2 ! * CTC RX clock
3660   ! *
3670   Dbitsx=3
3680   IF Dbits=5 THEN Dbitsx=0
3690   IF Dbits=6 THEN Dbitsx=2
3700   IF Dbits=7 THEN Dbitsx=1
3710   ! *
3720   Wr3=64*Dbitsx ! * Nr of data bits RX
3730   IF Transmit=False THEN Wr3=Wr3 OR 1 ! * RX enable
3740   OUT Sioctrl,3,Sioctrl,Wr3
3750   ! *
3760   Wr4=Wr4 OR 4*(Halfsbits-1) OR Parity ! * clock mode, nr of stop bits, parity
3770   OUT Sioctrl,4,Sioctrl,Wr4
3780   ! *
3790   Wr5=128 OR 32*Dbitsx OR 8 ! * DTR, Nr of data bits TX, TX enable
3800   IF Transmit THEN Wr5=Wr5 OR 2 ! * RTS on
3810   OUT Sioctrl,5,Sioctrl,Wr5
3820   ! *
3830   Wr1=20 ! * Rx int. on every char, parity aff. vector, status aff. vector
3840   OUT Sioctrl,1,Sioctrl,Wr1
3850   ! *
3860   ; CUR(21,11) Baudrate$;
3870   ; CUR(21,18); : IF Transmit THEN ; 'T'; ELSE ; 'R';
3880   ! *
3890   RETURN False
3900   ! *
3910   ! * 45.45=3M/16/129/32
3920   DATA 45.5,7,129,128
3930   ! *
3940   ! * 50=3M/16/117/32
3950   DATA '  50',7,117,128
3960   ! *
3970   ! * 57=3M/16/103/32
3980   DATA '  57',7,103,128
3990   ! *
4000   ! * 75=3M/16/39/64
4010   DATA '  75',7,39,192
4020   ! *
4030   ! * 100=1M5/234/64
4040   DATA ' 100',71,234,192
4050   ! *
4060   ! * 110=1M5/213/64
4070   DATA ' 110',71,213,192
4080   ! *
4090   ! * 150=1M5/156/64
4100   DATA ' 150',71,156,192
4110   ! *
4120   ! * 200=1M5/117/64
4130   DATA ' 200',71,117,192
4140   ! *
4150   ! * 300=1M5/78/64
4160   DATA ' 300',71,78,192
4170   ! *
4180   ! * 600=1M5/39/64
4190   DATA ' 600',71,39,192
4200   ! *
4210   ! * 1200=1M5/39/32
4220   DATA 1200,71,39,128
4230   ! *
4240   ! * 2400=1M5/39/16
4250   DATA 2400,71,39,64
4260   ! *
4270 FNEND 
4280 ! **********************************
4290 ! *
4300 ! * Execute command from keyboard
4310 ! *
4320 DEF FNCtrlcmd(C$)
4330   IF C$='' THEN RETURN False
4340   ON INSTR(1,Ctrlchar$,C$)+1 GOTO 4350,4370,4420,4450,4510,4540,4570,4570
4350   RETURN False
4360   ! *
4370   ! >  CTRL A
4380   Txchar$=''
4390   IF FNListen THEN Tx$=Cr$+Lf$+Txautocq$+C$+Tx$ ELSE Tx$=CHR$(ASCII('R') AND 31)
4400   RETURN False
4410   ! *
4420   ! >  CTRL F
4430   Tx$=T3$+CHR$(18) : Txchar$='' : RETURN False
4440   ! *
4450   ! >  CTRL K
4460   Q$=TIME$
4470   Tx$=' Date: '+LEFT$(Q$,10)+', UT: '+MID$(Q$,12,2)+':'+MID$(Q$,15,2)+' '+Tx$
4480   Txchar$=''
4490   RETURN False
4500   ! *
4510   ! >  CTRL R
4520   Txchar$='' : RETURN True
4530   ! *
4540   ! >  CTRL S
4550   RETURN FNSendfile
4560   ! *
4570   ! >  CTRL T or ESC
4580   Txchar$='' : RETURN False
4590   ! *
4600 FNEND 
4610 ! ************************************
4620 ! *
4630 ! *  Turn off TX for 5 s.
4640 ! *  If any key pressed return is False else True
4650 ! *
4660 DEF FNListen LOCAL Brktim$=1
4670   Txmod=False : Q7=FNChange(True)
4680   Brktim$=NUM$(MOD(PEEK(65524)+5,10)) ! * 5 s future
4690   WHILE MID$(TIME$,19,1)<>Brktim$
4700     IF SYS(5) THEN GET Q$ : RETURN False
4710   WEND 
4720   Txmod=True : Q7=FNChange(True)
4730   RETURN True
4740   ! *
4750 FNEND 
4760 ! **********************************
4770 ! *
4780 ! * Flying GET from keyboard
4790 ! *
4800 DEF FNFlyget LOCAL Kbchar$=1,A
4810   IF SYS(5) THEN GET Kbchar$ ELSE Kbchar$='' : GOTO 4880
4820   IF Kbchar$=Bs$ THEN Q7=FNBslo : GOTO 4880
4830   Q7=FNAutowrap(Kbchar$)
4840   IF Kbchar$=Bel$ THEN ; Kbchar$;
4850   IF ASCII(Kbchar$)<32 THEN 4880
4860   MID$(Keyinline$,Txtab,1)=Kbchar$
4870   Txtab=Txtab+1 : IF Txtab>80 THEN Q7=FNScrolo
4880   ! >
4890   A=32639+Txtab
4900   OUT 56,14,57,SWAP%(A),56,15,57,A,56,10,57,103
4910   Txbufsiz$=NUM$(LEN(Tx$))+' ' ! * Display buffer size
4920   Timedisp$=TIME$ ! * Display time
4930   RETURN ASCII(Kbchar$)
4940   ! *
4950 FNEND 
4960 ! **********************************************
4970 ! *
4980 ! *  Automatic wrapping of lines from keyboard
4990 ! *
5000 DEF FNAutowrap(C$)
5010   IF C$=Cr$ THEN Q7=FNPuttx(Txw$+Cr$+Lf$)+FNScrolo : Tcol=0 : Txw$='' : RETURN False
5020   IF Mxtcol=0 THEN Q7=FNPuttx(C$) : RETURN False
5030   ! *
5040   Txw$=Txw$+C$
5050   IF INSTR(1,' !$%&)*+,-./:;<=>?'+Ctrlchar$,C$) THEN Q7=FNPuttx(Txw$) : Txw$=''
5060   Tcol=Tcol+1
5070   IF LEN(Txw$)>=Mxtcol THEN Q7=FNPuttx(Cr$+Lf$+Txw$) : Txw$='' : Tcol=Mxtcol
5080   IF Tcol>=Mxtcol THEN Q7=FNPuttx(Cr$+Lf$) : Tcol=LEN(Txw$)
5090   RETURN False
5100   ! *
5110 FNEND 
5120 ! ***********************************************
5130 ! *
5140 ! *  Scroll lowest screen
5150 ! *
5160 DEF FNScrolo
5170   Loscr0$=Loscr1$
5180   Keyinline$=SPACE$(80)
5190   Txtab=1
5200   RETURN False
5210   ! *
5220 FNEND 
5230 ! *********************************************
5240 ! *
5250 ! *  Do backspace on lowest screen and in TX buffer if possible
5260 ! *
5270 DEF FNBslo
5280   IF LEN(Tx$)+LEN(Txw$)=0 OR Txtab<2 THEN ; Bel$; : RETURN False
5290   IF LEN(Tx$) THEN IF RIGHT$(Tx$,LEN(Tx$))<' ' THEN ; Bel$; : RETURN False
5300   Txtab=Txtab-1 : MID$(Keyinline$,Txtab,1)=' ' ! * Erase on screen
5310   IF LEN(Txw$) THEN Txw$=LEFT$(Txw$,LEN(Txw$)-1) : RETURN True
5320   Tx$=LEFT$(Tx$,LEN(Tx$)-1) : RETURN True
5330   ! *
5340 FNEND 
5350 ! ********************************************
5360 ! *
5370 ! *  Add string to TX buffer
5380 ! *
5390 DEF FNPuttx(S$)
5400   IF LEN(Tx$)+LEN(S$)<=Txbufmax THEN Tx$=Tx$+S$ ELSE ; Bel$;
5410   RETURN False
5420   ! *
5430 FNEND 
5440 ! **********************************
5450 ! *
5460 ! * Wait for SIO
5470 ! *
5480 DEF FNTxbusy=(INP(Sioctrl) AND 4)=0 
5490 ! *
5500 ! ******************************
5510 ! *
5520 ! * Transmit one char
5530 ! * Return True if sent char is printable
5540 ! *
5550 DEF FNTxcharout(C$) LOCAL D$=1
5560   IF C$='' THEN RETURN False
5570   ! *
5580   IF Charset<>Baudot THEN OUT Siodata,ASCII(C$) : RETURN True
5590   ! *
5600   ! *  Baudot code
5610   ! *
5620   D$=FNAbconv$(C$)
5630   IF D$=Nul$ THEN RETURN False
5640   OUT Siodata,ASCII(D$)
5650   IF C$=Cr$ THEN WHILE FNTxbusy : WEND : OUT Siodata,8 ! * Send an extra CR
5660   IF C$=Lf$ THEN WHILE FNTxbusy : WEND : OUT Siodata,31 : WHILE FNTxbusy : WEND : OUT Siodata,31 : Bshift=0 ! * Send LS and shift to letters
5670   IF D$=CHR$(27) THEN Bshift=32 : RETURN False
5680   IF D$=CHR$(31) THEN Bshift=0 : RETURN False
5690   RETURN True ! * Printable char
5700   ! *
5710 FNEND 
5720 ! ***************************
5730 ! *
5740 ! * Convert ASCII -> BAUDOT
5750 ! *
5760 DEF FNAbconv$(A$) LOCAL B$=1
5770   B$=MID$(Ab$,ASCII(A$)+1,1)
5780   IF (Bshift XOR (ASCII(B$) AND 32))=0 THEN RETURN CHR$(ASCII(B$) AND 31)
5790   IF INSTR(1,CHR$(0,2,4,8,27,31),B$) THEN RETURN B$ ! * These chars are same in both shifts: NUL LF SP CR FS LS
5800   Tx$=A$+Tx$ ! * Put char back for actual tx
5810   IF Bshift THEN RETURN CHR$(31) ELSE RETURN CHR$(27)
5820   ! *
5830 FNEND 
5840 ! *********************************
5850 ! *
5860 ! * Convert BAUDOT -> ASCII and echo
5870 ! *
5880 DEF FNBaconv(C$) LOCAL C
5890   IF C$='' THEN RETURN False
5900   C=ASCII(C$) AND 31
5910   IF C=27 THEN Bshift=32
5920   IF C=31 THEN Bshift=0
5930   Q7=FNEcho(MID$(Ba$,(C OR Bshift)+1,1))
5940   RETURN False
5950   ! *
5960 FNEND 
5970 ! *********************************
5980 ! *
5990 ! *  Echo one char on upper screen half and log it on file
6000 ! *
6010 DEF FNEcho(D$) LOCAL C$=1
6020   IF Fidlog=0 THEN 6080
6030   IF D$=Lf$ THEN IF Crlast THEN Q7=FNLog(Cr$) : Crlast=False : GOTO 6080
6040   IF Crlast THEN Q7=FNLog(Esc$+Cr$) : Crlast=False
6050   IF D$=Cr$ THEN Crlast=True : GOTO 6080
6060   IF INSTR(1,Nul$+Etx$+Ht$+Esc$,D$) THEN Q7=FNLog(Esc$+D$) : GOTO 6080
6070   Q7=FNLog(D$)
6080   ! >
6090   C$=D$
6100   IF Rxtab=80 OR C$=Lf$ THEN Rxtab=0 : Upscr0$=Upscr1$ : Echolin$=SPACE$(80)
6110   IF C$=Bel$ THEN ; C$; : IF Charset=Baudot THEN C$='*'
6120   IF ASCII(C$)<32 THEN RETURN False
6130   Rxtab=Rxtab+1
6140   MID$(Echolin$,Rxtab,1)=C$
6150   RETURN False
6160   ! *
6170 FNEND 
6180 ! **************************************
6190 ! *
6200 ! *  Log on text file
6210 ! *
6220 DEF FNLog(S$)
6230   MID$(Logrec$,Logrecttr,LEN(S$))=S$
6240   Logrecptr=Logrecptr+LEN(S$)
6250   IF Logrecptr<252 THEN RETURN False
6260   ! *
6270   ! *  Time to flush buffer
6280   ! *
6290   MID$(Logrec$,Logrecptr,1)=Etx$
6300   Logrecptr=1
6310   ON ERROR GOTO 6360
6320   PUT #Fidlog,Logrec$
6330   RETURN False
6340   ! >
6350   RETURN FNCllog ! * Close log file
6360   ! >
6370   RESUME 6340
6380   ! *
6390 FNEND 
6400 ! ************************************
6410 ! *
6420 ! *  Close log file
6430 ! *
6440 DEF FNCllog
6450   IF Fidlog=0 THEN RETURN False
6460   ! *
6470   ON ERROR GOTO 6570
6480   IF Crlast THEN MID$(Logrec$,Logrecptr,1)=Cr$ : Logrecptr=Logrecptr+1
6490   IF Logrecptr<>1 THEN MID$(Logrec$,Logrecptr,1)=Etx$
6500   PUT #Fidlog,Logrec$
6510   PUT #Fidlog,STRING$(253,0)
6520   CLOSE Fidlog : Fdlog$=''
6530   RETURN False
6540   ! >
6550   RETURN True
6560   ! *
6570   ! >
6580   ; CUR(21,28) 'Err' Bel$;
6590   Fidlog=0 : Fdlog$=''
6600   RESUME 6540
6610   ! *
6620 FNEND 
6630 ! ***************************************
6640 ! *
6650 ! *  Open, read and close send file
6660 ! *
6670 DEF FNSendfile LOCAL Ptr,Fd$=16,C$=1
6680   IF Fidsend THEN 6770
6690   Ptr=INSTR(1,Tx$,Cr$+Lf$)
6700   IF Ptr=0 THEN Tx$=Txchar$+Tx$ : Txchar$='' : RETURN False ! * He must finish file name
6710   IF Ptr>16 THEN Txchar$='' : RETURN False ! * Illegal file name
6720   Fd$=LEFT$(Tx$,Ptr-1) : Tx$=RIGHT$(Tx$,Ptr+2)
6730   ON ERROR GOTO 6940
6740   OPEN Fd$ AS FILE Finsend
6750   Fidsend=Finsend
6760   ! *
6770   ! >  File is open
6780   ON ERROR GOTO 6980
6790   ! >
6800   GET #Fidsend,C$
6810   IF C$=Nul$ THEN Fidsend=0 : GOTO 6870 ! * End of file
6820   IF C$=Etx$ THEN POSIT #Fidsend,253*INT((POSIT(Fidsend)-1.)/253)+253 : GOTO 6790
6830   IF C$=Ht$ THEN GET #Fidsend,C$ : Tx$=SPACE$(ASCII(C$))+Txchar$+Tx$ : GOTO 6870
6840   IF C$=Cr$ THEN Tx$=Cr$+Lf$+Txchar$+Tx$ : GOTO 6870
6850   IF C$=Esc$ THEN GET #Fidsend,C$
6860   Tx$=C$+Txchar$+Tx$
6870   ! >
6880   Txchar$=''
6890   RETURN False
6900   ! *
6910   ! >
6920   Fidsend=0
6930   RETURN False
6940   ! >  Open error
6950   ; CUR(22,0) Bel$ 'Can''t open "' Fd$ '". Error' ERRCODE '        ';
6960   RESUME 6910
6970   ! *
6980   ! >  Read error
6990   ; CUR(22,0) Bel$ 'Can''t read "' Fd$ '". Error' ERRCODE '        ';
7000   RESUME 6910
7010   ! *
7020 FNEND 
7030 ! ********************************
7040 ! *
7050 ! * Parameter change function
7060 ! *
7070 DEF FNChange(Nochange) LOCAL Mxcmdnb
7080   Mxcmdnb=4
7090   ; CUR(21,0) ' ';
7100   ; Charset$(Charset) '         X          ';
7110   ; CUR(21,73) '  ';
7120   Q7=FNSetv24(Baudrate,Datab(Charset),Parity(Charset),Hstopb(Charset),Txmod)
7130   ; CUR(21,22) Mxtcol;
7140   ; CUR(21,28); : IF Fidlog THEN ; 'Log'; ELSE ; '   ';
7150   IF Nochange THEN RETURN False
7160   ! >
7170   ON Cmdnb+1 GOTO 7180,7270,7350,7440
7180   ! >
7190   WHILE True
7200     ; CUR(21,2) Charset$(Charset) CUR(21,2);
7210     GET Q$
7220     ON INSTR(1,Bs$+Ht$+Cr$,Q$)+1 GOTO 7230,7530,7570,7610
7230     IF Q$='a' OR Q$='A' THEN Charset=Iso
7240     IF Q$='n' OR Q$='N' THEN Charset=Isonp
7250     IF Q$='b' OR Q$='B' THEN Charset=Baudot
7260   WEND 
7270   ! >
7280   WHILE True
7290     Q7=FNSetv24(Baudrate,Datab(Charset),Parity(Charset),Hstopb(Charset),Txmod)
7300     ; CUR(21,10); : GET Q$
7310     ON INSTR(1,Bs$+Ht$+Cr$,Q$)+1 GOTO 7320,7530,7570,7610
7320     IF Q$='+' THEN Baudrate=Baudrate+1 : IF Baudrate>12 THEN Baudrate=12
7330     IF Q$='-' THEN Baudrate=Baudrate-1 : IF Baudrate<1 THEN Baudrate=1
7340   WEND 
7350   ! >
7360   WHILE True
7370     ; CUR(21,22) Mxtcol;
7380     ; CUR(21,22); : GET Q$
7390     ON INSTR(1,Bs$+Ht$+Cr$,Q$)+1 GOTO 7400,7530,7570,7610
7400     IF Q$='+' THEN Txwidnb=Txwidnb+1 : IF Txwidnb>Mxtxwidnb THEN Txwidnb=Mxtxwidnb
7410     IF Q$='-' THEN Txwidnb=Txwidnb-1 : IF Txwidnb<0 THEN Txwidnb=0
7420     Mxtcol=Txwid(Txwidnb)
7430   WEND 
7440   ! >
7450   WHILE True
7460     ; CUR(21,28); : IF Fidlog THEN ; 'Log'; ELSE ; '   ';
7470     GET Q$
7480     ON INSTR(1,Bs$+Ht$+Cr$,Q$)+1 GOTO 7490,7530,7570,7610
7490     IF Q$='+' THEN IF Fdlog$<>'' THEN Fidlog=Finlog
7500     IF Q$='-' THEN Fidlog=0
7510   WEND 
7520   ! *
7530   ! > BS
7540   IF Cmdnb>0 THEN Cmdnb=Cmdnb-1
7550   GOTO 7160
7560   ! *
7570   ! > HT
7580   IF Cmdnb<Mxcmdnb THEN Cmdnb=Cmdnb+1
7590   GOTO 7160
7600   ! *
7610   ! >
7620   Q7=FNSetv24(Baudrate,Datab(Charset),Parity(Charset),Hstopb(Charset),Txmod)
7630   RETURN False
7640   ! *
7650 FNEND 
7660 ! *****************************************
7670 ! *
7680 ! * Time delay function
7690 ! *
7700 DEF FNDelay(Ms) LOCAL Lms
7710   Lms=1.001*Ms-3 ! * Function call takes 3ms.
7720   WHILE Lms
7730     Lms=Lms-1
7740   WEND 
7750   RETURN False
7760   ! *
7770 FNEND