Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Baudot 5 bit code through COM port

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBCC Baudot 5 bit code through COM port

    A little utility to send Baudot 5 bit code through a serial port...

    Click image for larger version

Name:	Screen2.png
Views:	73
Size:	13.1 KB
ID:	784655

    Code:
    '============================================================================================================
    ' 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.05 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,_
                    &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                                                                                       '
    
    '============================================================================================================
    Regards,
    Peter

  • #2
    I started a replies thread in Programming, subject
    Comments on PBCC Baudot 5 bit code through COM port.
    Last edited by Dale Yarker; 11 Sep 2019, 12:01 AM.
    Dale

    Comment


    • #3
      I corrected the Choose error, thanks Dale....

      Code:
      '============================================================================================================
      ' 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                                                                                       '
      
      '============================================================================================================
      Regards,
      Peter

      Comment

      Working...
      X