'-------------------------------------------------------------------------------
Option Explicit

' This code allows you to do the equivalent of Debug.Print, except using
' arbitrary baud rates.

' Last mod 12 Oct 2001

'-------------------------------------------------------------------------------
Public Sub Main()

' Test code.

    Const CR As Byte = 13
    Const LF As Byte = 10

    DebugPrint "Hello, world!", 19200
    DebugPrint Chr(CR) & Chr(LF), 19200

End Sub
'-------------------------------------------------------------------------------
Public Sub DebugPrint( _
    ByVal Tx As String, _
    ByVal Baud As Long)

' Transmits a string from Com1 at the specified baud rate, 8 data bits,
' no parity.

    Dim Char As String * 1
    Dim DataByte As Byte
    Dim N As Integer
    Dim Length As Integer

    ' UART Transmit Complete.
    Const TXC As Byte = bx0100_0000

    ' 9-bit characters.
    Const CHR9 As Byte = bx1111_1011   ' Complemented.

    ' Transmit Enable.
    Const TXEN As Byte = bx0000_1000

    ' UART Data Register Empty.
    Const UDRE As Byte = bx0010_0000

    ' Configure port for 8-bit data.
    Register.UCR = Register.UCR And CHR9

    ' Crystal clock frequency (Hz).
    Const fCK As Long = 7372800

    Length = Len(Tx)
    If (Length < 1) Then
        Exit Sub
    End If

    ' Clear TXC by writing a 1 to the bit.
    Register.USR = Register.USR Or TXC

    '     Baud    UBRR
    '
    '    2 400     191
    '    4 800      95
    '    9 600      47
    '   14 400      31
    '   19 200      23
    '   28 800      15
    '   38 400      11
    '   57 600       7
    '   76 800       5
    '  115 200       3
    '  153 600       2
    '  230 400       1
    '  480 600       0
    '
    ' In Atmel docs, this equation gives the relationship between the
    ' crystal clock frequency fCK, baud rate and register UBRR value:
    '
    '     Baud = fCK / ( 16 * (UBRR + 1) )
    '
    ' Rearranging terms gives UBRR as a function of fCK and Baud.
    Register.UBRR = CByte( fCK \ (16 * Baud) ) - 1

    For N = 1 To Length

        Char = Mid(Tx, N, 1)
        DataByte = Asc(Char)

        ' Enable transmission.
        Register.UCR = Register.UCR Or TXEN

        ' Wait for the I/O data register to be available.
        Do Until (Register.USR And UDRE = UDRE)
        Loop

        ' Make the data available for transmission.
        Register.UDR = DataByte
    Next

    ' Wait for transmission to complete.
    Do Until ( (Register.USR And TXC) = TXC )
    Loop

End Sub
'-------------------------------------------------------------------------------