DomotiGa - /trunk/DomotiGaServer/CVISCA.class - DomotiGa

The files contained in this repository can be downloaded to your computer using a svn client.
On Linux you simply type the command displayed below.

Subversion

This URL has Read-Only access.

Statistics

root / trunk / DomotiGaServer / CVISCA.class @ 707

History | View | Annotate | Download (9.2 kB)

 ' Gambas class file
 ' Description:
 ' CVISCA.class
 ' Support for Sony VISCA protocol to control PTZ camera's
 ' Development Status:
 ' Working, a few bugs to fix.
 ' Links:
 ' http://www.vision.auc.dk/~tbm/Sony/EVID30.pdf
 ' http://animatlab.lip6.fr/~gouricho/SonyPTZCamEVID31/evidapplication.html
 ' http://www.j3soft.net/webcam/evi-d30.htm
 ' http://www.j3soft.net/webcam/evi-d31.htm
 ' http://f1chf.free.fr/SONY/
 ' DomotiGa - an open source home automation program.
 ' Copyright(C) 2008-2009 Ron Klinkien
 ' Read file called COPYING for license details.
 PROPERTY Port AS String
 PROPERTY VISCADebug AS Boolean
 PRIVATE sPort AS String
 PRIVATE bVISCADebug AS Boolean
 PUBLIC hVISCA AS NEW SerialPort
 PUBLIC bCamNum AS Byte = &H80 + Hex(Main.iVISCACameraAddress)
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' open serial port
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC FUNCTION Connect() AS Boolean
   ' try to close the port
   TRY hVISCA.Close
   ' get a new one
   hVISCA = NEW Serialport AS "VISCA"
   WITH hVISCA
     .PortName = sPort
     .Speed = 9600
     .Parity = 0
     .DataBits = 8
     .StopBits = 1
     .FlowControl = 0
     .Open()
   END WITH
   ' all ok
   RETURN TRUE
 CATCH ' some errors
   Main.WriteLog(("VISCA Error: ") & ERROR.Text)
   RETURN FALSE
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' close port
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC FUNCTION Disconnect() AS Boolean
   ' try to close the connection
   TRY hVISCA.Close
   Main.WriteLog(("VISCA serial port close."))
   ' all ok
   RETURN TRUE
 CATCH ' some errors
   Main.WriteLog(("VISCA Error: ") & ERROR.Text)
   RETURN FALSE
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' send a command to the camera
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC FUNCTION SendCommand(aCommand AS Array)
   DIM iCmd AS Byte
   IF Main.bVISCADebug THEN Main.WriteDebugLog("[VISCA] > ", TRUE)
   FOR EACH iCmd IN aCommand
     IF Main.bVISCADebug THEN Main.WriteRFXDebugLog(Hex$(iCmd, 2) & " ", TRUE)
     TRY WRITE #hVISCA, iCmd
   NEXT
   IF Main.bVISCADebug THEN Main.WriteRFXDebugLog("\n", TRUE)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' got data back from camera
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB VISCA_Read()
   DIM sData AS Byte
   TRY READ #hVISCA, sData
   IF ERROR THEN Main.WriteDebugLog(("[VISCA] Error reading data from the serial port! ->") & ERROR.Text)
   IF Main.bVISCADebug THEN Main.WriteDebugLog("[VISCA] < " & Hex$(sData, 2))
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' send address set command to camera
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB AddressSet()
   DIM b AS Byte[] = [CByte(&H88), CByte(&H30), &H1, &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' send clear command to camera
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB IfClear()
   DIM b AS Byte[] = [CByte(&H88), CByte(&H1), &H0, &H1, &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' switch camera on and off (power save mode)
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Power(sMode AS String)
   DIM b AS Byte[] = [CByte(bCamNum), CByte(&h1), &H4, &H0, IIf(sMode = "on", &H2, &H3), &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' change white balance setting
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB WhiteBalance(sMode AS String)
   DIM b AS Byte[6]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   b[3] = &H35
   SELECT CASE LCase(sMode)
     CASE "auto"
       b[4] = &H0
     CASE "indoor"
       b[4] = &H1
     CASE "outdoor"
       b[4] = &H2
     CASE "onepush"
       b[4] = &H3
     CASE "trigger"
       b[4] = &H4
   END SELECT
   b[5] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' control autoexposure mode
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB AutoExposure(sMode AS String)
   DIM b AS Byte[6]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   b[3] = &H39
   SELECT CASE LCase(sMode)
     CASE "auto"
       b[4] = &H0
     CASE "manual"
       b[4] = &H3
     CASE "shutter"
       b[4] = &HA
     CASE "iris"
       b[4] = &HB
     CASE "bright"
       b[4] = &HD
   END SELECT
   b[5] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' control exposure modes (bright, shutter, iris and gain)
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB ManualExposure(sMode AS String, sDo AS String)
   DIM b AS Byte[7]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   b[3] = &H0
   SELECT CASE LCase(sMode)
     CASE "bright"
       b[4] = &HD
     CASE "shutter"
       b[4] = &HA
     CASE "iris"
       b[4] = &HB
     CASE "gain"
       b[4] = &HC
   END SELECT
   IF sDo = "-" THEN
     b[5] = &H2
   ELSE IF sDo = "+" THEN
     b[5] = &H3
   ELSE
     b[5] = &H0 ' reset
   END IF
   b[6] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' switch backlight compensation on/off
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB BackLight(sMode AS String)
   DIM b AS Byte[] = [CByte(bCamNum), CByte(&H1), &H4, &H33, IIf(sMode = "on", &H2, &H3), &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' tiltdrive
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Direction(sMode AS String, iPanSpeed AS Integer, iTiltSpeed AS Integer)
   DIM b AS Byte[9]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H6
   b[3] = &H1
   b[4] = Format(Val("&H" & Hex(iPanSpeed)))
   b[5] = Format(Val("&H" & Hex(iTiltSpeed)))
   SELECT CASE LCase(sMode)
     CASE "up"
       b[6] = &H3
       b[7] = &H1
     CASE "down"
       b[6] = &H3
       b[7] = &H2
     CASE "left"
       b[6] = &H1
       b[7] = &H3
     CASE "right"
       b[6] = &H2
       b[7] = &H3
     CASE "upleft"
       b[6] = &H1
       b[7] = &H1
     CASE "downleft"
       b[6] = &H1
       b[7] = &H2
     CASE "upright"
       b[6] = &H2
       b[7] = &H1
     CASE "downright"
       b[6] = &H2
       b[7] = &H2
     CASE "stop"
       b[6] = &H3
       b[7] = &H3
   END SELECT
   b[8] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' stop whatever you are doing
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB StopCommand()
   DIM b AS Byte[9]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H6
   b[3] = &H1
   b[4] = &H10
   b[5] = &H10
   b[6] = &H3
   b[7] = &H3
   b[8] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' go home
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Home()
   DIM b AS Byte[] = [CByte(bCamNum), CByte(&H1), &H6, &H4, &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' memory reset, set and recall
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Memory(sPreset AS String, bRecall AS Boolean, bRecallSet AS Boolean)
   DIM b AS Byte[7]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   b[3] = &H3F
   IF bRecall = TRUE THEN
     b[4] = &H2 ' recall
   ELSE IF BRecallSet = TRUE THEN
     b[4] = &H1 ' set
   ELSE
     b[4] = &H0 ' reset
   END IF
   b[5] = sPreset
   b[6] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' power inquiry
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB PowerInq()
   DIM b AS Byte[] = [CByte(bCamNum), CByte(&H9), &H4, &H0, &HFF]
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' control focus modes (stop, near, far, auto and manual)
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Focus(sMode AS String)
   DIM b AS Byte[6]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   SELECT CASE LCase(sMode)
     CASE "stop"
       b[3] = &H8
       b[4] = &H0
     CASE "far"
       b[3] = &H8
       b[4] = &H2
     CASE "near"
       b[3] = &H8
       b[4] = &H3
     CASE "auto"
       b[4] = &H38
       b[4] = &H2
     CASE "manual"
       b[4] = &H38
       b[5] = &H3
   END SELECT
   b[5] = &HFF
   SendCommand(b)
 END
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ' control zoom (stop, direct, tele, wide, tele(var) and wide(var)
 '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 PUBLIC SUB Zoom(sMode AS String, iValue AS Integer)
   DIM b AS Byte[6]
   b[0] = bCamNum
   b[1] = &H1
   b[2] = &H4
   SELECT CASE LCase(sMode)
     CASE "stop"
       b[3] = &H7
       b[4] = &H0
     CASE "tele"
       b[3] = &H7
       IF iValue > 1 THEN
         b[4] = &H2 + Hex(iValue)
       ELSE IF iValue > 7 THEN
         b[4] = &H2 + Hex(7)
       ELSE
         b[4] = &H2
       END IF
     CASE "wide"
       b[3] = &H7
       IF iValue > 1 THEN
         b[4] = &H3 + Hex(iValue)
       ELSE IF iValue > 7 THEN
         b[4] = &H2 + Hex(7)
       ELSE
         b[4] = &H3
       END IF
       b[4] = &H3
   END SELECT
   b[5] = &HFF
   SendCommand(b)
 END
 ' implement the properties
 PRIVATE FUNCTION Port_Read() AS String
   RETURN sPort
 END
 PRIVATE SUB Port_Write(sValue AS String)
   sPort = sValue
 END
 PRIVATE FUNCTION VISCADebug_Read() AS Boolean
   RETURN bVISCADebug
 END
 PRIVATE SUB VISCADebug_Write(sValue AS Boolean)
   bVISCADebug = sValue
 END