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