Sie sind hier: Home » Rollladenempfänger » Programm RLE

Link für: Programm Rollladensteuerempfänger

'*******************************************************************************
'*********************      Rollladensteuerempfänger    ************************
'*******************************************************************************

'name                     : Rollladensteuerempfänger V0.5.bas
'copyright                : (c) 12.02.2019 jep
'purpose                  : Rollladensteuerung
'micro                    : Atmel 328P-PU
'
'Changelog:               :V0.1: Erste Version; im Prinzip o.k.
'                         :V0.2: wie V0.1 aber aufgeräumt
'                         :V0.3: Empfangslänge reduziert, Empfangspuffer angepasst,
'                                Watchdog eingeführt
'                         :V0.4: Statusausgaben nur wenn Minidigit auf ON steht
'                         :V0.5: Bereinigung
'                         :V0.6: neue Leiterplatte mit neuem Universaal-S/E hat einen 16MHz-Oszi
'
'offene Probleme          : Funktion Beschatten fehlt noch
'-------------------------------------------------------------------------------

$regfile = "m328Pdef.dat"
'$crystal = 8000000                                          '8MHz-Oszillator
$crystal = 16000000                                         '16MHz-Oszillator
$hwstack = 80
$swstack = 80
$framesize = 100
$baud = 115200


Declare Sub Rfm12_init
Declare Function Spitransfer(byval Dataout As Word) As Word


'################################## ADRESSEN  ##################################
'                                                                             ##
Dim Rollladensteuerempfaengeradresse As Byte                '                 ##
Rollladensteuerempfaengeradresse = 31                       'ist fix          ##
'###############################################################################


'DIP-Schalter: A0...A3 = 16 Möglichkeiten

Config PinC.0 = Input
PORTC.0 = 1                                                 'Pullup
Debuggen Alias Pinc.0                                       'Debuggen = 0 => DIP-Schalter_1 ON
Config Pinc.1 = Input
Portc.1 = 1                                                 'Pullup
Debuggen1 Alias PINC.1                                      'Debuggen1 = 0 => DIP-Schalter_2 ON
Config PINC.2 = Input                                       'DIP wird nicht gebaucht
Set Portc.2                                                 'Pullup
Config PINC.3 = Input                                       'DIP wird nicht gebaucht
Set Portc.3                                                 'Pullup

Ledg Alias PortB.0                                          'grüne LED
Config Ledg = Output
Set Portb.0
Ledr Alias Portb.1                                          'rote LED
Config Ledr = Output
Set Portb.1

'======================== SPI des ATmega328P ====================================

Ss Alias Portb.2
Miso Alias Pinb.4
Mosi Alias Portb.3
Sck Alias Portb.5

Config Ss = Output                                          'Slave select
Config Sck = Output                                         'SCK  ----> SCK (RFM12B)
Config Mosi = Output                                        'MOSI ----> SDI (RFM12B)
Config Miso = Input                                         'MISO <---- SDO (RFM12B)
Set Portb.2                                                 'Pullup

'CONFIG SPI = soft , MISO = PinB.4 , MOSI = PortB.3 , clock = PortB.5 , SS = PortB.2

'CONFIG SPI = HARD , INTERRUPT = ON , DATA_ORDER = MSB , MASTER = YES , POLARITY = LOW , PHASE = 0 , CLOCKRATE = 16 , NOSS = 0 , SPIIN = 0
'spiinit

'============================== Serielle Konfiguration =========================

Config Serialin = Buffered , Size = 10 , Bytematch = 13     'Carridge Return als Bytematch


'---------Variables-------------------------------------------------------------

Dim D As Word
Dim N As Byte
Dim r as word                                               'wird im Interrupt genutzt
Dim W as Word
Dim x as Byte
Dim Y as Byte
Dim Taste as Byte                                           'Tastencode
Dim charakter as string * 1                                 'Zeichen ab UART
Dim Befehl as string * 15                                   'serieller Empfangscode
Dim Sercode_da as Byte                                      'Merker
Dim Relais as Byte                                          'akt. Relaiszustand
Dim Relaisup as Byte                                        'akt. Relaiszustand für lower nibble
Dim Relaisdown as Byte                                      'akt. Relaiszustand für higher nibble
Dim Relais1 as Byte                                         'Relaiscode
Dim Relais1up as Byte                                       'Relaiscode für lower nibble
Dim Relais1down as Byte                                     'Relaiscode für higher nibble
Dim Relaisstate as Byte                                     'Speicher wenn min. 1 Relais aktiv
Dim Rel as string * 10                                      'Text für Relaisbezeichnung
Dim temp as Byte
Dim LZR as Byte                                             'aktuelle Laufzeit Relais
Const maxLZR = 60                                           'max. Laufzeit Relais in sec                                               '90 sec
Dim Schattenspeicher as Byte
Schattenspeicher = 0
Dim Beschatten as Byte
Dim Besch_Merker as Byte                                    'Merker-Counter dass Rücklauf stattfinden soll
Const max_Merker = maxLZR + 2                               'Wert wann Rücklauf stattfindet
Dim Ruecklaufzeit as Word                                   'für Rücklaufzeit in ms
Ruecklaufzeit = 2000                                        'Initalwert 2000ms


'========= Hier werden die zu empfangenen Bytes (9, max 50) abgelegt ============

'   1    2    3    4    5    6    7    8    9
'+----+----+----+----+----+----+----+----+----+
'|               Eingangsbytes                |
'+----+----+----+----+----+----+----+----+----+
'|LENe|DABe|SABe|CDBe|Code|Batterie |CRC2|CRC1|
'+----+----+----+----+----+----+----+----+----+
'

Const Maxanzahlempfangsbytes = 9                            'zu empfangende Datenmenge (maximal total 66 Byte)
Dim Irq_empfangsbytes(Maxanzahlempfangsbytes + 2) As Byte   'Empfangspuffer während Empfang  (etwas grösser)
Dim Irq_anzahlbytemax as Byte                               'Anzahl zu erwartende Empfangsbytes gemäss Empfang
Dim Irq_Akt_byte As Byte                                    'Zähler für die empfangenen Bytes
Dim Funkdaten_vorhanden As Bit

Dim Empfangsbytes(Maxanzahlempfangsbytes + 2) As Byte       'Empfangspuffer nach Empfang
Dim Lene As Byte At Empfangsbytes(1) Overlay                'Längenbyte
Dim DABe as Byte at Empfangsbytes(2) Overlay
Dim SABe as Byte at Empfangsbytes(3) Overlay
DIM CDBe as Byte at Empfangsbytes(4) Overlay
Dim Code as Byte At Empfangsbytes(5) Overlay
Dim Betr_spg As Word At Empfangsbytes(6) Overlay
Dim Crc_16e As Word At Empfangsbytes(8) Overlay             'CRC16 für Empfang
Dim PNe as Byte                                             'Paket-Nummer beim Empfang
Dim PNez as Byte
Dim SABez as Byte


'
'die Quittung besteht aus 4 Bytes
'   1    2    3    4
'+----+----+----+----+
'|  Sendebytes( )    |
'+----+----+----+----+
'|LENs|DABs|SABs|CDBs|
'+----+----+----+----+
'

Dim Sendebytes(5) As Byte                                   'Anzahl ist fix (mit CRC)
Dim Anzahlbyte_s As Byte                                    'Anzahl zu sendende Bytes
Dim LENs As Byte At Sendebytes(1) Overlay                   'Längenbyte
Lens = &B00001000                                           'Datenmode, fix 9 Bytes Daten  (8 da LEN NICHT mitgezählt wird)
Dim DABs As Byte At Sendebytes(2) Overlay                   'Adresse an den die Daten geschickt werden (DAB)
Dabs = Rollladensteuerempfaengeradresse                     'ist Rollladensteuerempfaengeradresse
Dim SABs As Byte At Sendebytes(3) Overlay                   'eigene Adresse (SAB)
'SABs = Sensoradresse
Dim CDBs As Byte At Sendebytes(4) Overlay                   'Kommandobyte fix
CDBs = &B01100000                                           'Datenmode, fordert ACK
Dim Paketzaehler As Byte                                    'Startwert ist 1
Paketzaehler = 1

 

'(
'================  8MHz-Oszi    Timerinterupt für 1 sec einstellen =============
Config timer1 = Timer , Prescale = 256                      'https://www.rmc-sachsen.de/?nav=bascom-timer-berechnung
Const Preload = 34286                                       'gilt für 8 MHz
On Timer1 sectic                                            'beim Interrupt zur sub sectic springen
enable Timer1                                               'Timer1 Interrupt freigeben
Dim neueSekunde as Byte
')

'================== 16 MHz Oszi  Timerinterupt für 1 sec einstellen ============
Config timer1 = Timer , Prescale = 256                      'https://www.rmc-sachsen.de/?nav=bascom-timer-berechnung
Const Preload = 3036                                        'gilt für 16 MHz
On Timer1 sectic                                            'beim Interrupt zur sub sectic springen
enable Timer1                                               'Timer1 Interrupt freigeben
Dim neueSekunde as Byte


'=================== Interrupt für die Tasten aktivieren =======================
'(
'>>>>>>>>>>>>   gilt für Version 1 der Universal-S/E-Leiterplatte <<<<<<<<<<<<<<

STB alias PortD.4
Config STB = Output
Dout alias PortD.5
Config Dout = Output
Clk alias PortD.6
Config Clk = Output

'Interrupt für die Tasten aktivieren

Config Pind.3 = Input                                       'ist Int1; Glück gehabt
PortD.3 = 1                                                 'Pullup
Config Int1 = Falling
On Int1 Tastenauswertung
Enable Int1

Dim Tastegedrueckt as Byte
')

'>>>>>>>>>>>>  gilt für Version 2 der Universal S/E-Leiterplatte  <<<<<<<<<<<<<<

STB alias PortD.5
Config STB = Output
Dout alias PortD.6
Config Dout = Output
Clk alias PortD.7
Config Clk = Output

'Interrupt für die Tasten aktivieren

Config Pind.4 = Input                                       'ist PCInt20: Pech
PortD.4 = 1                                                 'Pullup

On PCInt2 Tastenauswertung
Pcmsk2.PCINT20 = 1                                          'enable pcint20 = Port D.4
Enable Pcint2                                               'Freigabe von pcint2 (pcint16-pcint24)
Disable Interrupts

Dim Tastegedrueckt as Byte


'================== Interrupt für den Empfang aktivieren =======================

Config PinD.2 = Input                                       'Int0
PortD.2 = 1                                                 'Pullup
Nirq Alias PinD.2
Config Int0 = Falling
On Int0 RFM_Funkirq
Enable Int0
Disable Interrupts                                          'alle Interrupts sperren


'======== Timerinterupt für Zeitbegrenzung Interruptempfang einstellen ===========

Config Timer0 = Timer , Prescale = 256                      'https://www.rmc-sachsen.de/?nav=bascom-timer-berechnung
'Const Timer0_preload = 255 -((2 * 8 * 8000000) /(4800 * 256))       'für 2 Bytes: gilt für 8 MHz und 4800 Baud
Const Timer0_preload = 255 -((2 * 8 * 16000000) /(4800 * 256))       'für 2 Bytes: gilt für 16 MHz und 4800 Baud
On Timer0 Timer0_irq                                        'beim Interrupt Empfang stoppen
Enable Timer0                                               'Timer0 Interrupt freigeben
Stop Timer0


'================================= TWI ========================================

$lib "i2c_twi.lbx"                                          'TWI wird verwendet
Config Scl = Portc.5                                        'SCL pinname angeben
Config Sda = Portc.4                                        'DA Pinname angeben
I2cinit                                                     'und initialisieren

Config Twi = 400000                                         'gewünschte Clockfrequenz für $lib "i2c_twi.lbx"

Const PCF8574 = &H40                                        'Adresse (write-Adresse)
Const PCF8574A = &H70                                       'Adresse (write-Adresse)


'_______________________________________________________________________________

'                              ***************
'                     **********************************
'          ********************************************************
'*******************************************************************************
'***************************** PROGRAMMSTART ***********************************
'*******************************************************************************

'Programmstart:
'Config Watchdog = 512                                       'bei 8MHz; 4 sec. Timeout
Config Watchdog = 1024                                      'bei 16MHz; 4 sec. Timeout

Start Watchdog
   If Debuggen = 0 then                                     'mit DIP.1 schaltbar
      Print
      Print "File: " ; Version(3)
      Print "Adresse: " ; Str(Rollladensteuerempfaengeradresse)
      Print
   End if
gosub Clear_Empfangsbytes

Relais = &B00000000                                         'alle Relais auf 0 setzen
Gosub Relaisout1

Ss = 1
Sck = 0
Rfm12_init                                                  'RFM12B initialisieren

IRQ_akt_Byte = 0
Funkdaten_vorhanden = 0
n = 0

Enable Interrupts

'Auf neue Anfangssequenz warten
r = Spitransfer(&H82c8)                                     'Empfänger aktivieren
r = Spitransfer(&Hca83)                                     'FIFO einstellen/aktivieren

'##############################################################################
'############################## Hauptprogramm ##################################

Do

   If neueSekunde = 1 then
      gosub Relaislaufzeit_pruefen                          'Relaislaufzeit abgelaufen?
      gosub Test_Besch_Merker                               'Beschattung aktiv?
      neueSekunde = 0
   End if

   If Tastegedrueckt = 1 then                               'lokale Taste betätigt
      waitms 10                                             'Entprellzeit
      I2Creceive PCF8574 , Taste                            'Taste holen
      Tastegedrueckt = 0                                    'Merker löschen
         If Debuggen = 0 then                               'mit DIP.1 schaltbar
            Print "Tastencode: " ; Bin(Taste)
           Print
         End If
      Select Case Taste
         Case &B11111110 : Relais1 = &B00000001 : Rel = "Badu"       'T1  Relais 1 Bad auf
         Case &B11111101 : Relais1 = &B00010000 : Rel = "Badd"       'T2  Relais 5 Bad ab
         Case &B11111011 : Relais1 = &B00000010 : Rel = "ESZu"       'T3  Relais 2 SZ auf
         Case &B11110111 : Relais1 = &B00100000 : Rel = "ESZd"       'T4  Relais 6 SZ ab
         Case &B11101111 : Relais1 = &B00000100 : Rel = "KZSu"       'T5  Relais 3 KZS auf
         Case &B11011111 : Relais1 = &B01000000 : Rel = "KZSd"       'T6  Relais 7 KZS ab
         Case &B10111111 : Relais1 = &B00001000 : Rel = "KZNu"       'T7  Relais 4 KZN auf
         Case &B01111111 : Relais1 = &B10000000 : Rel = "KZNd"       'T8  Relais 8 KZN ab
         Case &B11111010 : Relais1 = &B00000011 : Rel = "B+Eu"       'T1 + T3 Bad + ESZ auf
         Case &B11110101 : Relais1 = &B00110000 : Rel = "B+Ed"       'T2 + T4 Bad + ESZ ab
      End Select
      if Taste <> &HFF then gosub Relaisschalten1
   end if

   If Sercode_da = 1 then gosub Code_auswerten              'ist was im seriellen Puffer

   If Funkdaten_vorhanden = 1 then                          'zuerst CRC prüfen
      Y = Empfangsbytes(1) - 1                              'Datenlänge über alles ohne CRC16
      Crc_16e = Crc16(Empfangsbytes(1) , Y )
         If Debuggen = 0 then                               'mit DIP.1 schaltbar
            Y = Empfangsbytes(1) + 1
            Print
            Print "RxD:  ";
            For x = 1 to y
               Print Hex(Empfangsbytes(x)) ; " ";
            next x
            Print
            Print "SABe: " ; Hex(SABe)
            Print "CRC gerechn.: " ; hex(CRC_16e)           'CRC-Vergleich gerechnet
            Print "CRC Empfang:  " ; hex(Empfangsbytes(y)) ; hex(Empfangsbytes(y -1))       'mit Empfang"
         End If
      If Empfangsbytes(Empfangsbytes(1)) <> Low(crc_16e) Then
         If SABe => 17 and SABe < 21 then                   'Ausscheidung 5 Moduladressen 17...20
            gosub neg_Quittung
            goto Ende
         End if
      End if
      If Empfangsbytes(Empfangsbytes(1) + 1) <> High(crc_16e) Then
         If SABe => 17 and SABe < 21 then                   'Ausscheidung 5 Moduladressen 17...20
            gosub neg_Quittung
            goto Ende
         End if
      End if
      If SABe => 17 and SABe < 21 then                      'Ausscheidung 5 Moduladressen 17...20
         PNe = Empfangsbytes(4) and &B00001111              'PNe ausmaskieren

         'hier wird verhindert dass, wenn der Sender die Quittung nicht empfängt,
         'bei der Sendewiederholung das Relais wieder geschaltet wird.
         If SABe = SABez and PNe = PNez then                'gleiche Adresse und Paketnummer wie zuvor
            gosub pos_Quittung                              'pos. Quittung senden
            Goto Ende                                       'und ohne Relaisschalten weiter
         End if
         SABez = SABe                                       'Adresse zwischenspeichern
         PNez = PNe                                         'Paketnummer zwischenspeichern

         gosub pos_Quittung                                 'nur wenn erlaubte Sender
         gosub Relaisschalten
      End if
   Ende:
      Funkdaten_vorhanden = 0
      LEDg = 1                                              'grüne LED aus
   End if
   Reset Watchdog                                           'Watchdog triggern
Loop


'###############################################################################
'###############################################################################


'============================== Sekundenroutine ================================

sectic:
   Timer1 = Preload
   neueSekunde = 1
Return

'===============================================================================


'******************************* Tastaturinterrupt *****************************

Tastenauswertung:
   Tastegedrueckt = 1
   PCIFR.PCIF2 = 1                                          'Flagregister zurücksetzen
Return

'-------------------------------------------------------------------------------

Clear_Empfangsbytes:
   for n = 1 to Maxanzahlempfangsbytes
      Empfangsbytes(n) = 0
   Next n
Return


'-------------------------------------------------------------------------------
'-------------------    Unterprogramme für WEB-Auswertung     ------------------
'-------------------------------------------------------------------------------

Serial0charmatch:                                           'Interrupt vom seriellen Eingang
   Befehl = ""
   While Ischarwaiting() = 1                                'Zeichen sind da
      charakter = inkey()                                   'abholen
      Befehl = Befehl + charakter
      If Len(Befehl) = 4 then                               'es werden nur 4 Zeichen empfangen
         Clear serialin
      end if
   WEND
   Clear serialin
   serCode_da = 1
Return


'-------------------------------------------------------------------------------

Code_auswerten:

'Print Befehl

      if Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "vor Select Case: " ; Befehl
      end if
   Select Case Befehl                                       'Auswerung mittels Select Case
      Case "BADu" :
         Relais1 = &B00000001                               'und direktes Steuern der Relais
         Befehl = ""
      Case "BADd"
         Relais1 = &B00010000
         Befehl = ""
      Case "ESZu" :
         Relais1 = &B00000010
         Befehl = ""
      Case "ESZd"
         Relais1 = &B00100000
         Befehl = ""
      Case "KZSu" :
         Relais1 = &B00000100
         Befehl = ""
      Case "KZSd"
         Relais1 = &B01000000
         Befehl = ""
      Case "KZNu" :
         Relais1 = &B00001000
         Befehl = ""
      Case "KZNd"
         Relais1 = &B10000000
         Befehl = ""
      Case "ARLu" :
         Relais1 = &B00001111
         Befehl = ""
      Case "ARLd"
         Relais1 = &B11110000
         Befehl = ""
      Case else : Goto Rest_decodieren
   End Select
   Befehl = ""
   serCode_da = 0
      if Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "nach Select Case:  " ; Bin(Relais1)
      end if
   gosub Relaisschalten1
Return

Rest_decodieren:
   Select Case Befehl
      Case "BADs"
         Relais1 = &B00010000
         Befehl = ""
      Case "ESZs"
         Relais1 = &B00100000
         Befehl = ""
      Case "KZSs"
         Relais1 = &B01000000
         Befehl = ""
      Case "KZNs"
         Relais1 = &B10000000
         Befehl = ""
      Case "ARLs"
         Relais1 = &B11110000
         Befehl = ""
      Case else :
         if Debuggen1 = 0 then
            Print "NIX"                                     'mit DIP.2 schaltbar
         end if
         Befehl = ""
         serCode_da = 0
         goto war_nix
   End Select
   Befehl = ""
   serCode_da = 0
      if Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "nach Select Case: " ; Bin(Relais1)
      end if
   gosub Beschatten_down
war_nix:
Return

 

'****************************** Relais schalten ********************************
'Im upper Nibble ist down
'Im lower Nibble ist up


Relaisschalten:

   if code = &H10 then Relais1 = &B00000001 : Rel = "Badu"  'Relais 1 Bad up
   if code = &H11 then Relais1 = &B00010000 : Rel = "Badd"  'Relais 5 Bad down
   if code = &H12 then Relais1 = &B00000010 : Rel = "ESZu"  'Relais 2 ESZ up
   if code = &H13 then Relais1 = &B00100000 : Rel = "ESZd"  'Relais 6 ESZ down
   if code = &H14 then Relais1 = &B00000100 : Rel = "KZSu"  'Relais 3 KZS up
   if code = &H15 then Relais1 = &B01000000 : Rel = "KZSd"  'Relais 7 KZS down
   if code = &H16 then Relais1 = &B00001000 : Rel = "KZNu"  'Relais 4 KZN up
   if code = &H17 then Relais1 = &B10000000 : Rel = "KZNd"  'Relais 8 KZN down

Relaisschalten1:                                            'Vorbereitung, alle Vergleiche erfolgen
                                                            'im lower Nibble
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "Relais1: " ; Bin(Relais1) ; " ---> " ; Rel
      End If
   Relais1up = Relais1 and &B00001111                       'Up-Relais ist im lower Nibble
   Relais1down = Relais1
   Shift Relais1down , Right , 4                            'Down-Relais ins lower Nibble
   Relaisup = Relais and &B00001111                         'Up-Relais im lower Nibble
   Relaisdown = Relais
   Shift Relaisdown , Right , 4                             'Down-Relais ins lower Nibble
   If Relais1 > 15 then goto RLdown

RLup:
   temp = Relais1up
   temp = temp AND Relaisdown                               'schauen, ob Gegenrelais gezogen
   IF temp = 0 THEN goto nichtgez                           'nein, springen
   temp = Relais1up                                         'ja, nochmals laden
   temp = temp XOR &H0F                                     'lower nibbble invertieren
   relaisdown = relaisdown AND temp                         'Relais zurücksetzen
   GOTO relaisout                                           'und ausgeben
nichtgez:
   temp = Relais1up                                         'Maske wieder laden
   temp = temp AND relaisup                                 'Zustand gewünschtes Relais?
   IF temp = 0 THEN goto inaktiv                            'Sprung wenn nicht gezogen
   Relais1up = Relais1up XOR &H0F                           'Maske invertieren
   relaisup = relaisup AND Relais1up                        'Relais zurücksetzen
   GOTO relaisout                                           'und ausgeben
inaktiv:
   relaisup = relaisup OR Relais1up                         'Relais aktivieren
   GOTO relaisout                                           'und ausgeben

RLdown:
   temp = Relais1down
   temp = temp AND Relaisup                                 'schauen, ob Gegenrelais gezogen
   IF temp = 0 THEN goto nichtgez1                          'nein, springen
   temp = Relais1down                                       'ja, nochmals laden
   temp = temp XOR &H0F                                     'lower nibbble invertieren
   relaisup = relaisup AND temp                             'Relais zurücksetzen
   GOTO relaisout                                           'und ausgeben
nichtgez1:
   temp = Relais1down                                       'Maske wieder laden
   temp = temp AND relaisdown                               'Zustand gewünschtes Relais?
   IF temp = 0 THEN goto inaktiv1                           'Sprung wenn nicht gezogen
   temp = temp XOR &H0F                                     'Maske invertieren
   relaisdown = relaisdown AND temp                         'Relais zurücksetzen
   GOTO relaisout                                           'und ausgeben
inaktiv1:
   relaisdown = relaisdown OR Relais1down                   'Relais aktivieren
   GOTO relaisout                                           'und ausgeben

Relaisout:
   temp = Relaisdown
   Shift temp , left , 4                                    'Down ins obere Nibble verschieben
   Relais = temp or Relaisup                                'und zusammenfügen
   Relaisstate = 1                                          'Status setzen
   LZR = 0                                                  'Timer zurückstellen

Relaisout1:
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "vor Herausschieben, Relais: " ; Bin(Relais)
         Print
      End If
   shiftout Dout , Clk , Relais , 0                         'auf neg. Flanke schieben, pos. einlesen; MSB first
   STB = 1                                                  'und mit Strobe speichern
   waitus 1
   STB = 0
Return


Relaislaufzeit_pruefen:
   If Relaisstate = 1 then LZR = LZR + 1
      If Debuggen = 0 then
         Print "LZR: " ; LZR
      End If
   If LZR = maxLZR then
      Relaisstate = 0                                       'kein aktives Relais mehr nötig
      LZR = 0                                               'Relaislaufzeit zurückstellen
      Relais = &B00000000                                   'alle Relais ausschalten
      Gosub Relaisout1
   End if
Return


'===============================================================================

Beschatten_down:
   Schattenspeicher = Relais1                               'entspr. Bit im Speicher setzen
   gosub Relaisschalten1
   Besch_Merker = max_Merker                                'Start Rücklauf
Return


Test_Besch_Merker:
   if Besch_Merker <> 0 then                                'Beschattung noch aktiv
      Besch_Merker = Besch_Merker - 1
         If Debuggen = 0 then                               'mit DIP.1 schaltbar
            Print "Merker: " ; Besch_Merker
         End If
      if Besch_Merker = 0 then gosub Beschatten_up          'abgelaufen, nun noch up
   end if
Return


Beschatten_up:
   shift Schattenspeicher , right , 4                       'in die auf-Stellung schieben
   Relais1 = Schattenspeicher                               'Relais Ansteuerung
   Schattenspeicher = 0                                     'Speicher wieder löschen
   gosub Relaisschalten1
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "kurz hochfahren: " ; Bin(Relais)
      End If
   waitms Ruecklaufzeit                                     'Zeit für Rücklauf in ms
   Relais = &B00000000                                      'und alle Relais wieder aus
   gosub Relaisout1
   LZR = 0                                                  'Timer zurückstellen
   Relaisstate = 0
   Besch_Merker = 0                                         'nochmals zur Vorsicht
Return


'====================== Quittungen zusammenstellen und senden ==================

neg_Quittung:
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "QN  ";
      End if
   Sendebytes(1) = 3                                        '=LEN
   Sendebytes(2) = SABe                                     'zuvor empfangene Adresse
   Sendebytes(3) = Rollladensteuerempfaengeradresse         'eigene Adresse
   Sendebytes(4) = &B10100000                               '=NACK  (hA0)
   gosub RFM12_senden
Return


pos_Quittung:
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "QP  ";
      End if
   Sendebytes(1) = 3                                        '=LEN
   Sendebytes(2) = SABe                                     'zuvor empfangene Adresse
   Sendebytes(3) = Rollladensteuerempfaengeradresse         'eigene Adresse
   Sendebytes(4) = &B11100000 or PNe                        '=ACK  (hEx)
   gosub RFM12_senden
Return


'========================== Sendet die Quittung ================================
'Die Senderoutine ist für Polling des Senders geschrieben,
'es wird gewartet bis ein Byte gesendet ist


Rfm12_senden:
   Ledr = 0
   Disable INT0                                             'Empfänger ist sowieso abgeschaltet
      If Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "TxD: ";                                     'LED ein
         Print Hex(Sendebytes(1)) ; " ";
         Print Hex(Sendebytes(2)) ; " ";
         Print Hex(Sendebytes(3)) ; " ";
         Print Hex(Sendebytes(4)) ; " ";
         Print
      End if
   Anzahlbyte_s = Sendebytes(1) + 1                         'damit alle Bytes übertragen werden (+ LEN)
   D = Spitransfer(&H8238)                                  'Enable Transmitter; enable Synthesizer ;enable Crystal Osc
   Gosub Rfm12_warten
   D = Spitransfer(&Hb8aa)
   Gosub Rfm12_warten
   D = Spitransfer(&Hb8aa)
   Gosub Rfm12_warten
   D = Spitransfer(&Hb82d)
   Gosub Rfm12_warten
   D = Spitransfer(&Hb8d4)
   For N = 1 To Anzahlbyte_s
      Gosub Rfm12_warten
      D = &HB800 + Sendebytes(n)
      D = Spitransfer(d)
   Next N
   Gosub Rfm12_warten
   D = Spitransfer(&Hb8aa)
   Gosub Rfm12_warten
   D = Spitransfer(&Hb8aa)
   Gosub Rfm12_warten

   D = Spitransfer(&H8281)                                  'Tx aus, Rx ein
   D = Spitransfer(&H0000)                                  'Tx-Interrupt löschen

   D = Spitransfer(&HCA83)                                  'FIFO und Reset Mode

   Eifr.intf0 = 1                                           'Eventuell anstehenden Interrupt löschen
   Enable INT0                                              'Empfänger-Interrupt freigeben
   Ledr = 1                                                 'LED aus
Return


Rfm12_warten:
   Ss = 0
   Do
   Loop Until Miso = 1
Return


'*****************  Empfangs-Interrupt des Funkmoduls RFM12  ********************

Rfm_funkirq:
   Disable Int0                                             'während Interruptbehandlung ausschalten
   Timer0 = Timer0_preload
   Start Timer0                                             'Start Zeitüberwachung (Byteweise)
   Incr Irq_akt_byte                                        'aktueller Bytezähler erhöhen (Startwert ist 0)
   Irq_empfangsbytes(irq_akt_byte) = Spitransfer(&Hb000)    'Empfangsbyte holen und abspeichern
   If Irq_akt_byte = 1 Then                                 'ist erstes Byte
      If Irq_empfangsbytes(1) < 4 or Irq_empfangsbytes(1) >= Maxanzahlempfangsbytes then       'Wenn LEN grösser ist als die max. erwartete Anzahl
         Stop Timer0                                        'dann abbrechen
         Irq_akt_byte = 0                                   'Bytezähler löschen
         R = Spitransfer(&Hca81)                            'FIFO FILL zurücksetzen
         R = Spitransfer(&Hca83)                            'FIFO FILL aktivieren; auf neue Sync-Sequenz warten
         Goto Interrupt_ende
      Else
         Irq_anzahlbytemax = Irq_empfangsbytes(1) + 1       'im ersten Byte steht die Anzahl folgender Datenbytes
      End if
   End If
   If Irq_akt_byte = Irq_anzahlbytemax Then                 'max. Anzahl Bytes erreicht
      Stop Timer0
      R = Memcopy(irq_empfangsbytes(1) , Empfangsbytes(1) , Irq_anzahlbytemax)       'umkopieren
      Funkdaten_vorhanden = 1                               'Merker setzen
      LEDg = 0                                              'grüne LED ein
      Irq_akt_byte = 0                                      'Bytezähler löschen
      R = Spitransfer(&Hca81)                               'FIFO FILL zurücksetzen
      R = Spitransfer(&Hca83)                               'FIFO FILL aktivieren; auf neue Sync-Sequenz warten
   End If
Interrupt_ende:
   Eifr.intf0 = 1                                           'Eventuell anstehenden Interrupt löschen
   Enable Int0
Return

Timer0_irq:
   Stop Timer0                                              'Interrupt-Ueberwachung abgelaufen --> Stop
   Irq_akt_byte = 0                                         'Bytezähler löschen
   Funkdaten_vorhanden = 0                                  'Eventuellen Merker löschen

   R = Spitransfer(&H82c8)                                  'Empfänger aktivieren

   R = Spitransfer(&Hca81)                                  'FIFO FILL zurücksetzen
   R = Spitransfer(&Hca83)                                  'FIFO FILL aktivieren; auf neue Sync-Sequenz warten
   Eifr.intf0 = 1                                           'Eventuell anstehenden Interrupt löschen
      if Debuggen = 0 then                                  'mit DIP.1 schaltbar
         Print "Timeout"
      end if
Return

'_______________________________________________________________________________

'(
Function Spi_transfer(byval Dataout As Word) As Word
Local Dat_in_h as Byte
Local Dat_in_l as Byte

Dat_in_h = Spimove(High(Dataout))
Dat_in_l = Spimove(Low(Dataout))
Spitransfer = makeint(Dat_in_l , Dat_in_h)

End Function
')

 

Function Spitransfer(byval Dataout As Word) As Word

   Local Nspi As Integer
   Local Dspi As Integer
   Local Dmiso As Word


   Ss = 0
   Dmiso = 0
   For Nspi = 1 To 16
      Dspi = Dataout And &H8000
      If Dspi = 0 Then
         Mosi = 0
      Else
         Mosi = 1
      End If
      Dataout = Dataout * 2
      Dmiso = Dmiso * 2
      Dmiso = Dmiso + Miso
      Sck = 1
      Waitus 1
      Sck = 0
   Next Nspi
   Ss = 1
   Spitransfer = Dmiso
End Function


'_______________________________________________________________________________

'RFM-Initialisierung

Sub Rfm12_init
   Local Wert As Word

   X = 0
   Restore Datainit3                                        'Initialisierungsfolge
   Do
      Read Wert
      D = Spitransfer(wert)
      Incr X
   Loop Until Wert = 0
   Waitms 200
   R = Spitransfer(&H0000)
End Sub

'_______________________________________________________________________________


End
'********************************************************************
                                                       ' Programmende

'---------------------------------------------------

'Funkmodul Initialisierungsdaten mit 9600 Baud
Datainit3:
   Data &H80E8%                                             ' Enable: 868 Mhz;XTAL cap=12pf; TX-Register; RX-Fifo
   Data &H82D9%                                             ' Enable: Receiver; Crystal Osc; Base Band Block; Synthesizer, Disable Low-bat Detector; Transmitter; Wake-Up-Timer; Clock output Pin
   Data &HA67C%                                             ' Frequenz 868.3 MHz
'   Data &HA6F4%                                             ' Frequenz 868.9 MHz
   Data &HC647%                                             ' &Hc647=Datenrate '4.8kbps; C623=9600kbps; C611 =19200
   Data &H95C0%                                             ' Vdi , Fast , 67 kHz , 0db , -79dbm           !!!!!!!!!!
   Data &HC2AD%                                             ' Fiter=Digital; Recover Mode=Auto; Quality Threshold=4; Recovery Speed=Slow
   Data &HCA81%                                             ' FIFO INT Level=8; Sync on=2;Fifo Fill Start=Sync; Reset Sensitivity=High; Disable:FIFO Fill Enabled
   Data &HC483%                                             ' Enable: AFC Mode; AFC; Frequency Offset Register Disable: High Accuracy; Strobe
   Data &H9820%                                             ' Frequenz Shift=POS; Power Out=0 dB; Deviation=45 khz
   Data &HE000%                                             ' WakeUp-Timer=5s
   Data &HC800%                                             ' Duty Cycle = Infinity % OFF
   Data &HC000%                                             ' Low batterie=2,2V; Clock Pin=1 Mhz
   Data &HCED4%                                             ' Synchron Pattern
   Data &HCC76%                                             ' PLL Settings
   Data &H0000%                                             ' Status lesen, irqs zurückstellen
   Data 0%                                                  ' Ende initialisierung

'_______________________________________________________________________________


 
besucherzaehler-kostenlos.de