### Periodic Temperature Measurements using the DS1820

```' DS1820_2.Bas (BX-24)
'
' Performs a temperature measurement using a DS1820 every 15 seconds and
' displays.  Performs an 8-bit cyclic redundancy check on the data
'
' Illustrates the use of 1-Wire commands and use of the on-board real time
' clock to perfrom periodic measurements.
'
' Note that Timer is used to fetch the elapsed time since midnight and thus
' periodicity is achieved using;
'
'   do
'      TimeCurrent = Timer()
'   until (TimeCurrent >= TimeOut)
'
' However, a problem occurs when TimeOut  >= 86400.0.  That is, TimeOut
' is in a new day.  In this case, TimeOut = TimeOut - 86400.0 and the
' timing is performed in two steps;
'
'   do
'      TimeCurrent = Timer()
'   until (TimeCurrent <= TimeOut)	' wait for clock to roll over
'
'   do
'      TimeCurrent = Timer()
'   until (TimeCurrent >= TimeOut)
'
' For a more complete discussion of the implemenation of the calculation of
' the 8-bit CRC, see http://www.phanderson.com/PIC
'
' 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
Dim TimeCurrent as Single, TimeOut as Single, Tperiod as Single

Tperiod = 15.0

Call OpenSerialPort(1, 19200)
Call PutTime(0, 0, 0.0)
TimeOut = Timer()

Do		' continually perform measurements
T_C = MakeTempMeas(13)
If (T_C < -80.00) Then
Str="CRC Error"
Call PutStr(str)
Else
Call PutS(T_C)
End If
Call NewLine()

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
End Sub

Function MakeTempMeas(ByVal Pin as Byte) as Single
' Returns temperature.  Returns -89.99 if CRC error

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
```