Liste der Anhänge anzeigen (Anzahl: 1)
DMX mit Bascom
Hi folks,
habe mal vor längerem einen DMX-Tester angefangen. Das Empfangen mit Bascom funktioniert einwandfrei und kommt ohne Assembler aus. Das Senden hab ich noch nicht drin, da ich keine Zeit mehr dafür habe.
Aber vielleicht kanns jemand brauchen. Ich setze den Tester ab und zu bei einem Bekannten ein der ein Theater belichtet um Fehler zu suchen.
mfg.
Joachim
DMX-Signal in Bascom empfangen
Hi, ich habe den Quelltext als Download in meiner Mail mit drin. Aber man muss anscheinend angemeldet sein um ihn zu bekommen. Hier dann das ganze nochmal. Ich hoffe es klappt diesmal.
Code:
' Bedienung:
' System startet im Receivermodus
' Zeigt Kanal mit Wert an
'
' Drücken der Kanal-Taste
' Nochmal Kanal sucht nächsten Kanal mit Daten
' 0-9 Kanal eingeben und Enter
' + Taste erhöht den Kanal
' - Taste erniedriegt den Kanal
'
' Drücken der Data-Taste für 0-255
' Nochmal Data 0-100
' Nochmal Data Poti
' Nochmal das ganze und dann von vorne
' 0-9 Wert eingeben und Enter
' + Taste erhöht den Wert
' - Taste erniedriegt den Wert
'
' Durch Drücken von Enter wird Menü angezeigt
' ESC bricht ab
'
' Tastatur:
' 0-9
' Enter
' ESC
' +
' -
' Kanal
' Data
'
' Display 4x20
' 12345678901234567890 12345678901234567890
' 1 KANAL: xxx/XXX REC KANAL: XXX - XXX REC
' 2 WERT BINAER : XXX 255 X x _Xx X
' 3 PROZENT: XXX 0 XxX_xxXXX______X
' 4 Statuszeile
'
' 12345678901234567890 12345678901234567890
' 1 1 Receiver 1 Kanal 1 Ein Kanal
' 2 2 Receiver 16 Kanal 2 16 Kanal
' 3 Transmitter
' 4
'
' ************************************************************
' ****** Programm
' ************************************************************
$crystal = 8000000
$baud = 250000
Config Kbd = Portb , Debounce = 20 , Delay = 50
Config Lcdpin = Pin , Db4 = Portc.4 , Db5 = Portc.5 , Db6 = Portc.6 , Db7 = Portc.7 , E = Portc.3 , Rs = Portc.2
Config Lcd = 20 * 4
Config Pind.7 = Output
Config Pind.6 = Output
Config Pind.5 = Output
Config Adc = Single , Prescaler = Auto
Config Timer2 = Timer , Prescale = 1024
Dim Recval As Byte ' Wert via Serielle
Dim Status As Byte ' Statusbyte
Dim Modus As Byte ' 0 = Receiver, 1 = Transmitter
Dim Aktmodus As Byte
Dim Dmx_data As Byte ' Wert des anzeigenden Kanal 0-255
Dim Proval As Integer ' und in Prozent 0-100
Dim Tempchannel As Integer ' Kanal der eingegeben wird
Dim Viewchannel As Integer ' Angezeigter Kanal
Dim Keyval As Byte ' gedrueckte Taste
Dim Oldkey As Byte ' gedrueckte Taste
Dim Univers As Byte ' Universumsnummer
Dim Max_dmx_data As Integer ' maximal gesendete Daten
Dim Dmx_count As Integer ' Zaehler beim Empfang
Dim X As Integer ' Hilfsvariable
Dim Temp As Integer ' Hilfsvariable
Dim View_val As Integer
Dim Waittime As Integer
Dim View_string As String * 6 ' String mit Wert
Dim Num_row As Byte
Dim Num_col As Byte
Dim Num_min As Integer
Dim Num_max As Integer
Dim Num_len As Byte
Dim Num_flags As Byte
Dim Num_wert As Integer
Dim Num_string As String * 6
Dim Num_temp As Integer
Num_start Alias Num_flags.0
Num_end Alias Num_flags.1
Num_error Alias Num_flags.7
Dec_key Alias 10 '
Inc_key Alias 11
Data_key Alias 14
Channel_key Alias 13
Esc_key Alias 12
Enter_key Alias 15
Receive Alias 1 ' Empfängermodus
Transmit Alias 2 ' Sendemodus
Menue Alias 255 ' Menümodus
Foundflag Alias Status.0 ' Wert gefunden
Searchflag Alias Status.1 ' Wert am suchen
Waitflag Alias Status.2 ' Warte auf Suchergebnis
View Alias Status.3
Yes Alias 1
No Alias 0
Rs485_dir Alias Portd.6 ' Richtung des RS485-Bausteins
Lcd_light Alias Portd.7
Buzzer Alias Portd.5 ' Beeper Alias
Dmx_led Alias Portd.4
Cls
Cursor Off Noblink
Set Lcd_light
Set Dmx_led
Lcd " DMX-TESTER V0.1"
Locate 2 , 1
Lcd " (C) JR2004"
Locate 3 , 1
Lcd "fossie@fakedomain.de"
' Copyrightmeldung
For Temp = 1 To 5
Toggle Lcd_light
Toggle Dmx_led
Waitms 500
Next X
Locate 4 , 1
Lcd " Press any key"
Sound Buzzer , 250 , 600
Do
Loop Until Getkbd() <> 16
Sound Buzzer , 100 , 100
Modus = Receive
View = Yes
Aktmodus = 0
Tempchannel = 0
Viewchannel = 1
Univers = 0
Max_dmx_data = 0
Set Ucr.chr9 ' 9 Bit als 2 Stopbits setzen
On Timer2 Timer_int
On Urxc Dmx_receive ' Interruptroutine zum Empfang
Enable Timer2 ' enable the timer interrupt
Enable Urxc
Enable Interrupts
' ###### Hauptschleife ######
Do
If Lcd_light = 1 Then ' Wenn licht dann und Zeit abgelaufen
If Waittime > 300 Then Reset Lcd_light ' licht aus
End If
If Modus <> Aktmodus Then ' Modus gewechselt
Cls ' LCD loeschen
If Modus = Receive Then ' Empfangsmodus
Reset Rs485_dir
Set Ucr.rxen ' Empfang aktivieren fuer Empfang
Lcd "KANAL:"
Locate 1 , 18
Lcd "REC"
Locate 2 , 1
Lcd "WERT: b %"
Elseif Modus = Transmit Then ' Sendemodus
'Transmitter
Set Rs485_dir
Reset Ucr.rxen
Elseif Modus = Menue Then ' Menümodus
Reset Rs485_dir
Reset Ucr.rxen
Lcd "1 Receiver 1 Kanal"
Locate 2 , 1
Lcd "2 Receiver 16 Kanal"
Locate 3 , 1
Lcd "3 Transmitter"
End If
Aktmodus = Modus
End If
If Modus = Receive Then ' Receiver
If View = Yes Then ' wenn anzeige erlaubt
Locate 1 , 7
View_val = Viewchannel
Gosub Using
Lcd View_string ; "/"
View_val = Max_dmx_data
Gosub Using
Lcd View_string
Locate 2 , 7
View_val = Dmx_data
Gosub Using
Lcd View_string
Locate 2 , 13
Proval = 100 * Dmx_data
Proval = Proval / 255
View_val = Proval
Gosub Using
Lcd View_string
Cursor Off
Locate 4 , 1
Lcd " "
End If
Keyval = Getkbd() ' Lese Tastatur aus
If Keyval <> Oldkey Then
Oldkey = Keyval
If Keyval <> 16 Then
Sound Buzzer , 60 , 100
Set Lcd_light
Waittime = 0
End If
Keyval = Lookup(keyval , Keypad) ' und schau in Tabelle nach
Select Case Keyval
Case 255 ' keine Taste gedrückt
' do nothing
Case Esc_key ' ESC bricht ab
Set View
Num_flags = 0
Reset Searchflag
Reset Waitflag
Reset Num_start
Case Dec_key ' Erniedrige Kanal
Decr Viewchannel
If Viewchannel < 1 Then Viewchannel = Max_dmx_data
Case Inc_key ' Erhoehe Kanal
Incr Viewchannel
If Viewchannel > Max_dmx_data Then Viewchannel = 1
Case Channel_key ' Kanaltaste gedrueckt
If Num_start = 0 Then ' zuerst mal Eingabe aktivieren
Locate 4 , 1 ' Suchmeldung ausgeben
Lcd "Kanalnummer eingeben"
Num_row = 1
Num_col = 7
Num_min = 1
Num_max = Max_dmx_data
Num_len = 3
Gosub Numinput
Else ' Suchlauf nach Daten
If Max_dmx_data > 0 Then ' wenn ueberhaupt was da
Tempchannel = Viewchannel ' dann mal merken wo wir waren
Incr Viewchannel ' den naechsten Kanal suchen
If Viewchannel > Max_dmx_data Then Viewchannel = 1
Cursor Off ' Cursor aus
Locate 4 , 1 ' Suchmeldung ausgeben
Lcd "Searching... "
Set Waitflag ' und Flags setzen
Set Searchflag
Reset Num_start
Else
'Beep Fail
Sound Buzzer , 250 , 350
End If
End If
Case Enter_key
If Num_start = 1 Then ' Enter gedrückt
Gosub Numinput
If Num_end = 1 Then
If Num_error = 0 Then
Viewchannel = Num_wert
Else
'Beep_fail
Sound Buzzer , 150 , 350
End If
Num_flags = 0
End If
End If
Case Else ' Zahlentaste gedrueckt
If Num_start = 1 Then Gosub Numinput
End Select
End If
' Hier Ablauf bei Kanalsuchlauf
If Waitflag = 1 Then ' Wenn wir auf ein Ergebnis warten
If Searchflag = 0 Then ' und das Suchen ein Ende hat
If Foundflag = 1 Then ' und was gefunden wurde
' Beep_ok ' dann melden
Sound Buzzer , 100 , 400
Waitms 100
Sound Buzzer , 100 , 400
Else ' ansonsten
' Beep_fail ' jammern
Sound Buzzer , 150 , 350
Viewchannel = Tempchannel ' und zurueck woher wir kamen
End If
Reset Waitflag ' und das Warten beenden
Set View
End If
End If
Elseif Modus = Transmit Then ' Transmitter
Elseif Modus = Menue Then
End If
Loop
'#########################################################################
'### Unterroutinen
'#########################################################################
' Formatierte Zahlenausgabe
Using:
View_string = " " + Str(view_val)
View_string = Right(view_string , 3)
Return
' Zahleneingabe
Numinput:
If Num_start = 0 Then
Set Num_start
Reset View
Num_string = ""
Locate Num_row , Num_col
Lcd String(num_len , 32)
Locate Num_row , Num_col
Cursor On Blink
Else
If Keyval = Enter_key Then
Num_wert = Val(num_string)
If Num_wert < Num_min Then Set Num_error
If Num_wert > Num_max Then Set Num_error
Set Num_end
Set View
Else
If Len(num_string) < Num_len Then
Num_string = Num_string + Str(keyval)
Locate Num_row , Num_col
Lcd Num_string
Else
Sound Buzzer , 150 , 350
End If
End If
End If
Return
'#########################################################################
'### Interruptroutinen
'#########################################################################
' ### Interrupthandling für seriellen Empfang ###
Dmx_receive:
Recval = Udr
If Usr.or = 1 Then ' Overrun Error
Reset Dmx_led
Dmx_count = -2
Elseif Usr.fe = 1 Then ' Break detected durch Framing Error
If Ucr.rxb8 = 0 Then ' und 9.Bit = 0
Max_dmx_data = Dmx_count
Reset Dmx_led
Dmx_count = -1
End If
Elseif Dmx_count = -1 Then ' Wenns los geht
If Recval = Univers Then ' Und der Startcode = Univers also 0
Set Dmx_led ' dann melden
Dmx_count = 0 ' und Zaehler auf null
Else
Reset Dmx_led ' Falsches Universum, LED aus
Dmx_count = -2 ' und alles von vorne
End If
Elseif Dmx_count >= 0 Then ' Empfange Daten
Incr Dmx_count ' erhoehe Kanalzaehler
If Viewchannel = Dmx_count Then ' wenns der erwartete ist
Dmx_data = Recval ' an Variable uebergeben
If Searchflag = 1 Then ' wenn wir am Suchen sind
If Recval > 0 Then ' und der wert > 0 ist
Set Foundflag ' dann melden: gefunden
Reset Searchflag ' und Suche beenden
Else ' wenns dann doch null
Incr Viewchannel ' Kanal erhoehen
If Viewchannel > Max_dmx_data Then Viewchannel = 1 ' aber bis max. MaxDMXData
If Viewchannel = Tempchannel Then ' Wenn wir wieder am Anfang sind
Reset Foundflag ' dann nix gefunden
Reset Searchflag ' und Suche beenden
End If
End If
End If
End If
End If
Return
' ### Interrupt für warteschleife
Timer_int:
Incr Waittime
Return
End 'end program
' Keypad Daten
Keypad:
Data 1 , 4 , 7 , 10
Data 2 , 5 , 8 , 0
Data 3 , 6 , 9 , 11
Data 12 , 13 , 14 , 15
Data 255
mfg.
Joachim
