Attribute VB_Name = "Event"
'=====================================================================
'     Name: Event.bas
'     Purpose: To implement the functionality of the event counter
'     Notes:
'     Last Updated     Initials    Description
'       02/23/04         RY       Original code written
'
'=====================================================================



Dim debug_var As Integer
Dim EvPort As Integer '= &H7 '0111
Dim EvDDrBit As Integer '= &H2 '0010
Dim EvCLKBit As Integer '= &H4 '0100
Dim EvDinBit As Integer ' = &H1 '0001
Dim EvDoutBit As Integer '= &H1 '0001
Dim EvShadow As Long '= &H2 '0010
Dim DS1682_ADDR As Integer

Public Sub Port_Init()
    EvPort = &H7 '0111             'Indicates register 7 (consider reg0 as 1st reg)
    EvDDrBit = &H2 '0010           'Indicates 1st in register 7
    EvCLKBit = &H4 '0100           'Indicates the 2nd bit in register 7 (from lsb if lsb=0)
    EvDinBit = &H1 '0001           'Indicates least significant bit in register 7 (from lsb if lsb=0)
    EvDoutBit = &H1 '0001          'Indicates the least significant bit in register 7 (from lsb if lsb=0)
    DS1682_ADDR = &HD6             'Indicates the device address
End Sub


Public Sub rst_RegPtr()
Dim er As Integer
    Start_seq
    er = er + Write_byte(DS1682_ADDR)
    er = er + Write_byte(0) ' register address
    If er > 0 Then
        MsgBox "Time Counter: Error in writing", , ParvError
    End If
    Stop_seq
End Sub

Public Sub Stop_seq()
    'STOP CONDITION: A change in the state of data line, from LOW to HIGH, while the clock line is HIGH,
    'defines the STOP condition.
    
    '             _____
    'Data        |    _|______
    '            |   / |
    '       _____|__/  |
    '            |     |
    '            |     |
    'Clock      _|_____|______
    '          / |     |
    '    _____/  |_____|
    
    
    ' Set DDR to output
    SET_DDR_OUT
    
    ' Make Dout Low
    SET_DATA_LOW
    ' Make Clock low
    CLOCK_LOW
    
    ' Make Clock high
    CLOCK_HIGH
    ' MaKe Dout high
    SET_DATA_HIGH
End Sub

Public Sub Start_seq()
    'START SEQUENCE:A change in the state of data line from, HIGH to LOW, while the clock is HIGH,
    'defines the start condition

    '         -----
    'Data ___|__   |
    '        |  \  |
    '        |   \_|__________
    '        |     |
    '        |     |
    'clock___|_____|___
    '        |     |   \
    '        |     |    \_______
    '         -----
    
    CLOCK_LOW
    SET_DDR_OUT
    SET_DATA_LOW
    CLOCK_HIGH
    CLOCK_LOW
    'Make the data line high
    SET_DATA_HIGH
    'Make the clock high
    SET_DATA_HIGH
    
    'Make the clock high
    CLOCK_HIGH
    'Set ddr to output
    
    'Make the data line low
    SET_DATA_LOW
    'Make the clock low
    CLOCK_LOW
End Sub

Public Function Read_byte(nack As Integer) As Integer
Dim Rd_val As Integer
' Purpose: To read the byte from the address pointer by the register pointer. ( It is assumed that
' the register pointer has already been set. See page10 of data sheet for more details)
' Returns: The value read

' Set DDR for input
    SET_DDR_IN
    CLOCK_LOW
    I = &H80
    Rd_val = 0
    While CInt(I) > 0
    ' Raise clock
        CLOCK_HIGH
    ' Read Din bit
        If GET_DATA Then
            Rd_val = Rd_val Or (I)
        End If
    ' Lower clock
        CLOCK_LOW
        I = I / 2
    Wend '........Continue sequence for 8 times for 8 bits (1Byte)

'GENRATING THE ACKNOWLEDGEMENT
If nack Then
        SET_DATA_HIGH ' No acknowledge
Else
        SET_DATA_LOW  ' Ack
End If

' Set DDR for output
SET_DDR_OUT

If nack Then
        SET_DATA_HIGH ' No acknowledge
Else
        SET_DATA_LOW  ' Ack
End If
' Raise clock
    CLOCK_HIGH
    
' Lower clock
    CLOCK_LOW
    
    SET_DDR_IN
    
    Read_byte = Rd_val ' Return the value
    
End Function
Public Function Write_byte(w_val As Integer) As Integer
'Purpose: To write the value passed in as argument to the register pointed by the register pointer. (It
' is assumed the register pointer is already set. (See page 10 of data sheet for details).
' Return: Returns true if write was successful else -1
Dim er As Integer

'Set DDR to output
    SET_DDR_OUT
'Lower the clock
    CLOCK_LOW
    
I = &H80
    While CInt(I) > 0
    'write to the dout corresponding to the value passed starting starting with msb
        If (I And w_val) Then
            SET_DATA_HIGH
            'MsgBox GET_DATA
        Else
            SET_DATA_LOW
            'MsgBox GET_DATA
        End If
'Raise clock
    CLOCK_HIGH
'Lower clock
    CLOCK_LOW
    
        I = I / 2
        
    Wend '..... Repeat  until 8 times (1 byte is writen)

'Check for the ACKNOWLEDGEMENT
'Set DDR for input
    SET_DDR_IN
'Raise clock
    CLOCK_HIGH
'Check the din bit (should be 0) else error
    
    If GET_DATA > 0 Then
            er = 1
    Else
            er = 0
    End If
'Lower the clock
    CLOCK_LOW

Write_byte = er ' return if write was successful

End Function

Public Sub SET_DATA_HIGH() ' Make data high
    EvShadow& = EvShadow& Or (EvDoutBit)
    vbapp_Write EvPort, EvShadow&
End Sub

Public Sub SET_DATA_LOW() ' Make data low
    EvShadow& = EvShadow& And (Not EvDoutBit)
    vbapp_Write EvPort, EvShadow&
End Sub

Public Sub CLOCK_HIGH() ' Raise the clock
    EvShadow& = EvShadow& Or (EvCLKBit)
    vbapp_Write EvPort, EvShadow&
End Sub

Public Sub CLOCK_LOW() 'Lower the clock
    EvShadow& = EvShadow& And (Not EvCLKBit)
    vbapp_Write EvPort, EvShadow&
End Sub

Public Sub SET_DDR_OUT() 'Set DDR to output
    EvShadow& = EvShadow& Or (EvDDrBit)
    vbapp_Write EvPort, EvShadow&
End Sub

Public Sub SET_DDR_IN() 'Set DDR for input
    EvShadow& = EvShadow& And (Not EvDDrBit)  'Set DDR for input
    vbapp_Write EvPort, EvShadow&
End Sub

Public Function GET_DATA() As Long
    portvalue& = vbapp_Read(EvPort) ' Read Port
    If (portvalue& And EvDinBit) > 0 Then
            GET_DATA = 1
    Else
            GET_DATA = 0
    End If
End Function

Public Sub Read_loop()
    Dim I As Integer
    Dim dat As Long
    Dim Alrm0 As Long
    Dim Alrm1 As Long
    Dim Alrm2 As Long
    Dim Alrm3 As Long
    Dim ETC0 As Long
    Dim ETC1 As Long
    Dim ETC2 As Long
    Dim ETC3 As Long
    Dim Evnt0 As Long
    Dim Evnt1 As Long
    Dim Umem(20) As Long
    rst_RegPtr
    Start_seq
    er = er + Write_byte(DS1682_ADDR Or &H1)
    If er > 0 Then
        'MsgBox "Error"
    End If
    
    dat = Read_byte(0)
    Alrm0 = Read_byte(0)
    Alrm1 = Read_byte(0)
    Alrm2 = Read_byte(0)
    Alrm3 = Read_byte(0)
    ETC0 = Read_byte(0)
    ETC1 = Read_byte(0)
    ETC2 = Read_byte(0)
    ETC3 = Read_byte(0)
    Evnt0 = Read_byte(0)
    Evnt1 = Read_byte(0)
    
    
    
    For I = 11 To 20
        If I = 20 Then
            Umem(I - 11) = Read_byte(1) 'BitDisp(Read_From_Ad dr(I))
        Else
            Umem(I - 11) = Read_byte(0) 'BitDisp(Read_From_Addr(I))
        End If
    Next
End Sub



Public Sub Lock_UsrMemory()
Dim str1 As String
    
    str1 = InputBox("Remember that memory will be become readonly permanently Continue..(Y/N)")
    Select Case Trim(UCase(str1))
    Case "Y":
            er = Write_To_Addr(&H1F, &HF0)
            If er > 0 Then
                'MsgBox "Error in writing to the Memory try again"
                Exit Sub
            End If
            er = Write_To_Addr(&H1F, &HF0)
            If er > 0 Then
                'MsgBox "Error in writing to the Memory try again"
                Exit Sub
            End If
    Case "N":
    Case Else:
    End Select
End Sub

Public Function Read_From_Addr(addr As Integer) As Integer
    
    Dim dat As Integer
    Dim er As Integer
    
    Start_seq
    er = er + Write_byte(DS1682_ADDR)
    er = er + Write_byte(addr) ' register address
    Stop_seq

    Start_seq
    er = er + Write_byte(DS1682_ADDR Or &H1)
    If er > 0 Then
        MsgBox "Error"
    End If
    dat = Read_byte(1)
    Stop_seq
    Read_From_Addr = dat
    
End Function


Public Function Write_To_Addr(addr As Integer, dat As Integer) As Integer
Dim er As Integer
Start_seq
er = er + Write_byte(DS1682_ADDR)
er = er + Write_byte(addr) ' register address
er = er + Write_byte(dat)
Stop_seq
Write_To_Addr = er
End Function

Public Function cBinary(BinaryString As String) As Long

' convert binary string like 1100010 into decimal number

Dim L As Long
Dim MP As Long

MP = 1
L = Len(BinaryString)
Do While L > 0
   cBinary = cBinary + val(Mid$(BinaryString, L, 1)) * MP
   MP = MP * 2
   L = L - 1
Loop

End Function

Public Function BitDisp$(A%)
Dim I As Integer
        For I = 7 To 0 Step -1
                If (A% And (2 ^ I)) = 0 Then
                        A1$ = A1$ + "0"
                Else
                        A1$ = A1$ + "1"
                        End If
                Next
                BitDisp$ = A1$
End Function