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 
' received from the DS1820.
'
' 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