'############################################################################### '# # '# DMX 512 Sender 1.2c fürs c't-Lab # '# # '# (c) Günter Gerold # '# # '# DMX 512 Signale senden mit Bascom-Basic # '# Das Timing stimmt nur bei 8 MHz Quarz andere Quarze erfordern eine # '# Neuberechnung des Timings! # '############################################################################### $regfile = "m8def.dat" $crystal = 8000000 $baud = 38400 $lib "gg.lib" 'My i2c driver for the LCD $eeprom Const Gg_displayport = &H40 Config Lcdbus = 8 Config Lcd = 16 * 1a Dim _tempgg(3) As Byte Dim Temp As Word Dim Kanal As Word Dim Port As Word Dim Puffer(513) As Byte On Timer2 Ontimer0 Config Timer2 = Timer , Prescale = 64 Enable Timer2 Dim B As Byte 'die Werte von den 512 Kanälen B = 0 Dim C As Integer Dim D As Byte Ddrd = &B11111111 Config Portc.0 = Input Config Portc.1 = Input Portc = &B11 Config Pinc.0 = 0 Config Pinc.1 = 0 Dmxout Alias Portd.7 Trigger Alias Portd.6 'für mein altes Oszi ;-) Dis_ledrechts Alias Portd.3 Dis_ledactivityoff Alias Portd.2 Config Serialin = Buffered , Size = 63 , Bytematch = 13 Config Serialout = Buffered , Size = 63 Config I2cdelay = 1 Config Scl = Portc.5 'Configure i2c SCL Config Sda = Portc.4 Const Slave = &H40 Dis_ledactivityoff = 1 Dis_ledrechts = 1 Dim Ax(2) As Byte Echo Off Config Pinb.0 = Input 'Modulnummer +1 Config Pinb.1 = Input 'Modulnummer +2 Config Pinb.2 = Input 'Modulnummer +4 Portb.0 = 1 Portb.1 = 1 Portb.2 = 1 Declare Sub Writeserinp Declare Sub Checkserinp Declare Sub Parser Declare Sub Inkrementalgeber Declare Sub Store_puffer Declare Sub Read_puffer Dim Serinpstr As String * 63 Dim Serinpbuffer As String * 63 Dim Serinbuffarr(5) As Byte At Serinpbuffer Overlay Dim Mnemonicbuffer As String * 4 Dim Mnemonicbufferarray(5) As Byte At Mnemonicbuffer Overlay Dim Cr_received As Bit Dim Strsize As Byte Dim Mymainchannel As Byte Dim Mainchannel As Byte Dim Subchannel As Word Dim Wert As Byte Dim Zeichenpos As Byte Dim Tempnew As Word Tempnew = 300 Dim Differenz As Integer Dim Inkrement As Integer Dim Oldinkrement As Integer Dim Taster_pressed As Bit Taster_pressed = 1 Dim Dis_oben As Bit Dis_oben = 1 Dim Dis_kanal As Word Dis_kanal = 1 Dim Strbuffer As String * 20 Dim Doppelpunkt As String * 1 Doppelpunkt = ":" Dim Istgleich As String * 1 Istgleich = "=" Inkrement = 1 Dim Mnemonicarr(7) As String * 3 Mnemonicarr(1) = "DMX" Mnemonicarr(2) = "IDN" Mnemonicarr(3) = "AON" 'Alle Kanäle ein Mnemonicarr(4) = "AOF" 'Alle Kanäle aus Mnemonicarr(5) = "LEP" 'laden aus EEPROM Mnemonicarr(6) = "SEP" 'speichern in EEPROM Dim Cmd2subcharr(7) As Word Cmd2subcharr(1) = 0 Cmd2subcharr(2) = 513 Cmd2subcharr(3) = 514 Cmd2subcharr(4) = 515 Cmd2subcharr(5) = 516 Cmd2subcharr(6) = 517 Mymainchannel.0 = Not Pinb.0 'Moduladdresse von den Jumpern holen Mymainchannel.1 = Not Pinb.1 Mymainchannel.2 = Not Pinb.2 Enable Interrupts Cls Call Read_puffer Cursor Off 'clear the LCD display Lcd "DMX-" Lowerline Lcd "Tester" Declare Sub Dmx() Waitms 1000 Cls Waitms 2 Cursor On Cursor Blink Do 'zwischen hier und call DMX haben wir theoretisch eine Sekunde Zeit If Cr_received = 1 Then 'wenn was im ser. Buffer ist abholen Cr_received = 0 Input Serinpstr 'zum Abtrennen eines oder mehrerer LF am Anfang des Strings, das noch vom Vorgänger-String im Buffer steht While Asc(serinpstr) = 10 Strsize = Len(serinpstr) - 1 Serinpstr = Right(serinpstr , Strsize) Wend 'Hier ist der String empfangen und ein event. LF entfernt Call Checkserinp End If Oldinkrement = Inkrement Call Inkrementalgeber If Inkrement <> Oldinkrement Or Taster_pressed = 1 Then If Dis_oben = 1 Then If Inkrement < 1 Then Inkrement = 1 If Taster_pressed = 0 Then Dis_kanal = Inkrement Else Inkrement = Dis_kanal End If Upperline Lcd "Kan.:" ; Dis_kanal ; " " Lowerline Lcd "Wert:" ; Puffer(dis_kanal) ; " " Locate 1 , 5 Else If Inkrement > 255 Then Inkrement = 255 If Taster_pressed = 0 Then Puffer(dis_kanal) = Inkrement Else Inkrement = Puffer(dis_kanal) End If Lowerline Lcd "Wert:" ; Puffer(dis_kanal) ; " " Locate 2 , 5 End If Taster_pressed = 0 End If Ax(1) = 1 I2creceive Slave , Ax(1) , 1 , 1 If Ax(1).3 = 0 Then Call Store_puffer Elseif Ax(1).4 = 0 Then 'UP Dis_oben = 1 Taster_pressed = 1 Elseif Ax(1).5 = 0 Then 'Down Dis_oben = 0 Taster_pressed = 1 End If Call Dmx Loop Sub Store_puffer Dim J As Word For J = 1 To 512 Writeeeprom Puffer(j) , J Next End Sub Sub Read_puffer Dim K As Word For K = 1 To 512 Readeeprom Puffer(k) , K Next End Sub '############################################################################### '# # '# Das ist der eigentliche DMX512 Generator. Das Einfügen oder Weglassen # '# selbst von scheinbar unnötigen NOPs führt zu Timingproblemen. # '# # '############################################################################### Sub Dmx() Dmxout = 0 'Reset Waitus 87 nop nop nop nop nop nop Dmxout = 1 $asm .def Tmp1 = R17 'Marker .def Tmp2 = R18 ldi Tmp1, $5 Make_loop1: dec Tmp1 brne Make_loop1 nop nop $end Asm For Kanal = 0 To 512 '8 'Anzahl der Kanäle Temp = Puffer(kanal) '20 $asm .def Temp1 = R17 .def Temp2 = R18 .def Txbyte = R19 Putchar: LDS Txbyte, {Temp} '2 LDI Temp1 , 9 '1 COM Txbyte '1 SEC '1 Putchar0: BRCC Putchar1 '1 oder 2 nop '1 CBI Portd,Pd7 '2 RJMP putchar2 '2 Putchar1: SBI Portd,Pd7 '2 NOP '1 nop '1 Putchar2: LDI Temp2 , $7 '1 Sd_loop0: DEC Temp2 '1 BRNE Sd_loop0 nop LSR Txbyte '1 DEC Temp1 '1 BRNE putchar0 '1 oder 2 $end Asm nop nop nop Dmxout = 1 '2 genauso schnell wie SBI PORTD,PD7 in Assembler $asm .def Tmp1 = R17 .def Tmp2 = R18 ldi Tmp1, $1 '1 Make_loop0: '2 Stoppbits dec Tmp1 '1 brne Make_loop0 '1 oder 2 $end Asm Next Kanal '10 $asm .def Tmp1 = R17 .def Tmp2 = R18 ldi Tmp1, $7 Make_loop3: 'zusätzlich für Kanal 512 dec Tmp1 brne Make_loop3 $end Asm End Sub '--------------------------------------------------------------------------- ' Writeserinp ' Leitet den empfangenen String zum nächsten Modul weiter '--------------------------------------------------------------------------- Sub Writeserinp Print Serinpstr ' Befehl Weiterreichen End Sub '--------------------------------------------------------------------------- ' Serial0charmatch ' Im Eingangspuffer wurde ein "13" empfangen '--------------------------------------------------------------------------- Serial0charmatch: Cr_received = 1 Return '--------------------------------------------------------------------------- ' Checkserinp ' Hier der String abgeholt ' Der Mainchannel und der : wird geprüft '--------------------------------------------------------------------------- Sub Checkserinp If Asc(serinpstr) = 35 Then 'Strings mit # gleich weiterleiten Call Writeserinp Exit Sub End If Zeichenpos = Instr(serinpstr , ":") If Zeichenpos > 0 Then ' Doppelpunkt Gefunden Serinpbuffer = Left(serinpstr , Zeichenpos) Mainchannel = Val(serinpbuffer) If Mainchannel = Mymainchannel Then Call Parser Exit Sub Else Call Writeserinp Exit Sub End If Else 'kein : If Mainchannel = Mymainchannel Then 'Mainchannel müsste noch von vorigem Durchlauf drinstehen Call Parser Exit Sub Else 'anderes Modul Call Writeserinp Exit Sub End If End If End Sub '--------------------------------------------------------------------------- ' Parser ' Hier beginnt der Parser ' '--------------------------------------------------------------------------- Sub Parser Dim I As Word Dim A As Byte A = 1 Serinpbuffer = "" Mnemonicbuffer = "" Wert = 0 Subchannel = 0 'der ":" und alles davor kommt weg Zeichenpos = Len(serinpstr) - Instr(serinpstr , Doppelpunkt) Serinpbuffer = Right(serinpstr , Zeichenpos) For I = 1 To 4 'die nächsten 4 Stellen nach dem Doppelpunkt (4 wegen Leerzeichen) If Serinbuffarr(i) >= "A" And Serinbuffarr(i) <= "Z" Or Serinbuffarr(i) >= "a" And Serinbuffarr(i) <= "z" Then Mnemonicbufferarray(a) = Serinbuffarr(i) Incr A Mnemonicbufferarray(a) = 0 End If Next If Len(mnemonicbuffer) = 3 Then '3 Buchstaben sind angekommen Mnemonicbuffer = Ucase(mnemonicbuffer) For I = 0 To 25 If Mnemonicbuffer = Mnemonicarr(i) Then 'passende Zahl suchen Subchannel = Cmd2subcharr(i) Exit For End If Next End If A = 1 Mnemonicbuffer = "" For I = 1 To Instr(serinpbuffer , Istgleich) 'Den ganzen String bis Ende oder = nach Zahlen durchsuchen If Serinbuffarr(i) >= "0" And Serinbuffarr(i) <= "9" Then Mnemonicbufferarray(a) = Serinbuffarr(i) Incr A Mnemonicbufferarray(a) = 0 End If Next Subchannel = Subchannel + Val(mnemonicbuffer) 'gefundene Zahl mit dem Mnemonic addieren Zeichenpos = Len(serinpbuffer) - Instr(serinpbuffer , Istgleich) Serinpbuffer = Right(serinpbuffer , Zeichenpos) 'alles hinter = ist der Wert Wert = Val(serinpbuffer) Select Case Subchannel Case 1 To 512 Puffer(subchannel) = Wert Case 513 Print "#" ; Mymainchannel ; ":513=1.2c[DMX by GG06/2008]" Case 514 For I = 1 To 512 Puffer(i) = 255 Taster_pressed = 1 Next Case 515 For I = 1 To 512 Puffer(i) = 0 Taster_pressed = 1 Next Case 516 Call Read_puffer Case 517 Call Store_puffer Taster_pressed = 1 Print "#" ; Mymainchannel ; ":517 gespeichert!" End Select End Sub '--------------------------------------------------------------------------- ' Inkrementalgeber ' Routinen zum Abholen des Drehgeberwerts ' '--------------------------------------------------------------------------- Links: If D = 3 Then Incr Tempnew D = 0 Else Incr D End If Return Rechts: If D = 3 Then Decr Tempnew D = 0 Else Incr D End If Return Ontimer0: B = Encoder(pinc.0 , Pinc.1 , Links , Rechts , 0) Return Sub Inkrementalgeber If Tempnew <> 300 Then Differenz = Tempnew - 300 Tempnew = 300 C = Abs(differenz) Select Case C Case 1: Inkrement = Inkrement + Differenz Case 2 To 5: Differenz = Differenz * 5 Inkrement = Inkrement + Differenz Case 6 To 9: Differenz = Differenz * 10 Inkrement = Inkrement + Differenz End Select If Inkrement < 0 Then Inkrement = 0 If Inkrement > 512 Then Inkrement = 512 End If End Sub