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.
Zitieren
Lesezeichen