' 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