'============================================================================================================
' Baudot code test program
'============================================================================================================
#COMPILE EXE "Baudot.exe"
#COMPILER PBCC 5
#DIM ALL
FUNCTION PBMAIN () AS LONG
LOCAL lRet,lCnt,lCh,lKey,lShift,lOldShift,InitDone AS LONG, lStr, Shifted, NotShifted, Shiftless AS STRING
'..........................................................................................................
COMM OPEN "COM1" AS #1 'Serial port opening and settings
IF ERR THEN PRINT "Can't open COM port, terminating. (error: " & FORMAT$(ERR) & ")" : SLEEP 2000 : EXIT FUNCTION
COMM SET #1, BAUD = 50
COMM SET #1, BYTE = 5
COMM SET #1, STOP = 1
COMM SET #1, PARITY = 0
COMM SET #1, TXBUFFER = 2048
'..........................................................................................................
NotShifted = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Shifted = "1234567890,.):=+?'\-(@" & CHR$(7,9)
Shiftless = CHR$(10,13,32)
'..........................................................................................................
WHILE lStr <> CHR$(27) 'Wait key
IF InitDone = 0 THEN
COLOR 15,0 : PRINT STRING$(80,"-") 'Print hdr
PRINT " Baudot test V1.06 at 50 Baud, 1 start, 1.5 stop, no parity. Press <"; : COLOR 12,0
PRINT "Esc";: COLOR 15,0 : PRINT "> to end."
PRINT " Type any text you want (only Baudot characters allowed)"
PRINT " (<" ;: COLOR 12,0 : PRINT "@" ;: COLOR 15,0 : PRINT "> = BELL, ";
PRINT "<" ;: COLOR 12,0 : PRINT "Tab";: COLOR 15,0 : PRINT "> = WHO ARE YOU, ";
PRINT "<" ;: COLOR 12,0 : PRINT "Down Arrow";: COLOR 15,0 : PRINT "> = LF, ";
PRINT "<" ;: COLOR 12,0 : PRINT "Del";: COLOR 15,0 : PRINT "> = Clr Screen)"
PRINT STRING$(80,"-")
InitDone = 1
END IF
'........................................................................................................
lStr = INKEY$
IF lStr = CHR$(0,80) THEN
lStr = CHR$(10) :COLOR 12,0 : PRINT "[LF]" : COLOR 15,0
IF CURSORY >= 26 THEN SCROLL 1,6,1,25,100 : LOCATE 25,1
END IF
IF lStr = "@" THEN lStr = CHR$(7)
IF INSTR(lStr, ANY "abcdefghijklmnopqrstuvwxyz") AND LEN(lStr) = 1 THEN lStr = CHR$(ASC(lStr)-&h20)
IF lStr = CHR$(7) THEN COLOR 12,0 : PRINT "[BELL]"; : COLOR 15,0
IF lStr = CHR$ (9) THEN COLOR 12,0 : PRINT "[WHO ARE YOU]"; : COLOR 15,0
IF lStr = CHR$(13) THEN
COLOR 12,0 : PRINT "[CR]" : COLOR 15,0
IF CURSORY >= 26 THEN SCROLL 1,6,1,25,100 : LOCATE 25,1
END IF
IF lStr = CHR$(0,83) THEN CLS : InitDone = 0
lShift = 0
'........................................................................................................
IF LEN (lStr) = 1 THEN 'See if
IF INSTR(lStr, ANY NotShifted) THEN lShift = 1 : PRINT lStr; 'lower or
IF INSTR(lStr, ANY Shifted) THEN lShift = 2 : IF ASC(lStr) > 9 THEN PRINT lStr; 'upper
IF INSTR(lStr, ANY Shiftless) THEN lShift = 3 : IF lStr = " " THEN PRINT lStr; 'shift is
END IF 'needed
IF CURSORX > 75 THEN
IF CURSORY >= 25 THEN
SCROLL 1,6,1,25,100
LOCATE 25,1
' print
ELSE
PRINT
END IF
END IF
lCh = ASC(lStr)
IF LEN(lStr) = 1 THEN
'........................................................................................................
lRet = CHOOSE(lCh+1,_
&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h0B,&h00,&h09,&h02,&h00,&h00,&h08,&h00,&h00, _ 'Ascii to
&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h00, _ 'Baudot
&h04,&h00,&h00,&h00,&h00,&h00,&h00,&h05,&h0F,&h12,&h00,&h11,&h0C,&h03,&h1C,&h00, _ 'table
&h16,&h17,&h13,&h01,&h0A,&h10,&h15,&h07,&h06,&h18,&h0E,&h00,&h00,&h1E,&h00,&h19, _ '
&h00,&h03,&h19,&h0E,&h09,&h01,&h0D,&h1A,&h14,&h06,&h0B,&h0F,&h12,&h1C,&h0C,&h18, _ '
&h16,&h17,&h0A,&h05,&h10,&h07,&h1E,&h13,&h1D,&h15,&h11,&h00,&h1D,&h00,&h00,&h00) '
'.......................................................................................................
IF (lShift <> lOldShift) AND (lShift < 3) AND (lShift > 0) THEN '
lOldShift = lShift 'Send
IF lShift = 2 THEN COMM SEND #1, CHR$(&h1B) 'extra
IF lShift = 1 THEN COMM SEND #1, CHR$(&h1F) 'shiftbyte
END IF 'if needed
IF lShift THEN COMM SEND #1, CHR$(lRet) '
END IF
WEND 'Send data
IF CURSORX > 1 THEN PRINT
PRINT "Terminating, please wait..." '
COMM CLOSE #1 '
END FUNCTION '
'============================================================================================================