$regfile = "m8def.dat" ' we use the M8
$crystal = 3686400
$baud = 19200
$hwstack = 32
$swstack = 10
$framesize = 40
Config Portd.2 = Input
Config Portd.3 = Input
Config Portd.4 = Input
Config Portd.5 = Input
Config Portd.6 = Input
Config Portd.7 = Input
Config Portb.0 = Input
Config Portb.1 = Input
Config Portb.2 = Input
Config Portb.3 = Input
Config Portb.4 = Input
Config Portb.5 = Input
Config Portc.0 = Input
Config Portc.1 = Input
Config Portc.2 = Input
Config Portc.3 = Output 'Shutter-LED
Config Portc.4 = Output 'Beamer-LED grün
Config Portc.5 = Output 'Beamer-LED rot
Portd.2 = 1
Portd.3 = 1
Portd.4 = 1
Portd.5 = 1
Portd.6 = 1
Portd.7 = 1
Portb.0 = 1
Portb.1 = 1
Portb.2 = 1
Portb.3 = 1
Portb.4 = 1
Portb.5 = 1
Portc.0 = 1
Portc.1 = 1
Portc.2 = 1
Dim Count As Long , L As Byte , Q As String * 1 , S As String * 25 , U As Bit , V As Long , W As Byte , X As Bit , Y As Bit , Z As Byte , Charwait As Byte
Config Serialin = Buffered , Size = 25
Config Serialout = Buffered , Size = 25
Enable Interrupts
Count = 200001 'Zähler f. Statusabfrage
Declare Sub Status1 'Statusabfrage für Beamer
Declare Sub Datenempfang
Declare Sub Prb50 'Shutter auf
Declare Sub Prb51 'Shutter zu
Do
Debounce Pind.3 , 0 , Prd3 , Sub
Debounce Pind.4 , 0 , Prd4 , Sub
Debounce Pind.5 , 0 , Prd5 , Sub
Debounce Pind.6 , 0 , Prd6 , Sub
Debounce Pind.7 , 0 , Prd7 , Sub
Debounce Pinb.0 , 0 , Prb0 , Sub
Debounce Pinb.1 , 0 , Prb1 , Sub
Debounce Pinb.2 , 0 , Prb2 , Sub
Debounce Pinb.3 , 0 , Prb3 , Sub
If Pinc.0 = 1 Then 'Falls Shutter-Schalter an
Debounce Pinc.1 , 0 , Prb50 , Sub 'Shutter-Knopf "Auf"
Debounce Pinc.2 , 0 , Prb51 , Sub 'Shutter-Knopf "Zu"
Elseif Pinc.0 = 0 Then
If Pinb.5 = 1 Then 'Falls DMX-Relais zu
Call Prb51
Elseif Pinb.5 = 0 Then 'Falls DMX-Relais auf
Call Prb50
End If
End If
Count = Count + 1 'Timer für Statusabfrage
If Count > 200000 Then
Clear Serialin
S = ""
Print Chr(002);
Print "AD01;QPW";
Print Chr(003);
Waitms 100
Count = 0
Set Z
End If
If Ischarwaiting() = 1 Then Call Datenempfang
If Z = 1 Then Call Status1 'Wenn Statusabfrage gestartet
If X = 1 Then Call Status1 'Wenn ETX-Zeichen empfangen
Loop
'-------------------------------------
Sub Datenempfang:
Do
Q = Waitkey()
S = S + Chr(q)
Charwait = Ischarwaiting()
If Q = "{003}" Then 'falls ETX-Zeichen empfangen
Set X
Charwait = 0
End If
Loop Until Charwait = 0 'wiederholen bis kein Zeichen mehr wartet oder ETX empfangen
End Sub
'----------------------------------------------------
Sub Status1
Reset X
'LED-Status anpassen
If S = "{002}001{003}" Then 'AN
Portc.4 = 1
Portc.5 = 0
Set X
Elseif S = "{002}PON{003}" Then
Portc.4 = 1
Portc.5 = 1
Wait 15
Set X
Elseif S = "{002}POF{003}" Then
Portc.4 = 1
Portc.5 = 1
Wait 90
Set X
Elseif S = "{002}000{003}" Then 'AUS
Portc.4 = 0
Portc.5 = 1
Set X
Elseif S = "{002}OSH:0{003}" Then 'Shutter ist offen
Portc.3 = 0
Set X
Elseif S = "{002}OSH:1{003}" Then 'Shutter ist zu
Portc.3 = 1
Set X
Elseif S = "{002}ER401{003}" Then 'Fehler in RS232-Übertragung
Set X
Elseif S = "{002}ER402{003}" Then
Set X 'Fehler in RS232-Übertragung
Elseif S = "?" Then
Set X 'Fehler in RS232-Übertragung
End If
If X = 0 Then 'Keine Kommunikation
Portc.5 = 0
Portc.4 = 0
End If
'SerialIn-Buffer und Status-Bit anpassen
Reset X
If Z = 1 And Right(s , 1) <> "{003}" Then 'Statusabfrage aktiv
Reset Z
Else
Reset Z
S = ""
End If
End Sub
'--------------------------------------- Ausgabe-Routinen
Prd3:
If Pind.2 = 1 Then
Print Chr(002);
Print "AD01;PON";
Print Chr(003); 'AN
Elseif Pind.2 = 0 Then
Print Chr(002);
Print "AD01;POF";
Print Chr(003); 'Aus
End If
Count = 200001
Waitms 1000
Return
Prd4:
Print Chr(002);
Print "AD01;VXX:LNSI4=+00000";
Print Chr(003); 'Fokus+
Return
Prd5:
Print Chr(002);
Print "AD01;VXX:LNSI4=+00001";
Print Chr(003); 'Fokus-
Return
Prd6:
Print Chr(002);
Print "AD01;VXX:LNSI5=+00000"; 'Zoom+
Print Chr(003);
Return
Prd7:
Print Chr(002);
Print "AD01;VXX:LNSI5=+00001"; 'Zoom-
Print Chr(003);
Prb0:
If Pinb.4 = 0 Then
Print Chr(002);
Print ""; 'Trapez Up
Print Chr(003);
Elseif Pinb.4 = 1 Then
Print Chr(002);
Print "AD01;VXX:LNSI3=+00000"; 'Lens Up
Print Chr(003);
End If
Return
Prb1:
If Pinb.4 = 0 Then
Print Chr(002);
Print ""; 'Trapez Down
Print Chr(003);
Elseif Pinb.4 = 1 Then
Print Chr(002);
Print "AD01;VXX:LNSI3=+00001"; 'Lens Down
Print Chr(003);
End If
Return
Prb2:
If Pinb.4 = 0 Then
Print Chr(002);
Print ""; 'Trapez Left
Print Chr(003);
Elseif Pinb.4 = 1 Then
Print Chr(002);
Print "AD01;VXX:LNSI2=+00001"; 'Lens Left
Print Chr(003);
End If
Return
Prb3:
If Pinb.4 = 0 Then
Print Chr(002);
Print ""; 'Trapez Right
Print Chr(003);
Elseif Pinb.4 = 1 Then
Print Chr(002);
Print "AD01;VXX:LNSI2=+00000"; 'Lens Right
Print Chr(003);
End If
Return
Prb50:
If U = 1 Then
Print Chr(002);
Print "AD01;OSH:0"; 'Shutter auf
Print Chr(003);
Reset U
End If
Return
Prb51:
If U = 0 Then
Print Chr(002);
Print "AD01;OSH:1"; 'Shutter zu
Print Chr(003);
Set U
End If
Return |
