Take a picture by RICOH THETA 360.

theta.fsx

// https://gist.github.com/tako2/7734472 I was reffering.
open System
open System.Net.Sockets
open System.Text

type Result<'a, 'b> =
| Success of 'a
| Failure of 'b

type MaybeBuilder() =
    member this.Bind(x, f) =
        match x with
        | Success y -> f y
        | Failure e -> Failure e

    member this.Return(x) =
        Success x

let (|>>) x f = 
    match x with
    | Success data -> f data |> Success
    | Failure e -> Failure e

let maybeAssert b e = if b then Success() else Failure(e)

let maybe = new MaybeBuilder()

type PTP_IP = {
    host: string
    port: int32
    name: string
    GUID: string}

type Connection = {
    commandSocket: Socket
    eventSocket: Socket
    sessionID: int32}

type Command = {ID: int32; Data: Byte[]}

[<AutoOpen>]
module Struct =
    let packInt (num: int) = BitConverter.GetBytes(num)
    let packInt16 (num: int16) = BitConverter.GetBytes(num)
    let packInt32 (num: int32) = BitConverter.GetBytes(num)
    let packInt64 (num: int64) = BitConverter.GetBytes(num)
    let packGUID (guid: string) = 
        guid.Split('-') |> Seq.toArray
        |> Array.collect(fun s ->
            [|0..((s.Length / 2) - 1)|]
            |> Array.map(fun i -> s.[i * 2] + s.[i * 2 + 1] 
                                    |> int 
                                    |> fun j -> j + 16
                                    |> Convert.ToChar 
                                    |> Convert.ToByte)
        )
    let packString s = s |> Seq.toArray |>  Array.collect(fun (c: char) -> BitConverter.GetBytes c)

    let unpackInt16 b = BitConverter.ToInt16(b, 0)
    let unpackInt32 b = BitConverter.ToInt32(b, 0)
    let unpackInt64 b = BitConverter.ToInt64(b, 0)
    let unpackString b = Encoding.ASCII.GetString(b)
    let unpackGUID = unpackString

[<AutoOpen>]
module MaybeSocket =
    let connect (sock:Socket) (host:string) port =
        try
            Success(sock.Connect(host, port))
        with
        | e -> Failure ("Connect failure." + e.Message)

    let send (sock: Socket) (msg: Byte[]) =
        try
          let sendLen = sock.Send msg
          if sendLen = msg.Length then
            Success()
          else
            Failure("failed to send data.")
        with
        | e -> Failure("Sending failure." + e.Message)

    let receive (sock:Socket) len = 
        try
            let buf = Array.create len 0uy
            let recvLen = sock.Receive(buf, len, SocketFlags.None)
            if recvLen = len then
                Success buf
            else
                Failure("failed to receive data.length(" + recvLen.ToString() + ")" )
        with
        | e -> Failure("Receiving failure." + e.Message)

module PTPIPClient =
    let sendCommand (sock:Socket) (commandID:int) (payload:byte[]) =
        let length = packInt(payload.Length + 8)
        let id = packInt(commandID)
        [length; id; payload] |> Array.concat |> send sock
    
    let recvResponse (sock:Socket) =
        maybe {
            let! length = receive sock 4 |>> unpackInt32
            let! cmdID  = receive sock 4 |>> unpackInt32
            if length = 8 then
                return {ID=cmdID; Data=[||]}
            else
                let! data = receive sock (length - 8)
                return {ID=cmdID; Data=data}
        }

    let sendInitCommandRequest ptpip (sock:Socket) =
        printf "send init request.\r\n"
        Array.concat [packGUID(ptpip.GUID) ; packString(ptpip.name); packInt(1)]
        |> sendCommand sock 1

    let waitInitCommandAck sock =
        maybe {
            let! cmd = recvResponse sock
            let! _ = maybeAssert (cmd.ID = 2) "invalid command id."
            let sessionID = unpackInt32 cmd.Data.[0..3]
            let guid = unpackGUID cmd.Data.[4..19]
            let name = unpackString cmd.Data.[20..(cmd.Data.Length - 5)]
            printf "GUID : %s\r\n" guid
            printf "Name : %s\r\n" name
            return sessionID 
        }

    let sendInitEventRequest sock sessionID =
        printf "send init event request.\r\n"
        sessionID |> packInt32 |> sendCommand sock 3

    let waitInitEventAck sock = 
        printf "wait init event ack.\r\n"
        maybe {
            let! cmd = recvResponse sock
            let! _ = maybeAssert (cmd.ID = 4) ("invalid command id:" + cmd.ID.ToString())
            return ()
        }

    let sendPTPCommandRequest (sock: Socket) transactionID (payload: byte[]) cmdID (options: int[]) =
        let rec sendPayload (payload: byte[]) =
            if payload.Length > 200 then
                let head, tail = payload.[..199], payload.[200..]
                match sendCommand sock 10 head with
                | Success _ -> sendPayload tail
                | f -> f
            else
                sendCommand sock 12 payload

        maybe {
            // command request
            let optionBytes = Array.collect(fun opt -> packInt32 opt) options
            let! _ = [packInt32 1; packInt16 cmdID; packInt32 transactionID; optionBytes]
                     |> Array.concat |> sendCommand sock 6

            // command data
            let! _ = [packInt32 transactionID; packInt32 (payload.Length); packInt32 0]
                     |> Array.concat |> sendCommand sock 9

            let! _ = sendPayload payload 
            return ()
        }

    let waitPTPCommandResponse (sock: Socket) =
        let rec getArgs length (bytes:byte[]) (args: int32[]) =
            if args.Length >= length || bytes.Length = 0 then
                args
            else
                let args = [args; [|unpackInt32 bytes.[0..3]|]] |> Array.concat

                if args.Length >= length  || bytes.Length = 0 then 
                    args
                else
                    getArgs length bytes.[4..] args

        let rec getPayload length tranID (sock: Socket) payload =
            let result = maybe{
                let! cmd = recvResponse sock
                let! _ = maybeAssert (cmd.ID = 10 || cmd.ID = 12) "failead receive payload" 
                let tempTranID = unpackInt32 cmd.Data.[0..3]
                let! _ = maybeAssert (tempTranID = tranID) "invalid transaction iD."
                return (cmd.ID, Array.concat [payload; cmd.Data.[4..]])
            }

            match result with
            | Failure(e) -> Failure(e)
            | Success(id, p) -> if p.Length >= length || id = 12 
                                then Success(p)
                                else getPayload length tranID sock p
        maybe {
            let! cmd = recvResponse sock
            let! payload = 
                if cmd.ID = 9 then
                    let transactionID = unpackInt32 cmd.Data.[0..3]
                    let payloadLength = unpackInt32 cmd.Data.[4..7]
            
                    getPayload payloadLength transactionID sock [||]
                else
                    Success([||])

            let! cmd = if cmd.ID = 9 then recvResponse sock else Success(cmd)

            let! _ = maybeAssert (cmd.ID = 7) "failed response ptp response."
            let ptpRes = unpackInt16 cmd.Data.[0..1]
            let transactionID = cmd.Data.[2..5]
            let args = getArgs (cmd.Data.Length - 6) cmd.Data.[6..] [||]

            return ptpRes, args, payload
        }

    let waitPTPEvent conn = 
        let rec getArgs length (bytes:byte[]) (args: int32[]) =
            if args.Length < length then
                let args = [args; [|unpackInt32 bytes.[0..3]|]] |> Array.concat
                getArgs length bytes.[4..] args
            else
                args

        maybe {
            let! cmd = recvResponse conn.eventSocket
            let! _ = match cmd.ID with
                     | 8 -> Success()
                     | _ -> Failure("faild wait event.")
            let eventID = unpackInt16 cmd.Data.[0..1]
            let transactionID = unpackInt32 cmd.Data.[2..5]
            let args = getArgs (cmd.Data.Length - 6) cmd.Data.[6..] [||]
            return eventID, args
        }


    let openConnection ptpip =
        maybe {
            let cmdSock = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            printf "connect.\r\n"
            let! _ = connect cmdSock ptpip.host ptpip.port
            printf "send init command.\r\n"
            let! _ = sendInitCommandRequest ptpip cmdSock
            printf "wait init command.\r\n"
            let! sessionID = waitInitCommandAck cmdSock

            let eventSock = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            printf "connect evt.\r\n"
            let! _ = connect eventSock ptpip.host ptpip.port
            printf "send init event cmmand(sessionID: %d)\r\n" sessionID
            let! _ = sendInitEventRequest eventSock sessionID
            printf "wait init event command.\r\n"
            let! _ = waitInitEventAck eventSock
        
            printf "complete open.\r\n"
            return {commandSocket=cmdSock; eventSocket=eventSock; sessionID=sessionID}
        }

    let closeConnection conn =
        conn.commandSocket.Close()
        conn.eventSocket.Close()

    let zeroMsg: byte [] = (Array.zeroCreate 0)
    //let zeroOptions: 

    let openSession conn tranID =
        let commandID = int16 0x1002
        maybe {
            printf "send open session.\r\n"
            let! _ = sendPTPCommandRequest conn.commandSocket tranID zeroMsg commandID [|conn.sessionID|]
            printf "wait open session response.\r\n"
            let! result, _, _ = waitPTPCommandResponse conn.commandSocket
            let! _ = maybeAssert (result = int16 0x2001) ("failed to open session. :" + string result)
            return (tranID + 1)
        }

    let closeSession conn tranID =
        let commandID = int16 0x1003
        maybe {
            let! _ = sendPTPCommandRequest conn.commandSocket tranID zeroMsg commandID (Array.zeroCreate 0)
            let! result, _, _ = waitPTPCommandResponse conn.commandSocket
            let! _ = maybeAssert (result = int16 0x2001) "failed to close session."
            return (tranID + 1)
        }

    let initiateCapture conn tranID = 
        let commandID = int16 0x100E
        maybe {
            let! _ = sendPTPCommandRequest conn.commandSocket tranID zeroMsg commandID [|0;0|]
            let! result, _, _ = waitPTPCommandResponse conn.commandSocket
            let! _ = maybeAssert (result = int16 0x2001) "failed open session."
  
            //let! eveID, args = waitPTPEvent conn.eventSock
            return (tranID + 1)
        }


type Theta360() =
    let ptpip = {host="192.168.1.1"; port=15740; name="THETA"; GUID="8a7ab04f-ebda-4f33-8649-8bf8c1cdc838"}
    let mutable connection = None
    let mutable transactionID = 0

    member this.Open () =
        maybe {
            let! conn = PTPIPClient.openConnection ptpip
            transactionID <- 0
            connection <- Some conn
            let! newTranID = PTPIPClient.openSession conn transactionID
            transactionID <- newTranID
            return ()
        }

    member this.Close () =
        match connection with
        | Some con ->
            maybe {
                printf "close session.\r\n"
                let! _ = PTPIPClient.closeSession con transactionID
                printf "close connection.\r\n"
                PTPIPClient.closeConnection con
                return ()
            }
        | None -> Failure("failed to close")

    member this.Shutter () = 
        match connection with
        | Some con ->
            maybe {
                let! id = PTPIPClient.initiateCapture con transactionID
                transactionID <- id
                return()
            }
        | None -> Failure("failed to shutter.")


// オープン -> シャッターを切る -> クローズ
let theta = new Theta360()

match theta.Open() with
| Success(s) -> printf "success"
                try
                    match theta.Shutter() with
                    | Success _ -> printf "success shutter.\r\n"
                    | Failure e -> printf "failure(%s)\r\n" e
                finally
                    match theta.Close() with
                    | Success(s) -> printf "success"
                    | Failure(f) -> printf "failure(%s)" f
| Failure(f) -> printf "failure(%s)" f