open Ctypes include T module L = G.P(Bindings) module GT = G.U let request_type_standard = GT.request_type_standard |> Signed.Int64.to_int let request_type_class = GT.request_type_class |> Signed.Int64.to_int let request_type_vendor = GT.request_type_vendor |> Signed.Int64.to_int let request_type_reserved = GT.request_type_reserved |> Signed.Int64.to_int let endpoint_direction_in = GT.endpoint_direction_in |> Signed.Int64.to_int let endpoint_direction_out = GT.endpoint_direction_out |> Signed.Int64.to_int let recipient_device = GT.libusb_recipient_device |> Signed.Int64.to_int let recipient_interface = GT.libusb_recipient_interface |> Signed.Int64.to_int let recipient_endpoint = GT.libusb_recipient_endpoint |> Signed.Int64.to_int let recipient_other = GT.libusb_recipient_other |> Signed.Int64.to_int let string_of_error = function | Success -> "Success" | Number n -> Printf.sprintf "Positive number: %d" n | e -> L.error_name e let description_of_error = function | Success -> "Success" | Number n -> Printf.sprintf "Positive number: %d" n | e -> L.error_description e let init_libusb () = match L.init null with | Success -> Ok () | Number _ -> assert false | e -> Error e let exit_libusb () = L.exit null let get_version () = let sv = !@ (L.get_version ()) in { major = getf sv GT.version_major |> Unsigned.UInt16.to_int; minor = getf sv GT.version_minor |> Unsigned.UInt16.to_int; micro = getf sv GT.version_micro |> Unsigned.UInt16.to_int; nano = getf sv GT.version_nano |> Unsigned.UInt16.to_int; rc = getf sv GT.version_rc; describe = getf sv GT.version_describe; } type device = GT.device structure ptr let get_device_list () = let dl = from_voidp GT.device null |> allocate (ptr GT.device) |> allocate (ptr (ptr GT.device)) in match L.get_device_list null dl with | Success -> L.free_device_list !@dl 0; Ok [] | Number nb_devices -> let l = CArray.from_ptr !@dl nb_devices |> CArray.to_list in L.free_device_list !@dl 0; Ok l | err -> Error err let unref_device d = L.unref_device d type device_handle = GT.device_handle structure ptr let open_device ?(unref=true) d = let h = from_voidp GT.device_handle null |> allocate (ptr GT.device_handle) in match L.open_device d h with | Success -> if unref then unref_device d; Ok !@h | Number _ -> assert false | e -> Error e let close_device h = L.close_device h let get_device_descriptor d = let desc = make GT.device_descriptor in match L.get_device_descriptor d (addr desc) with | Success -> Ok { id_vendor = getf desc GT.device_descriptor_idvendor |> Unsigned.UInt16.to_int; id_product = getf desc GT.device_descriptor_idproduct |> Unsigned.UInt16.to_int; i_manufacturer = getf desc GT.device_descriptor_imanufacturer |> Unsigned.UInt8.to_int; i_product = getf desc GT.device_descriptor_iproduct |> Unsigned.UInt8.to_int; } | Number _ -> assert false | e -> Error e let get_string_descriptor d i = if i <= 0 then Error Error_not_found else let sz = Unsigned.UInt8.(to_int max_int) in let strptr = allocate_n char ~count:sz in match L.get_string_descriptor_ascii d (Unsigned.UInt8.of_int i) strptr sz with | Success -> assert false | Number n -> Ok (string_from_ptr strptr ~length:n |> String.trim) | e -> Error e let is_vendor v d = match get_device_descriptor d with | Ok dd -> dd.id_vendor = v | _ -> false let is_product p d = match get_device_descriptor d with | Ok dd -> dd.id_product = p | _ -> false let filter_devices f dl = let keep, unref = List.partition f dl in List.iter unref_device unref; keep let control_transfer ~device_handle ~request_type ~request ~value ~index ~buffer ~timeout = let sz = Bigarray.Array1.dim buffer in L.control_transfer device_handle (Unsigned.UInt8.of_int request_type) (Unsigned.UInt8.of_int request) (Unsigned.UInt16.of_int value) (Unsigned.UInt16.of_int index) (bigarray_start array1 buffer) (Unsigned.UInt16.of_int sz) (Unsigned.UInt.of_int timeout)