A 7000 Point Temperature Data Logger using a DS1820



' DS1820_3.Bas (BX-24)
'
' Illustrates a 7000 point temperature point datalogger using the BX24's
' EEPROM.  Extends on DS1820_2.Bas.
'
' On boot, the BX24 reads Pin 14 and if at zero, measures temperatures 
' and saves to EEPROM beginning at &H1000.  Note that a CRC  failure is 
' saved as -89.99.   On each save, a terminating value of -99.99 is written 
' to the next EEPROM location.  This is used in the Dump routine.
'
' If, on boot, Pin 14 is at a logic one (open), data is dumped to the
' terminal.  If value is -89.99 (less than -80.00 and > -95.0) then CRC
' error is displayed.  Display of data continues until terminating value
' of -99.99 is read from EEPROM.
'
'
' BX24					DS1820
'			+5
'			|
'			* 4.7K
' 			|
' RA.7 (Term 13) ---------------------- DQ (term 2)
'					Terms 1 and 3 to GRD
' 
'
' copyright, Peter H. Anderson, Baltimore, MD, Dec, '99

Const TEST as Byte = 1

Sub Main()
   
   Dim Str as String *15
   Dim T_C as Single, Terminator as Single
   Dim TimeCurrent as Single, TimeOut as Single, Tperiod as Single
   Dim EEPROMAdr as Long

   Tperiod = 5.0

   Call OpenSerialPort(1, 19200)

   Call PutPin(14, 2)		' make 14 an input with pullup
   If(GetPin(14) = 0) Then	' enter measure mode
     EEPROMAdr = &H1000
     Call PutTime(0, 0, 0.0)
     TimeOut = Timer()

     Do		' continually perform measurements and log them
        Terminator = -99.99
        Call PutEEPROM(EEPROMAdr+4, Terminator, 4) ' write "last data"       
        T_C = MakeTempMeas(13)
        Call PutEEPROM(EEPROMAdr, T_C, 4)           ' save temp meas
        EEPROMAdr = EEPROMAdr + 4              	    ' next location

        TimeOut = TimeOut + Tperiod

        If (TimeOut >= 86400.0) Then	' rollover 
           TimeOut = TimeOut - 86400.0
           Do				' wait for RTC to roll over
             TimeCurrent = Timer()	' 86398, 86399, 0
           Loop Until (TimeCurrent <= TimeOut)
        End If

        Do
          TimeCurrent = Timer()
        Loop Until (TimeCurrent >= TimeOut)  
     Loop Until (EEPROMAdr >=&H7FF8)      ' until out of memory   
              
   Else			' dump the data from memory
      EEPROMAdr = &H1000        
      Do
         Call GetEEPROM(EEPROMAdr, T_C, 4)
         If ((T_C < -80.0) AND (T_C > -95.0)) Then	' CRC error
            Str = "CRC Error"
            Call PutStr(Str)
            Call NewLine()
         ElseIf (T_C > -95.0) Then
            Call PutS(T_C)
            Call NewLine()
         End If
         EEPROMAdr = EEPROMAdr + 4
      Loop Until (T_C < -95.0)	' until there is no more data
   End If
End Sub

Function MakeTempMeas(ByVal Pin as Byte) as Single

   Dim N as Integer
   Dim Dat(1 To 9) as Byte, CRC as Byte
   Dim T_C as Single

   Call Init_1W(Pin)
   Call OutByte_1W(Pin, &Hcc)	' skip ROM
      
   Call OutByte_1W(Pin, &H44)	' perform temperature conversion
   Call StrongPullup_1W(Pin)	' strong pullup

      
   Call Init_1W(Pin)
   Call OutByte_1W(Pin, &Hcc)	' skip ROM
      
   Call OutByte_1W(Pin, &Hbe)	' get temperature data
     
   For N = 1 to 9        
     Dat(N) = InByte_1W(Pin)	' fetch the nine bytes        
   Next

   If (TEST <> 0) Then
      For N = 1 to 9
         Call PutHexB(Dat(N))
         Call PutByte(Asc(" "))
      Next     
      Call NewLine()
   End If

   CRC = CalcCRC(Dat, 9)	' calculate CRC of the 9 bytes

   If (CRC <>0) Then		' CRC failure   
     T_C = -89.99
   Else
     If (Dat(2) = 0) Then	' its postive
        T_C = CSng(Dat(1)) / 2.0
     Else
        Dat(1) = (Dat(1) XOR &Hff) + 1	' takes the 2's comp
        T_C = CSng(Dat(1)) / 2.0
     End If
   End If

   MakeTempMeas = T_C

End Function    

Sub Init_1W(ByVal Pin as Byte) ' bring Pin low for 500 usecs and then back 
				' high

   Dim N as Integer
   Call PutPin(Pin, 2)	' be sure DQ is an input

   Call PutPin(Pin, 0)	
   
  
   For N = 1 to 3	' adjust for 500 usec delay
   Next

   Call PutPin(Pin, 2)
  
   For N = 1 to 3
   Next

End Sub

Function InByte_1W(ByVal Pin as Byte) as Byte

   Dim N as Integer, IByte as Byte, B as Byte
   For N =1 to 8
      B = Get1Wire(Pin)
      If (B=1) then
         IByte = (IByte\2) OR bx10000000
      Else
         IByte = IByte\2         
      End If
   Next

   InByte_1W = IByte

End Function
           
Sub OutByte_1W(ByVal Pin as Byte, ByVal OByte as Byte)

   Dim N as Integer, B as Byte
   For N = 1 to 8
     B = OByte AND bx00000001
     If (B=1) Then
        Call Put1Wire(Pin, 1)
     Else
        Call Put1Wire(Pin, 0)
     End If
     OByte = OByte \ 2
   Next
End Sub      

Sub StrongPullUp_1W(ByVal Pin as Byte)
	' Provide a hard logic one for 0.5 secs
   Call PutPin(Pin, 1)
   Call Sleep(0.5)
   Call PutPin(Pin, 2)
End Sub

Sub PutHexB(ByVal X as Byte)	' display a byte in hex format
    Dim Y as Byte
 
    Y= X \ 16 			' convert high nibble to character
    If (Y < 10) then
      Y = Y + Asc("0")
    Else
      Y = Y - 10 + Asc ("A")
    End If
    Call PutByte(Y)

    Y= X And bx00001111 	' same for low nibble
    If (Y < 10) then
      Y = Y + Asc("0")
    Else
      Y = Y - 10 + Asc ("A")
    End If
    Call PutByte(Y)
End Sub

Function CalcCRC(ByRef Buff() as Byte, _
                  ByVal NumVals as Integer) as Byte

   Dim ShiftReg as Byte, SRlsb as Byte, DataBit as Byte, V as Byte
   Dim FBbit as Byte, I as Integer, J as Integer

   ShiftReg = 0			' initialize the shift regsiter

   For I = 1 to NumVals		' for each byte in the array    
      V = Buff(I)
      For J = 1 to 8		' for each bit
         DataBit = V AND &H01	' isolate least sign bit
         SRlsb = ShiftReg AND &H01
         FBbit = (DataBit XOR SRlsb) AND &H01
				' calculate the feed back bit
         ShiftReg = ShiftReg \ 2	' shift right
         If (FBbit = 1) then
            ShiftReg = ShiftReg XOR &H8c
         End if   
         'Call PutB(Shift_Reg)	' for debugging
         'Call NewLine()      
         V = V \ 2		' next bit now in least sig bit position
      Next     
      ' Call PutB(Shift_Reg)
      ' Call NewLine()
   Next
   CalcCRC = ShiftReg		' return the result

End Function