hallo dieter,
Ich versuche momentan das programm so umzuschreiben, damit es auch mit einem 8Mhz quarz passt.
Hier ist das fertige und überprüfte Programm:
Sender:
Code:
$regfile = "2313DEF.DAT"
$baud = 19200 'zum Debuggen
$crystal = 7362700
'Config Serialout = Buffered , Size = 20
'Deklaration der SUB und Functions
Declare Function Make_manchester(byval Daten As Byte) As Word
Declare Sub Send_code(byval Daten As Word)
Declare Sub Send_start()
Declare Sub Send_byte(byval Daten As Byte , Byval Crc_select As Byte)
Const Crc_poly = &H1021 'CRC Polynom
Const Sync_byte = &B01010100 'Startbyte, kommt aus dem SNAP Prtokoll
'Definition der Variablen
Dim Crc As Word
Dim Tempw_1 As Word
Dim Tempw_2 As Word
Dim Temp As Word
Dim Daten(9) As Byte 'Sendebuffer
Dim Temp1 As Byte
Dim Temp2 As Byte
Dim Zaehler As Byte
Dim A As Byte
'Werte für die Funkübertragung einstellen
Const Bit_zeit = 1000 'in us für LOW/HIGH -- > Manchesterbit = 2 * Bitzeit
'original = 500
Const Bit_wait_start = Bit_zeit * 2.5 'Wartezeit zum erkennen des nächsten Bytes
Const Bit_zeit_1_2 = Bit_zeit / 4 'Bitzeit beim einschwingen
Const Anzahl_bit_wechsel = 50 'kommt auf das Modul an hier 150
'geändert auf 10 da 1000us/4=250us*10=2,5ms
'Empfänger braucht 1,6ms zum einschwingen
'Einstellen der Ports
Funk Alias Portd.6 'Bezeichner für Funkport
Config Pind.6 = Output 'Port für Funkmodul
'Enable Interrupts
Daten(1) = "S"
Daten(2) = "N"
Daten(3) = "A"
Daten(4) = "P"
'Hauptschleife
'Kleine Schleife zum testen des Programms
Print "Transmitter 1.0"
Wait 1
Do
'Bitmuster zum einschwingen des Funkempfängers senden
Call Send_start()
'Startbyte senden
Call Send_byte(sync_byte , 1)
'4 Datenbytes senden
For Zaehler = 1 To 4
Call Send_byte(daten(zaehler) , 1)
'Print Daten(zaehler)
Next Zaehler
'CRC zerlegen und senden
Temp1 = High(crc)
Call Send_byte(temp1 , 0)
Temp1 = Low(crc)
Call Send_byte(temp1 , 0)
'kleine Pause, bis es weiter geht
Wait 1
Loop
End
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Unterprogramm zum senden eines Bytes
'Übergabe: Daten, zu sendenes Byte
'crc_select = 0 --> kein CRC, 1 --> mit CRC
'Rückgabe: CRC Wert steht am Schluß in der Variablen crc
Sub Send_byte(byval Daten As Byte , Byval Crc_select As Byte)
If Crc_select = 1 Then 'CRC berechnen = ja ???
Temp1 = Daten
Gosub Calc_crc ' Crc Berechnen
End If
Temp = Make_manchester(daten) 'Variable in Manchester Code umrechnen
Call Send_code(temp) 'und senden
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Bitwechsel zum einschwingen senden
'Der empfänger braucht eine gewisse Zeit, um sich auf die Frequenz des Senders einzustellen.
'Bei meinen Modulen von ELV, steht im Datenblatt, das sie bis zu 200 ms dafür brauchen.
'Bei einigen Tests haben sich diese Werte als ausreichend herausgestellt.
'Dauer ca 26,6 ms
'Rückgabe: keine
Sub Send_start()
Crc = 0 'Variable für neue CRC berechnung löschen
Local Count As Byte
Count = 0
Do
Set Funk
Waitus Bit_zeit_1_2
Reset Funk
Waitus Bit_zeit_1_2
Incr Count
Loop Until Count = Anzahl_bit_wechsel
Waitus Bit_wait_start 'kleine Pause zum erkennen des Startes
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Manchester Code ausgeben auf Portpin "Funk", definiert weiter oben
'Hier wird die Variable manchester Bitweise ausgegeben und über den Funksender
'übertragen. Zwischen dem senden einzelner Bytes sollte die Pause nicht größer
'als 500 ms sein, sonst verliert der Empfäger die Frequenz des Senders und die
'Daten sind verloren.
'Vor dem ersten senden von Daten, muß mit dem Aufruf send_start() erstmal die
'Bitmuster zum einschwingen gesendet werden.
'Dauer ca 9,7 ms
'Übergabe: zu sendene Variable (word) Manchestercodiert
'Rückgabe: keine
Sub Send_code(byval Daten As Word)
Local Bit_number As Byte
'Startbit senden
Set Funk
Waitus Bit_zeit
'Anzahl der zu übertragenen Bits
Bit_number = 16
Do
Decr Bit_number
'Bit abfragen und reagieren
If Daten.bit_number = 1 Then
Set Funk
Else
Reset Funk
End If
'benötigte Zeit warten
Waitus Bit_zeit
Loop Until Bit_number = 0
Reset Funk
'kleine Pause, damit der Empfäger das Ende/Start erkennen kann
Waitus Bit_wait_start
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Umrechnen eiens Bytes in Manchester Code
'Hier wird das übergebene Byte mit Manchestercode codiert.
'Dauer ca
' Übergabe: byte, umzurechene Byte
' Rückgabe: word, umgerechnete Variable
Sub Make_manchester(byval Daten As Byte)
Local Bit_number As Byte
Local Manchester As Word
'Anzahl der zu umzurechnen Bits
Bit_number = 8
Do
Shift Manchester , Left , 2
Decr Bit_number
If Daten.bit_number = 1 Then
Manchester = Manchester + 1 '01
Else
Manchester = Manchester + 2 '10
End If
Loop Until Bit_number = 0
Make_manchester = Manchester
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Routine zum berechnen der CRC 16 Cecksumme, aus Bascom Buch
'Crc steht am Ende in der Varablen crc
'Übergabe: umzurechene Variable in temp1
Calc_crc:
Tempw_1 = Temp1 * 256
Crc = Tempw_1 Xor Crc
For Temp2 = 0 To 7
If Crc.15 = 0 Then Goto Shift_only
Tempw_2 = Crc * 2
Crc = Tempw_2 Xor Crc_poly
Goto Nxt
Shift_only:
Crc = Crc * 2
Nxt:
Next
Return
Empfänger:
Code:
'-------------------------------------------------------------------------------
' Datenübertragung Empfangsroutine
'-------------------------------------------------------------------------------
'Ein paar Berehnungen anstellen
Const Takt = 8000000 '8 MHZ
Const Reload = 256 'Timerreload
$regfile = "2313DEF.DAT"
$baud = 38400
$crystal = Takt
Config Serialout = Buffered , Size = 20
'Ein paar Werte für die Empfangsroutine berechnen
Const Pulse_soll = 2 * 10 ^ -3 'Bitzeit für ein Manchesterbit 01 / 10 in ms
'Pulse_soll muß doppelt so hoch sein wie "Bit_zeit" im Sender
Const Pulse_min_temp = Takt / Reload * Pulse_soll * 0.4 * 0.8 '20
Const Pulse_1_2_temp = Takt / Reload * Pulse_soll * 0.8 * 0.8 '40
Const Pulse_max_temp = Takt / Reload * Pulse_soll * 1.2 * 0.8 '60
Const Start_bit = 8 '9 Bit ist das Startbit, muß 1 sein
Const Pruef_bit = Start_bit + 1 '10 Bit ist ein Prüfbit, muß immer 0 sein
Const Timer0_reload = - Reload '--> 65535 - reload
Const Crc_poly = &H1021
Const Sync_byte = &B01010100
Const Byte_counter = 7 'Anzahl der zu empfangenen Bytes
'Definition der Variablen
Dim Daten_temp As Word
Dim Crc As Word
Dim Tempw_1 As Word
Dim Tempw_2 As Word
'wegen dem Typcast, ungeschickt, aber sonst geht es nicht
Dim Pulse_min As Byte
Dim Pulse_1_2 As Byte
Dim Pulse_max As Byte
Pulse_min = Pulse_min_temp
Pulse_1_2 = Pulse_1_2_temp
Pulse_max = Pulse_max_temp
Dim Daten As Byte
Dim Signal_count As Byte
Dim Signal_old As Byte 'Merker für BIT Zustand
Dim Zaehler As Byte
Dim Daten_buffer(8) As Byte
Dim Temp1 As Byte
Dim Temp2 As Byte
Dim Crc_error_count As Byte
Dim Daten_empfangen As Bit ' Status Register
'Einstellen der Ports ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Signal Alias Pind.6 'Eingang für Funkmodul
Config Signal = Input
'Led Alias Porta.2
'Config Pina.2 = Output
Print "Funkempfänger"
'Wait 1
'Timer einstellen+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Config Timer0 = Timer , Prescale = 1
On Timer0 Timer0_overflow
Enable Timer0
Enable Interrupts
'Hauptschleife. Wenn ein Byte empfangen wurde, wird geprüft ob es das Startbyte war.
'Wenn ja, dann werden die restichen zu empfangenen Bytes in die Variable Daten_Buffer
'geschoben. Wenn alle Bytes da sind, wird die CRC berechnet berechnet und entschieden,
'ob die Daten gültig sind oder nicht. CRC = 0 --> Daten gültig
Do
If Daten_empfangen = 1 Then 'Daten empfangen
If Daten = Sync_byte Then Zaehler = 1 'Zeiger auf Anfang stellen
Daten_buffer(zaehler) = Daten 'Daten in Buffer schieben
Daten_empfangen = 0 'Status ändern
If Zaehler = Byte_counter Then 'alle Bytes da ???
Gosub Check_crc 'CRC berechnen
If Crc <> 0 Then
'Hier sin die Daten ungültig
Incr Crc_error_count
Print "CRC Error: " ; Crc_error_count
Else
'Ab hier sind die Daten gültig
Zaehler = 1
'Daten ausgeben, ohne Startbyte und die beiden CRC Bytes
Do
Incr Zaehler
Print Chr(daten_buffer(zaehler)) ;
Loop Until Zaehler = 5
Print 'neue Zeile
Zaehler = 0
End If
End If
Daten = 0
Incr Zaehler
End If
Loop
End
'Die CRC Werte der empfangenen Daten berechnen. Am Schluß muß CRC = 0 sein
Check_crc:
Crc = 0
Temp1 = Daten_buffer(1)
Gosub Calc_crc
Temp1 = Daten_buffer(2)
Gosub Calc_crc
Temp1 = Daten_buffer(3)
Gosub Calc_crc
Temp1 = Daten_buffer(4)
Gosub Calc_crc
Temp1 = Daten_buffer(5)
Gosub Calc_crc
Temp1 = Daten_buffer(6)
Gosub Calc_crc
Temp1 = Daten_buffer(7)
Gosub Calc_crc
Return
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Routine zum berechnen der CRC 16 Cecksumme, aus Bascom Buch
'Crc steht am Ende in der Varablen crc
'Übergabe: umzurechene Variable in temp1
Calc_crc:
Tempw_1 = Temp1 * 256
Crc = Tempw_1 Xor Crc
For Temp2 = 0 To 7
If Crc.15 = 0 Then Goto Shift_only
Tempw_2 = Crc * 2
Crc = Tempw_2 Xor Crc_poly
Goto Nxt
Shift_only:
Crc = Crc * 2
Nxt:
Next
Return
'-------------------------------------------------------------------------------
'Hier werden die Daten empfangen und geprüft auf die Bitzeiten
'Aufruf alle 41 µs bei 8Mhz
'-------------------------------------------------------------------------------
Timer0_overflow:
Timer0 = Timer0_reload
Incr Signal_count
'Ende gefunden oder Signal zu lang
If Signal_count > Pulse_max Then
'Print Signal_count
'Startbit = 1 and Pruef_bit = 0 dann Daten übergeben
If Daten_temp.pruef_bit = 0 And Daten_temp.start_bit = 1 Then
Daten = Daten_temp
Set Daten_empfangen
End If
Daten_temp = 0
End If
'Flankenwechsel ??
If Signal <> Signal_old.1 Then
'Print Signal_count
'neuen Zustand merken
Toggle Signal_old
'Pulse zu kurz ??
If Signal_count < Pulse_min Then
Daten_temp = 0
'Print Signal_count
End If
'Start oder Abfragezeitpunkt ??
If Daten_temp = 0 Or Signal_count > Pulse_1_2 Then
'wenn noch nicht zuviele Daten, dann eine Stelle schieben
If Daten_temp.start_bit = 0 Then
Shift Daten_temp , Left , 1
End If
'Bit setzen wenn der Empfänger das Signal 1:1 ausgibt. Signal_old.1 = 0 wenn es 180° gedreht ist
If Signal_old.1 = 1 Then
Incr Daten_temp
End If
Signal_count = 0
End If
End If
Return
Dieter,
Vielen Dank für deinen tollen support. Ich denke da kann sich so mancher eine Scheibe von abschneiden.
[/quote]
Zitieren
Lesezeichen