'###############################################################################
'# #
'# 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
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
Ddrd = &B11111111
Config Portc.0 = Input
Config Portc.1 = Input
Portc = &B11
Config Pinc.0 = 0
Config Pinc.1 = 0
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
Dmxout Alias Portd.7
Trigger Alias Portd.6 'für mein altes Oszi ;-)
Dis_ledrechts Alias Portd.3
Dis_ledactivityoff Alias Portd.2
On Timer2 Ontimer0
Config Timer2 = Timer , Prescale = 64
Enable Timer2
Declare Sub Writeserinp
Declare Sub Checkserinp
Declare Sub Parser
Declare Sub Inkrementalgeber
Declare Sub Store_puffer
Declare Sub Read_puffer
Dim _tempgg(3) As Byte
Dim Temp As Word
Dim Kanal As Word
Dim Puffer(513) As Byte
Dim B As Byte 'die Werte von den 512 Kanälen
Dim C As Integer
Dim D As Byte
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 Ax(2) 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 Doppelpunkt As String * 1
Doppelpunkt = ":"
Dim Istgleich As String * 1
Istgleich = "="
Inkrement = 1
Dis_ledactivityoff = 1
Dis_ledrechts = 1
Echo Off
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 Gg_displayport , 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