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-8859-1
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
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