Code:
'######################################################################
'DCFFunkuhr.bas
'
'Ein Testprogramm für die Universalplatine RN-AVR UNIVERSAL
'
'Das Programm zeigt wie man per Funk die Uhrzeit ermittelt und verifiziert
'Dazu muss ein einfaches DCF Funkmodul an Pin PD3 angeschlossen werden
'
' (c) Frank Brall 2013
'Software und RN-AVR UNIVERSAL Bezug über www.robotikhardware.de DVD
'Weitere Beispiele auf DVD von robotikhardware.de
'oder im www.Roboternetz.de und rn-wissen.de
'
'Dieses Programm darf als Open Source frei verwendet werden, wenn
'das die oberen Copyright Zeilen vollständig in andere Projekt
'Dokumentationen und Sourcecode übernommen werden.
'
'######################################################################
'Portbelegung bzw. Modulverbindung
'DCF-Signal PD3 (Int1)
'LCD an folgenden PIns
'DB7 PC7
'DB6 PC6
'DB5 PC5
'DB4 PC4
'RS PC3
'E PC2
'Licht PD7
'Infos DCF http://www.ptb.de/cms/fileadmin/inte...009_Heft_3.pdf
Declare Sub Funkuhraktivieren()
Declare Sub Funkuhrzeitauswerten()
Declare Sub Funkuhrzeitausgeben()
Declare Function Dcf_decodiere(byval Bitnr As Byte , Byval Bitanzahl As Byte , Byval Paritaet As Byte) As Integer
Declare Function Dcf_checkparitaet(byval Bitnr As Byte , Byval Bitanzahl As Byte) As Integer
$programmer = 12 'MCS USB (Zeile weglassen wenn anderer Programmer)
$prog &HFF , &HFF , &HD9 , &HFE 'Fusebits richtig programmieren (Quarz ein,Jtag aus)
$regfile = "m644def.dat"
$framesize = 32
$swstack = 32
$hwstack = 64
$crystal = 8000000 'QuarzFrequenzuenz
$baud = 9600
Baud = 9600
'******************************************* Definitionen für Funkuhr ****************************************
Config Pind.3 = Input
Portd.3 = 1
Dcfsignal Alias Pind.3 'Pin an dem Funkuhr hängt
Dim I As Integer
Dim N As Integer
Dim Q As Integer ' Zaehler der im Interrupt genutzt wird
Dim Timestamp As Long 'gerechnet ab aktivierung des geräetes
Dim Uhr_10ms As Integer
Dim Uhr_sek As Integer
Dim Uhr_min As Integer
Dim Uhr_std As Integer
Dim Datum_tag As Integer
Dim Datum_monat As Integer
Dim Datum_jahr As Integer
Dim Datum_wochentag As Integer
Dim Dcfuhrok As Byte
Uhr_min_ok Alias Dcfuhrok.0 'wird 1 wenn Wert verifiziert wurde
Uhr_std_ok Alias Dcfuhrok.1
Datum_tag_ok Alias Dcfuhrok.2
Datum_monat_ok Alias Dcfuhrok.3
Datum_jahr_ok Alias Dcfuhrok.4
Datum_wochentag_ok Alias Dcfuhrok.5
Bit6 Alias Dcfuhrok.6
Bit7 Alias Dcfuhrok.7
' Meine Timer
Dim Dcf_ms_time As Integer 'Zählt vergangenen ms
Dim Dcfsignal_ms As Integer 'ca. 100ms LOW Bit ca. 200ms High Bit
Dim Dcfmerkesignal_ms As Integer
Dim Dcfsignalabstand_ms As Integer
Dim Dcfflanke As Bit '0 = fallend 1 = steigend
Dim Dcfsignalbit As Bit
Dim Dcfbits(61) As Byte ' alle 60 empfangenen Bits
Dim Merkedcfbits(61) As Byte ' alle 60 empfangenen Bits
Dim Dcfbitsauswerten As Byte ' 1 wenn dcfbits vollständig in Merkedcfbits kopiert wurden und noch nicht ausgewertet wurden
Dim Dcfnextbit As Integer ' Nummer des nächsten Bits wenn 0 dann bit nicht notieren
Dim Dcfminutenanzahl As Byte 'Gibt an wie oft eine vollständige DCF Signalrunde (1Min) geprueft wurde
Dim Dcffunkuhrstatus As Byte ' 0=Kein guter Empfang
' 1=Warte auf Minutenbeginn
' 2=Signalstart gefunden Minute wird nun aufgezeichnet
' 3=Uhrzeit wird verifiziert
' 4=Fertig - Uhrzeit korrekt erkannt
Dim Dcfempfangsqualitaet As Byte '0 = Schlecht 1 = Gut
Dim Dcfwert As Integer 'Wird bei dcf auswertung gebraucht
Dim Dcflong As Long 'Wird bei dcf auswertung gebraucht
'******************************************* ENDE Code für Funkuhr ****************************************
'LCD
Config Pind.7 = Output 'Spannung an LCD aktivieren
Lcdpower Alias Portd.7
Lcdpower = 1 'Licht an
Config Lcd = 20 * 4 , Chipset = Ks077
Config Lcdpin = Pin , Db4 = Portc.4 , Db5 = Portc.5 , Db6 = Portc.6 , Db7 = Portc.7 , E = Portc.2 , Rs = Portc.3
Config Lcdbus = 4
Initlcd
Cls
' ********* HAUPTPROGRAMM ************
Config Pind.6 = Output 'LED
Led1 Alias Portd.6
Led1 = 0 'ein
Call Funkuhraktivieren
Do
If Dcfbitsauswerten = 1 Then Funkuhrzeitauswerten 'Bits auswerten
Funkuhrzeitausgeben
Wait 1
Loop
'******************************************* Code für Funkuhr ****************************************
Sub Funkuhraktivieren()
Dcffunkuhrstatus = 1
Dcfempfangsqualitaet = 0
Dcfminutenanzahl = 0
Dcfnextbit = 0
Dcfbitsauswerten = 0
Dcfuhrok = 0
Config Int1 = Falling
On Int1 Int1_int
Config Timer0 = Timer , Prescale = 1024
On Timer0 Timer0_int
Timer0 = 178
Enable Int1
Enable Timer0
Enable Interrupts
End Sub
'ueberprueft die paritaet eine Bitfolge, das letzte Bit muss paritaetsbit sein
'ist paritaet ok dann ruckgabe 1 ansonsten -1
Function Dcf_checkparitaet(byval Bitnr , Byval Bitanzahl)
Local T As Integer
Local Anz_einsen As Byte
Local Pari As Byte
Incr Bitnr 'Um 1 herabsetzen da bei uebergabe 0 mitgezaehlt wird
Anz_einsen = 0
For T = 1 To Bitanzahl
If Merkedcfbits(bitnr) > 0 Then Incr Anz_einsen
Incr Bitnr
Next T
Pari = Anz_einsen.0 'Gerade=0 ungerade=1
Dcf_checkparitaet = 1
If Pari = 1 Then Dcf_checkparitaet = -1
End Function
'Uebernimmt an angebener Stelle die Bitinformation und wandelt in dezimal
'wenn paritaet=1 dann wird diese mit nachfolgendem Bit verglichen
'bei fehler wird -1 zurückgebenen
Function Dcf_decodiere(byval Bitnr , Byval Bitanzahl , Byval Paritaet)
Local T As Integer
Local Wert As Byte
Local Summe As Byte
Local Anz_einsen As Byte
Local Pari As Byte
Incr Bitnr 'Um 1 herabsetzen da bei uebergabe 0 mitgezaehlt wird
Anz_einsen = 0
Summe = 0
Restore Bcdzahl
For T = 1 To Bitanzahl
Read Wert
If Merkedcfbits(bitnr) > 0 Then
Incr Anz_einsen
Summe = Summe + Wert
End If
Incr Bitnr
Next T
Dcf_decodiere = Summe
If Paritaet = 1 Then 'wenn parität geprüft werden soll
If Merkedcfbits(bitnr) > 0 Then Incr Anz_einsen 'paritaetsbit hinzuzaehlen
Pari = Anz_einsen.0 'Gerade=0 ungerade=1
If Pari = 1 Then Dcf_decodiere = -1
End If
End Function
'DCFBits auswerten
Sub Funkuhrzeitauswerten()
Uhr_sek = 0
If Uhr_min_ok = 0 Then
Dcfwert = Dcf_decodiere(21 , 7 , 1)
If Dcfwert <> -1 Then
If Dcfwert = Uhr_min Then
Uhr_min_ok = 1
Else
Uhr_min = Dcfwert
End If
End If
End If
If Uhr_std_ok = 0 Then
Dcfwert = Dcf_decodiere(29 , 6 , 1)
If Dcfwert <> -1 Then
If Dcfwert = Uhr_std Then
Uhr_std_ok = 1
Else
Uhr_std = Dcfwert
End If
End If
End If
Dcfwert = Dcf_checkparitaet(36 , 23)
If Dcfwert = 1 Then
If Datum_tag_ok = 0 Then
Dcfwert = Dcf_decodiere(36 , 6 , 0)
If Dcfwert <> -1 Then
If Dcfwert = Datum_tag Then
Datum_tag_ok = 1
Else
Datum_tag = Dcfwert
End If
End If
End If
If Datum_monat_ok = 0 Then
Dcfwert = Dcf_decodiere(45 , 5 , 0)
If Dcfwert <> -1 Then
If Dcfwert = Datum_monat Then
Datum_monat_ok = 1
Else
Datum_monat = Dcfwert
End If
End If
End If
If Datum_jahr_ok = 0 Then
Dcfwert = Dcf_decodiere(50 , 8 , 0)
If Dcfwert <> -1 Then
If Dcfwert = Datum_jahr Then
Datum_jahr_ok = 1
Else
Datum_jahr = Dcfwert
End If
End If
End If
If Datum_wochentag_ok = 0 Then
Dcfwert = Dcf_decodiere(42 , 3 , 0)
If Dcfwert <> -1 Then
If Dcfwert = Datum_wochentag Then
Datum_wochentag_ok = 1
Else
Datum_wochentag = Dcfwert
End If
End If
End If
End If
Locate 1 , 1
If Uhr_min_ok = 1 Then Lcd "Min_OK ";
If Uhr_std_ok = 1 Then Lcd "Std_OK ";
If Dcfuhrok = &B111111 Then
Dcffunkuhrstatus = 4
Locate 1 , 1
Disable Int1 'Funkuhrinterrupt abstellen da zeit ja gelesen
Lcd "Uhrzeit komplett ok"
End If
Dcfbitsauswerten = 0 'ausgewertet
End Sub
Sub Funkuhrzeitausgeben()
Local H As String * 2
Local M As String * 2
Local S As String * 2
Local D As String * 2
Local Mo As String * 2
Local Ya As String * 2
Local Tag As String * 10
'Status ausgeben
Locate 1 , 1
Select Case Dcffunkuhrstatus
Case 0 : Lcd "Noch kein Empfang";
Case 1 : Lcd "Signalstart suchen";
Case 2 : Lcd "Uhrzeit empfangen...";
Case 3 : Lcd "Uhrzeit pruefen ...";
Case 4 : Lcd "Uhrzeit korrekt! ";
Tag = Lookupstr(datum_wochentag , Datatage)
Locate 4 , 1
Lcd Tag
End Select
Locate 2 , 1
Lcd "Signal:" ;
If Dcfempfangsqualitaet = 1 Then
Lcd "gut ";
Else
Lcd "schlecht";
End If
Lcd " R:" ; Dcfminutenanzahl ; " ";
H = Str(uhr_std)
H = Format(h , "00")
M = Str(uhr_min)
M = Format(m , "00")
S = Str(uhr_sek)
S = Format(s , "00")
D = Str(datum_tag)
D = Format(d , "00")
Mo = Str(datum_monat)
Mo = Format(mo , "00")
Ya = Str(datum_jahr)
Ya = Format(ya , "00")
Locate 3 , 1
Lcd H ; ":" ; M ; ":" ; S ; " " ; D ; "." ; Mo ; "." ; Ya
End Sub
' Wird bei DCF Flankenwechsel aufgerufen
Int1_int:
If Dcfflanke = 1 Then
Config Int1 = Falling
Dcfsignal_ms = Dcf_ms_time
Dcfmerkesignal_ms = Dcf_ms_time
Dcfflanke = 0
If Dcfsignal_ms < 80 Then
Dcfempfangsqualitaet = 0 'Stoerung kein guter Empfang
Dcfnextbit = 0 'auf neuen Anfang warten, hat keinen zweck mit der aktuellen Folge
Else
Dcfempfangsqualitaet = 1 'Könnte Signal sein Doch Empfang?
End If
If Dcfnextbit > 0 And Dcfnextbit < 62 Then
If Dcfsignal_ms < 110 Then
Dcfsignalbit = 0
Else
Dcfsignalbit = 1
End If
Dcfbits(dcfnextbit) = Dcfsignalbit
' Print "nextbit" ; Nextbit
Incr Dcfnextbit
End If
Else
Config Int1 = Rising
Dcfsignalabstand_ms = Dcf_ms_time
Dcfflanke = 1
If Dcfsignalabstand_ms > 1100 Then 'Minutenanfang
If Dcfnextbit = 0 Then
If Dcfminutenanzahl = 0 Then Dcffunkuhrstatus = 2
Dcfnextbit = 1 'Erste Aufzeichnung von vorne beginnt
Else
Q = Memcopy(dcfbits(1) , Merkedcfbits(1) , 61) 'merke gelesesene dcfbits
Dcfbitsauswerten = 1
Incr Dcfminutenanzahl
Dcffunkuhrstatus = 3
Dcfnextbit = 1
End If
End If
End If
Dcf_ms_time = 0
Return
'Wird alle 10 ms aufgerufen udn dient der zeitmessung während dem
'Funkuhr DCF-Signal
Timer0_int:
Dcf_ms_time = Dcf_ms_time + 10
Incr Uhr_10ms
If Uhr_10ms > 99 Then
Uhr_10ms = 0
Incr Uhr_sek
Incr Timestamp
End If
If Uhr_sek > 59 Then
Uhr_sek = 0
Incr Uhr_min
End If
If Uhr_min > 59 Then
Uhr_min = 0
Incr Uhr_std
End If
If Uhr_std > 23 Then
Uhr_std = 0
End If
Timer0 = 178
Return
'******************************************* ENDE Interrupts für Funkuhr ****************************************
Bcdzahl:
Data 1 , 2 , 4 , 8 , 10 , 20 , 40 , 80
Datatage:
Data "noch unbekannt" , "Montag" , "Dienstag" , "Mittwoch" , "Donnerstag" , "Freitag" , "Samstag" , "Sonntag"
Lesezeichen