From: Jérémie D. <Ba...@us...> - 2010-01-29 21:20:44
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "krobot". The branch, master has been updated via 50c027108ad86dc99649d4bb86741b422b48143d (commit) from e0d4b08a4fc5530a34eac0d46d8f91be05d7f094 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 50c027108ad86dc99649d4bb86741b422b48143d Author: Jérémie Dimino <je...@di...> Date: Fri Jan 29 22:20:13 2010 +0100 merge D-Bus drivers ----------------------------------------------------------------------- Changes: diff --git a/PC_Mainboard/clients/lib-krobot/krobot.ml b/PC_Mainboard/clients/lib-krobot/krobot.ml index 6c77010..3329f21 100644 --- a/PC_Mainboard/clients/lib-krobot/krobot.ml +++ b/PC_Mainboard/clients/lib-krobot/krobot.ml @@ -33,6 +33,8 @@ lwt bus = Log#exn exn "failed to create remote transport"; fail exn +let driver = OBus_peer.make bus "fr.krobot" + (* +-----------------------------------------------------------------+ | Compass | +-----------------------------------------------------------------+ *) @@ -43,7 +45,7 @@ OP_signal Value : int OP_method Get : int lwt compass = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.Compass") [ "fr"; "krobot"; "Devices"; "Compass" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Compass" ] in lwt initial = get proxy in return (React.S.hold initial (value proxy)#event) @@ -52,7 +54,7 @@ lwt compass = +-----------------------------------------------------------------+ *) let op_method_call member typ = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.AX12") [ "fr"; "krobot"; "Devices"; "AX12" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "AX12" ] in OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.AX12" ~member typ OP_method OpenClaw : unit -> unit @@ -65,7 +67,7 @@ OP_method CloseCylinder : unit -> unit +-----------------------------------------------------------------+ *) let op_method_call member typ = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.Elevator") [ "fr"; "krobot"; "Devices"; "Elevator" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Elevator" ] in OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Elevator" ~member typ OP_method ElevatorUp : int -> int -> unit @@ -86,7 +88,7 @@ let elevator_down ?speed ?delay () = +-----------------------------------------------------------------+ *) let op_method_call member typ = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.Grip") [ "fr"; "krobot"; "Devices"; "Grip" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Grip" ] in OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Grip" ~member typ OP_method OpenGrip : unit -> unit @@ -102,7 +104,7 @@ OP_signal Value : bool array OP_method Get : bool array lwt logic_sensors = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.LogicSensors") [ "fr"; "krobot"; "Devices"; "LogicSensors" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "LogicSensors" ] in lwt initial = get proxy in return (React.S.hold initial (value proxy)#event) @@ -124,7 +126,7 @@ OP_signal Value : int array OP_method Get : int array lwt range_finders = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.RangeFinders") [ "fr"; "krobot"; "Devices"; "RangeFinders" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "RangeFinders" ] in lwt initial = get proxy in return (React.S.hold initial (value proxy)#event) @@ -133,7 +135,7 @@ lwt range_finders = +-----------------------------------------------------------------+ *) let op_method_call member typ = - let proxy = OBus_proxy.make (OBus_peer.make bus "fr.krobot.Device.Motors") [ "fr"; "krobot"; "Devices"; "Motors" ] in + let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Motors" ] in OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Motors" ~member typ OP_method Turn : int -> int -> int -> unit diff --git a/PC_Mainboard/daemons/Makefile b/PC_Mainboard/daemons/Makefile deleted file mode 100644 index 5120c74..0000000 --- a/PC_Mainboard/daemons/Makefile +++ /dev/null @@ -1,35 +0,0 @@ -# Makefile -# -------- -# Copyright : (c) 2009, Jeremie Dimino <je...@di...> -# Licence : BSD3 -# -# This file is a part of [kro]bot. - -PREFIX=/usr/local - -OC = ocamlbuild -OF = ocamlfind - -ifeq ($(TERM),dumb) -OC += -classic-display -endif - -.PHONY: all -all: - $(OC) all - -.PHONY: clean -clean: - $(OC) -clean - -.PHONY: install -install: - install -m0644 dbus-rules/fr.krobot.conf /etc/dbus-1/system.d/fr.krobot.conf - install _build/dbus-drivers/card_interface.native $(PREFIX)/bin/krobot-card-interface - install _build/dbus-drivers/card_sensor.native $(PREFIX)/bin/krobot-card-sensor - -.PHONY: uninstall -uninstall: - rm -f /etc/dbus-1/system.d/fr.krobot.conf - rm -f $(PREFIX)/bin/krobot-card-interface - rm -f $(PREFIX)/bin/krobot-card-sensor diff --git a/PC_Mainboard/daemons/PcInterface.h b/PC_Mainboard/daemons/PcInterface.h deleted file mode 100644 index 6928d8e..0000000 --- a/PC_Mainboard/daemons/PcInterface.h +++ /dev/null @@ -1,208 +0,0 @@ -/** - * @file PcInterface.h - * Fichier commun avec le programme hsur la carte m (USB PC). - * Ce fichier dnit de nombreuses constantes utilis pour le protocole - * de communication carte <-> PC. -*/ - -#ifndef PC_INTERFACE_H -#define PC_INTERFACE_H - -#define USB_VID 0x04D8 ///< Vendor ID commun aux diffntes cartes USB -#define USB_PID_USB_DEV_BOARD 0x0001 ///< Product ID de la Carte d'essais -#define USB_PID_PROXIMITY_SENSOR 0x0002 ///< Product ID de la Carte capteurs -#define USB_PID_MOTOR_CONTROLLER 0x0003 ///< Product ID de la Carte d'asservissement -#define USB_PID_ROBOT_INTERFACE 0x0004 ///< Product ID de la Carte d'actionneur -#define USB_PID_BATTERY_MONITORING 0x0005 ///< Product ID de la carte Battery Monitoring -#define USB_PID_BOOTLOADER 0x000b ///< Product ID d'une carte en mode bootloader - -// Protocole USB -#define UP_HSEQ 0 ///< Host sequence number -#define UP_DSEQ 1 ///< Device sequence number -#define UP_CMD 2 -#define UP_ERR 3 -#define UP_RES0 4 -#define UP_RES1 5 -#define UP_RES2 6 -#define UP_RES3 7 -#define UP_RES4 60 -#define UP_RES5 61 -#define UP_RES6 62 -#define UP_RES7 63 -#define UP_DATA 8 - -// Commande (premier bit) -#define CMD_RESET 0 ///< Reset du PIC -#define CMD_BOOTLOADER 1 ///< Reset du PIC en mode bootloader -#define CMD_GET 2 ///< Obtenir une information -#define CMD_RESPOND 3 ///< Rnse ne commande -#define CMD_ERR 4 ///< Envoyer une erreur -#define CMD_SEND 5 ///< Envoyer du texte -#define CMD_SET 6 ///< Dnir l't d'un parame -#define CMD_TEST 7 ///< Commande grique pour dencher une action de test -#define CMD_CALIBRATE 8 ///< Lance la calibration d'un tme [Carte capteurs] -#define CMD_AX12 9 -#define CMD_TRAJ 10 ///< Transmet une trajetoire au Krobot -#define CMD_MOTOR 11 ///< Gestion des moteurs -#define CMD_MOTOR_TOR 12 - -// CMD_GET arguments -#define GET_RESET_SOURCE 0 ///< Demande au PIC la source du Reset -#define GET_BOARD_INFO 1 ///< Demande au PIC le nom de la carte et l'auteur -#define GET_FIRMWARE_BUILD 2 ///< Demande au PIC la date et l'heure de compilation du firmware -#define GET_PORTS_CONFIG 3 ///< Demande la config TRIS des ports du PIC -#define GET_PORTS_STATE 4 ///< Demande l't des ports du PIC -#define GET_RANGEFINDER_STATE 5 ///< Demande au PIC les mesures des tmes [Carte capteurs] -#define GET_ISENS 6 ///< Demande au PIC les valeurs des courants moteurs mesur [Carte d'asservissement] -#define GET_CURRENT_POS 7 ///< Demande au PIC les positions actuelles des moteurs [Carte d'asservissement] -#define GET_RANGEFINDER_CALIBRATION 8 ///< Demande au PIC les valeurs de calibration des tmes [Carte capteurs] -#define GET_TOR_STATE 9 ///< Demande au PIC l't des capteurs de contact [Carte capteurs] -#define GET_CMP03_DATA 10 ///< Rp les infos du compas ctronique CMP03 -#define GET_CELL_VOLTAGE 11 ///< Tensions des cellules [Battery Monitoring] -#define GET_CURRENT 12 ///< Valeur instantandu courant dtar la batterie [Battery Monitoring] -#define GET_POWER_STATE 13 ///< Etat de l'alimentation de puissance (On/Off) [Battery Monitoring] -#define GET_BATTERY_STATE 14 ///< Etat des batteries (Pleine charge/Charge moyenne/Charge faible) [Battery Monitoring] - -// CMD_ERR arguments -#define ERR_UNKNOWN_CMD 1 ///< Commande inconnue -#define ERR_UNKNOWN_GET 2 ///< Demande inconnue -#define ERR_UNKNOWN_SET 3 ///< Demande inconnue -#define ERR_INVALID_RESPONSE 4 ///< Rnse invalide -#define ERR_AX12_WRONG_PACKET 5 -#define ERR_AX12_ERROR 6 -#define ERR_AX12_CHKSUM 7 -#define ERR_CMP03_NOT_RESPONDING 8 -#define ERR_ADJD_S371_NOT_RESPONDING 9 - -// CMD_SET arguments -#define SET_PORTS_CONFIG_INPUTS 0x00 ///< Dnir les entr du PIC -#define SET_PORTS_CONFIG_OUTPUTS 0x01 ///< Dnir les sorties du PIC -#define SET_PORTS_STATE_LOW 0x02 ///< Dnir les sorties 't bas du PIC -#define SET_PORTS_STATE_HIGH 0x03 ///< Dnir les sorties 't haut du PIC -#define SET_SERVO_CONFIG 0x04 ///< Dnir la config des servomoteurs -#define SET_SERVO_STATE 0x05 ///< Dnir l't des servomoteurs - -// CMD_CALIBRATE arguments -#define CAL_START 0x00 -#define CAL_CONTINUE 0x01 -#define CAL_STOP 0x02 -#define CAL_ERROR 0x03 -#define CAL_DONE 0x04 -#define CAL_PLACE_INF 0x05 -#define CAL_PLACE_30 0x06 -#define CAL_PLACE_100 0x07 - -// GET_RESET_SOURCE reponse -#define RESET_SOURCE_POR 0x01 ///< Power-on Reset -#define RESET_SOURCE_RI 0x02 ///< RESET Instruction -#define RESET_SOURCE_BOR 0x03 ///< Brown-out Reset -#define RESET_SOURCE_WDT 0x04 ///< Watchdog Time-out Reset -#define RESET_SOURCE_STKFUL 0x05 ///< Stack Full Reset -#define RESET_SOURCE_STKUNF 0x06 ///< Stack Underflow Reset -#define RESET_SOURCE_MCLR 0x07 ///< Master Clear Reset - -// CMD_AX12 -#define AX12_PING 0x01 -#define AX12_READ 0x02 -#define AX12_WRITE 0x03 -#define AX12_GOTO 0x04 -#define AX12_GET_POS 0x05 -#define AX12_GET_SPEED 0x06 -#define AX12_GET_LOAD 0x07 -#define AX12_GET_STATS 0x08 -#define AX12_WRITE_REG 0x09 -#define AX12_ACTION 0x10 - -// CMD_TRAJ -#define TRAJ_INIT 0x00 -#define TRAJ_FORWARD 0x01 -#define TRAJ_BACKWARD 0x02 -#define TRAJ_TR 0x03 -#define TRAJ_TL 0x04 -#define TRAJ_GOTO 0x05 -#define TRAJ_FINISHED 0x06 -#define TRAJ_STOP 0x07 -#define TRAJ_NEW_POSITION 0x08 -#define TRAJ_NEW_VELOCITY 0x09 -#define TRAJ_CHANGE_VELOCITY 0x0A -#define TRAJ_CONFIG 0x0B -#define TRAJ_CONFIG_DEFAULT 0x0C -#define TRAJ_START 0x0D -#define TRAJ_GET_REL_POS 0x0E -#define TRAJ_READ_CONFIG 0x0F - -#define TRAJ_NOT_COMPLETED 0x00 -#define TRAJ_COMPLETED 0x01 - -#define TRAJ_STOP_MOTOR_OFF 256 -#define TRAJ_STOP_ABRUPT 512 -#define TRAJ_STOP_SMOOTH 1024 - -// CMD_MOTOR -#define MOTOR_ENABLE 1 -#define MOTOR_DISABLE 2 -#define MOTOR_MOVE 3 - -#define MOTOR_RIGHT 0 ///< Sction du moteur de droite (moteur 1) -#define MOTOR_LEFT 1 ///< Sction du moteur de gauche (moteur 2) -#define MOTOR_BOTH 2 ///< Sction des 2 moteurs simultannt - -// XXX omplr -#define READ_VERSION 0x00 -#define READ_FLASH 0x01 -#define WRITE_FLASH 0x02 -#define ERASE_FLASH 0x03 -#define READ_EEDATA 0x04 -#define WRITE_EEDATA 0x05 -#define READ_CONFIG 0x06 -#define WRITE_CONFIG 0x07 -#define UPDATE_LED 0x32 -#define RESET 0xFF - -#define FLASH_BOOT_START 0x00 -#define FLASH_BOOT_END 0x7FF -#define FLASH_VECTOR_START 0x800 -#define FLASH_VECTOR_END 0x829 -#define FLASH_PAGE_START 0x82A -#define FLASH_PAGE_END 0x7FFF - -#define PORTA_RA0 1 -#define PORTA_RA1 2 -#define PORTA_RA2 4 -#define PORTA_RA3 8 -#define PORTA_RA4 16 -#define PORTA_RA5 32 -#define PORTA_RA6 64 - -#define PORTB_RB0 1 -#define PORTB_RB1 2 -#define PORTB_RB2 4 -#define PORTB_RB3 8 -#define PORTB_RB4 16 -#define PORTB_RB5 32 -#define PORTB_RB6 64 -#define PORTB_RB7 128 - -#define PORTC_RC0 1 -#define PORTC_RC1 2 -#define PORTC_RC2 4 -#define PORTC_RC4 16 -#define PORTC_RC5 32 -#define PORTC_RC6 64 -#define PORTC_RC7 128 - -#define PORTD_RD0 1 -#define PORTD_RD1 2 -#define PORTD_RD2 4 -#define PORTD_RD3 8 -#define PORTD_RD4 16 -#define PORTD_RD5 32 -#define PORTD_RD6 64 -#define PORTD_RD7 128 - -#define PORTE_RE0 1 -#define PORTE_RE1 2 -#define PORTE_RE2 4 -#define PORTE_RE3 8 - -#endif // PC_INTERFACE_H diff --git a/PC_Mainboard/daemons/README b/PC_Mainboard/daemons/README deleted file mode 100644 index 6ad88cc..0000000 --- a/PC_Mainboard/daemons/README +++ /dev/null @@ -1,5 +0,0 @@ -* "usb" contains the lowlevel interface to cards - -* "dbus-drivers" contains programs doing the interfaces between - qlowlevel usb communication and high-level functions exported via - D-Bus diff --git a/PC_Mainboard/daemons/_tags b/PC_Mainboard/daemons/_tags deleted file mode 100644 index 24a3ec1..0000000 --- a/PC_Mainboard/daemons/_tags +++ /dev/null @@ -1,8 +0,0 @@ -# -*- conf -*- - -<**/*.ml>: syntax_camlp4o, pkg_camlp4 -<usb/**/*.ml>: pkg_lwt.syntax -<dbus-drivers/**/*.ml>: pkg_lwt.syntax, pkg_obus.syntax - -<usb/**/*>: thread, pkg_threads, pkg_usb -<dbus-drivers/**/*>: thread, pkg_threads, pkg_obus, pkg_usb diff --git a/PC_Mainboard/daemons/dbus-drivers/card_interface.ml b/PC_Mainboard/daemons/dbus-drivers/card_interface.ml deleted file mode 100644 index 8bf514e..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/card_interface.ml +++ /dev/null @@ -1,233 +0,0 @@ -(* - * card_interface.ml - * ----------------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -(* Driver for the interface card *) - -open OBus_pervasives -open Lwt - -(* +-----------------------------------------------------------------+ - | Compass | - +-----------------------------------------------------------------+ *) - -module Compass = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - mutable data : int; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Compass" end) - - OL_signal Value : int - OL_method Get : int = fun dev -> return dev.data - - let get card = - lwt data = Card.send_request card Protocol.get_cmp03_data "" in - return (RW.get_int16 data 2) - - let rec loop dev = - lwt data = get dev.card in - if data <> dev.data then begin - dev.data <- data; - lwt () = value dev data in - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - end else - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - - let make card path = - lwt data = get card in - let dev = { - obus = OBus_object.make path; - card = card; - data = data; - } in - ignore (loop dev); - return dev -end - -(* +-----------------------------------------------------------------+ - | AX12 | - +-----------------------------------------------------------------+ *) - -module AX12 = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.AX12" end) - - let ax12_goto card id pos speed = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.ax12_goto; - RW.set_uint8 data 1 id; - RW.set_uint16 data 2 pos; - RW.set_uint16 data 4 speed; - lwt _ = Card.send_request card Protocol.cmd_ax12 data in - return () - - OL_method OpenClaw : unit = fun dev -> - ax12_goto dev.card 1 1023 0 - - OL_method CloseClaw : unit = fun dev -> - ax12_goto dev.card 1 770 0 - - OL_method OpenCylinder : unit = fun dev -> - ax12_goto dev.card 2 154 0 - - OL_method CloseCylinder : unit = fun dev -> - ax12_goto dev.card 2 579 0 - - let make card path = - return { - obus = OBus_object.make path; - card = card; - } -end - -(* +-----------------------------------------------------------------+ - | Elevator | - +-----------------------------------------------------------------+ *) - -module Elevator = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Elevator" end) - - let motor_move card sens speed duration = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.motor_move; - RW.set_uint8 data 1 Protocol.motor_right; - RW.set_uint8 data 2 (if sens < 0 then 200 else sens); - RW.set_uint8 data 3 (if speed < 0 then 2000 else speed); - RW.set_uint32 data 4 duration; - Card.send_command card Protocol.cmd_motor data - - OL_method ElevatorUp : int -> int -> unit = fun dev speed delay -> - motor_move dev.card 0 speed delay - - OL_method ElevatorDown : int -> int -> unit = fun dev speed delay -> - motor_move dev.card 1 speed delay - - let make card path = - return { - obus = OBus_object.make path; - card = card; - } -end - -(* +-----------------------------------------------------------------+ - | Grip | - +-----------------------------------------------------------------+ *) - -module Grip = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Grip" end) - - let set_servo_state card angles = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.set_servo_state; - RW.set_uint8 data 1 (List.fold_left (fun acc (s, _) -> acc lor (1 lsl s)) 0 angles); - List.iter (fun (s, a) -> RW.set_uint8 data (2 + s) a) angles; - Card.send_command card Protocol.cmd_set data - - let left = 1 - let right = 2 - - OL_method OpenGrip : unit = fun dev -> - lwt () = set_servo_state dev.card [(left, 45); (right, -5)] in - lwt () = Lwt_unix.sleep 0.5 in - set_servo_state dev.card [(left, 10); (right, 45)] - - OL_method CloseGrip : unit = fun dev -> - lwt () = set_servo_state dev.card [(right, -10)] in - lwt () = Lwt_unix.sleep 0.2 in - set_servo_state dev.card [(left, 50)] - - let make card path = - return { - obus = OBus_object.make path; - card = card; - } -end - -(* +-----------------------------------------------------------------+ - | Entry point | - +-----------------------------------------------------------------+ *) - -let motor_enable card = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.motor_enable; - RW.set_uint8 data 1 Protocol.motor_both; - Card.send_command card Protocol.cmd_motor data - -lwt () = - if not !Common.foreground then Lwt_unix.daemonize ~keep_stderr:true (); - - lwt card = Card.open_card ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_robot_interface - and bus = Lazy.force OBus_bus.system in - - lwt () = motor_enable card in - - lwt compass = Compass.make card [ "fr"; "krobot"; "Devices"; "Compass" ] - and ax12 = AX12.make card [ "fr"; "krobot"; "Devices"; "AX12" ] - and elevator = Elevator.make card [ "fr"; "krobot"; "Devices"; "Elevator" ] - and grip = Grip.make card [ "fr"; "krobot"; "Devices"; "Grip" ] in - - Compass.OBus.export bus compass; - AX12.OBus.export bus ax12; - Elevator.OBus.export bus elevator; - Grip.OBus.export bus grip; - - (* Request bus names: *) - lwt () = - Lwt_util.iter (fun name -> OBus_bus.request_name bus name >> return ()) [ - "fr.krobot.Device.Compass"; - "fr.krobot.Device.AX12"; - "fr.krobot.Device.Elevator"; - "fr.krobot.Device.Grip"; - ] - in - - fst (Lwt.wait ()) diff --git a/PC_Mainboard/daemons/dbus-drivers/card_motor.ml b/PC_Mainboard/daemons/dbus-drivers/card_motor.ml deleted file mode 100644 index 524db2c..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/card_motor.ml +++ /dev/null @@ -1,97 +0,0 @@ -(* - * card_motor.ml - * ------------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -(* Driver for the motor card *) - -open OBus_pervasives -open Lwt - -(* +-----------------------------------------------------------------+ - | Motors | - +-----------------------------------------------------------------+ *) - -module Motors = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Motors" end) - - let move cmd card arg1 arg2 arg3 = - let data = String.create 7 in - RW.set_uint8 data 0 cmd; - RW.set_int16 data 1 arg1; - RW.set_int16 data 3 arg2; - RW.set_int16 data 5 arg3; - Card.send_command card Protocol.cmd_traj data - - let move_forward = move Protocol.traj_forward - let move_backward = move Protocol.traj_backward - let turn_right = move Protocol.traj_tr - let turn_left = move Protocol.traj_tl - - let turn dev angle speed acc = - if angle < 0 then - move Protocol.traj_tl dev.card (-angle) speed acc - else - move Protocol.traj_tr dev.card angle speed acc - - let move dev dist speed acc = - if dist < 0 then - move Protocol.traj_backward dev.card (-dist) speed acc - else - move Protocol.traj_forward dev.card dist speed acc - - OL_method Turn : int -> int -> int -> unit - OL_method Move : int -> int -> int -> unit - - let make card path = - return { - obus = OBus_object.make path; - card = card; - } -end - -(* +-----------------------------------------------------------------+ - | Entry point | - +-----------------------------------------------------------------+ *) - -let motor_enable card = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.motor_enable; - RW.set_uint8 data 1 Protocol.motor_both; - Card.send_command card Protocol.cmd_motor data - -lwt () = - if not !Common.foreground then Lwt_unix.daemonize ~keep_stderr:true (); - - lwt card = Card.open_card ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_motor_controller - and bus = Lazy.force OBus_bus.system in - - lwt () = motor_enable card in - - lwt motors = Motors.make card [ "fr"; "krobot"; "Devices"; "Motors" ] in - - Motors.OBus.export bus motors; - - (* Request bus names: *) - lwt () = - Lwt_util.iter (fun name -> OBus_bus.request_name bus name >> return ()) [ - "fr.krobot.Device.Motors"; - ] - in - - fst (Lwt.wait ()) diff --git a/PC_Mainboard/daemons/dbus-drivers/card_sensor.ml b/PC_Mainboard/daemons/dbus-drivers/card_sensor.ml deleted file mode 100644 index bca7626..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/card_sensor.ml +++ /dev/null @@ -1,141 +0,0 @@ -(* - * card_sensor.ml - * -------------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -(* Driver for the sensor card *) - -open OBus_pervasives -open Lwt - -(* +-----------------------------------------------------------------+ - | Logic sensors | - +-----------------------------------------------------------------+ *) - -module LogicSensors = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - mutable data : bool array; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.LogicSensors" end) - - OL_signal Value : bool array - OL_method Get : bool array = fun dev -> return dev.data - - let get card = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.get_tor_state; - lwt data = Card.send_request card Protocol.cmd_get data in - let x = RW.get_uint16 data 0 in - return (Array.init 16 (fun i -> x land (1 lsl i) <> 0)) - - let rec loop dev = - lwt data = get dev.card in - if data <> dev.data then begin - dev.data <- data; - lwt () = value dev data in - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - end else - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - - let make card path = - lwt data = get card in - let dev = { - obus = OBus_object.make path; - card = card; - data = data; - } in - ignore (loop dev); - return dev -end - -(* +-----------------------------------------------------------------+ - | Range finders | - +-----------------------------------------------------------------+ *) - -module RangeFinders = -struct - type t = { - obus : OBus_object.t; - card : Card.t; - mutable data : int array; - } - - module OBus = OBus_object.Make(struct - type obj = t - let get obj = obj.obus - end) - - include OBus.MakeInterface(struct let name = "fr.krobot.Device.RangeFinders" end) - - OL_signal Value : int array - OL_method Get : int array = fun dev -> return dev.data - - let get card = - let data = Card.make_buffer () in - RW.set_uint8 data 0 Protocol.get_rangefinder_state; - lwt data = Card.send_request card Protocol.cmd_get data in - return (Array.init 8 (fun i -> RW.get_int32 data (i * 4))) - - let rec loop dev = - lwt data = get dev.card in - if data <> dev.data then begin - dev.data <- data; - lwt () = value dev data in - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - end else - lwt () = Lwt_unix.sleep Config.update_delay in - loop dev - - let make card path = - lwt data = get card in - let dev = { - obus = OBus_object.make path; - card = card; - data = data; - } in - ignore (loop dev); - return dev -end - -(* +-----------------------------------------------------------------+ - | Entry point | - +-----------------------------------------------------------------+ *) - -lwt () = - if not !Common.foreground then Lwt_unix.daemonize ~keep_stderr:true (); - - lwt card = Card.open_card ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_proximity_sensor - and bus = Lazy.force OBus_bus.system in - - (* Object exportation over the system bus *) - lwt logic_sensors = LogicSensors.make card [ "fr"; "krobot"; "Devices"; "LogicSensors" ] - and range_finders = RangeFinders.make card [ "fr"; "krobot"; "Devices"; "RangeFinders" ] in - - LogicSensors.OBus.export bus logic_sensors; - RangeFinders.OBus.export bus range_finders; - - (* Request bus names: *) - lwt () = - Lwt_util.iter (fun name -> OBus_bus.request_name bus name >> return ()) [ - "fr.krobot.Device.LogicSensors"; - "fr.krobot.Device.RangeFinders"; - ] - in - - fst (Lwt.wait ()) diff --git a/PC_Mainboard/daemons/dbus-drivers/common.ml b/PC_Mainboard/daemons/dbus-drivers/common.ml deleted file mode 100644 index df6ce0c..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/common.ml +++ /dev/null @@ -1,19 +0,0 @@ -(* - * common.ml - * --------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -let foreground = ref false - -let args = [ - "-n", Arg.Set foreground, "do not daemonize"; -] - -let usage_msg = Printf.sprintf "Usage: %s [-n]\n\noptions are:" (Filename.basename (Sys.argv.(0))) - -let () = - Arg.parse args ignore usage_msg diff --git a/PC_Mainboard/daemons/dbus-drivers/config.ml b/PC_Mainboard/daemons/dbus-drivers/config.ml deleted file mode 100644 index e1ee58f..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/config.ml +++ /dev/null @@ -1,10 +0,0 @@ -(* - * config.ml - * --------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -let update_delay = 0.05 diff --git a/PC_Mainboard/daemons/dbus-drivers/config.mli b/PC_Mainboard/daemons/dbus-drivers/config.mli deleted file mode 100644 index dda1d49..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/config.mli +++ /dev/null @@ -1,11 +0,0 @@ -(* - * config.mli - * ---------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -val update_delay : float - (** Time to wait between updates *) diff --git a/PC_Mainboard/daemons/dbus-drivers/fake.ml b/PC_Mainboard/daemons/dbus-drivers/fake.ml deleted file mode 100644 index 94981af..0000000 --- a/PC_Mainboard/daemons/dbus-drivers/fake.ml +++ /dev/null @@ -1,136 +0,0 @@ -(* - * fake.ml - * ------- - * Copyright : (c) 2010, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -(* A fake server that does nothing. FOr testing purpose.*) - -open OBus_pervasives -open Lwt - -module Id = struct - type obj = OBus_object.t - let get obj = obj -end - -(* +-----------------------------------------------------------------+ - | Compass | - +-----------------------------------------------------------------+ *) - -module Compass = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Compass" end) - OL_signal Value : int - OL_method Get : int = fun _ -> return 0 -end - -(* +-----------------------------------------------------------------+ - | AX12 | - +-----------------------------------------------------------------+ *) - -module AX12 = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.AX12" end) - OL_method OpenClaw : unit = fun _ -> return () - OL_method CloseClaw : unit = fun _ -> return () - OL_method OpenCylinder : unit = fun _ -> return () - OL_method CloseCylinder : unit = fun _ -> return () -end - -(* +-----------------------------------------------------------------+ - | Elevator | - +-----------------------------------------------------------------+ *) - -module Elevator = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Elevator" end) - OL_method ElevatorUp : int -> int -> unit = fun _ _ _ -> return () - OL_method ElevatorDown : int -> int -> unit = fun _ _ _ -> return () -end - -(* +-----------------------------------------------------------------+ - | Grip | - +-----------------------------------------------------------------+ *) - -module Grip = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Grip" end) - OL_method OpenGrip : unit = fun _ -> return () - OL_method CloseGrip : unit = fun _ -> return () -end - -(* +-----------------------------------------------------------------+ - | Motors | - +-----------------------------------------------------------------+ *) - -module Motors = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.Motors" end) - OL_method Turn : int -> int -> int -> unit = fun _ _ _ _ -> return () - OL_method Move : int -> int -> int -> unit = fun _ _ _ _ -> return () -end - -(* +-----------------------------------------------------------------+ - | Logic sensors | - +-----------------------------------------------------------------+ *) - -module LogicSensors = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.LogicSensors" end) - OL_signal Value : bool array - OL_method Get : bool array = fun _ -> return (Array.create 16 false) -end - -(* +-----------------------------------------------------------------+ - | Range finders | - +-----------------------------------------------------------------+ *) - -module RangeFinders = -struct - module OBus = OBus_object.Make(Id) - include OBus.MakeInterface(struct let name = "fr.krobot.Device.RangeFinders" end) - OL_signal Value : int array - OL_method Get : int array = fun _ -> return (Array.create 8 0) -end - -(* +-----------------------------------------------------------------+ - | Entry point | - +-----------------------------------------------------------------+ *) - -lwt () = - if not !Common.foreground then Lwt_unix.daemonize ~keep_stderr:true (); - - lwt bus = Lazy.force OBus_bus.system in - - Compass.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "Compass" ]); - AX12.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "AX12" ]); - Elevator.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "Elevator" ]); - Grip.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "Grip" ]); - Motors.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "Motors" ]); - LogicSensors.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "LogicSensors" ]); - RangeFinders.OBus.export bus (OBus_object.make [ "fr"; "krobot"; "Devices"; "RangeFinders" ]); - - (* Request bus names: *) - lwt () = - Lwt_util.iter (fun name -> OBus_bus.request_name bus name >> return ()) [ - "fr.krobot.Device.Compass"; - "fr.krobot.Device.AX12"; - "fr.krobot.Device.Elevator"; - "fr.krobot.Device.Grip"; - "fr.krobot.Device.Motors"; - "fr.krobot.Device.LogicSensors"; - "fr.krobot.Device.RangeFinders"; - ] - in - - fst (Lwt.wait ()) diff --git a/PC_Mainboard/daemons/dbus-rules/fr.krobot.conf b/PC_Mainboard/daemons/dbus-rules/fr.krobot.conf deleted file mode 100644 index 3e04cb6..0000000 --- a/PC_Mainboard/daemons/dbus-rules/fr.krobot.conf +++ /dev/null @@ -1,82 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> <!-- -*- XML -*- --> - -<!DOCTYPE busconfig PUBLIC - "-//freedesktop//DTD D-BUS Bus Configuration 1.0//EN" - "http://www.freedesktop.org/standards/dbus/1.0/busconfig.dtd"> -<busconfig> - <!-- Only root can own the service --> - <policy user="root"> - <allow own="fr.krobot.Device.Compass"/> - <allow own="fr.krobot.Device.AX12"/> - <allow own="fr.krobot.Device.Grip"/> - <allow own="fr.krobot.Device.Elevator"/> - <allow own="fr.krobot.Device.LogicSensors"/> - <allow own="fr.krobot.Device.RangeFinders"/> - <allow own="fr.krobot.Device.Motors"/> - </policy> - - <policy context="default"> - <!-- Compass --> - <allow send_destination="fr.krobot.Device.Compass"/> - <allow send_destination="fr.krobot.Device.Compasss" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.Compass" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.Compass" - send_interface="fr.krobot.Device.Compass"/> - - <!-- AX12 --> - <allow send_destination="fr.krobot.Device.AX12"/> - <allow send_destination="fr.krobot.Device.AX12s" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.AX12" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.AX12" - send_interface="fr.krobot.Device.AX12"/> - - <!-- Grip --> - <allow send_destination="fr.krobot.Device.Grip"/> - <allow send_destination="fr.krobot.Device.Grip" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.Grip" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.Grip" - send_interface="fr.krobot.Device.Grip"/> - - <!-- Elevator --> - <allow send_destination="fr.krobot.Device.Elevator"/> - <allow send_destination="fr.krobot.Device.Elevator" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.Elevator" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.Elevator" - send_interface="fr.krobot.Device.Elevator"/> - - <!-- LogicSensors --> - <allow send_destination="fr.krobot.Device.LogicSensors"/> - <allow send_destination="fr.krobot.Device.LogicSensors" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.LogicSensors" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.LogicSensors" - send_interface="fr.krobot.Device.LogicSensors"/> - - <!-- RangeFinders --> - <allow send_destination="fr.krobot.Device.RangeFinders"/> - <allow send_destination="fr.krobot.Device.RangeFinders" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.RangeFinders" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.RangeFinders" - send_interface="fr.krobot.Device.RangeFinders"/> - - <!-- Motors --> - <allow send_destination="fr.krobot.Device.Motors"/> - <allow send_destination="fr.krobot.Device.Motorss" - send_interface="org.freedesktop.DBus.Properties"/> - <allow send_destination="fr.krobot.Device.Motors" - send_interface="org.freedesktop.DBus.Introspectable"/> - <allow send_destination="fr.krobot.Device.Motors" - send_interface="fr.krobot.Device.Motors"/> - </policy> -</busconfig> diff --git a/PC_Mainboard/daemons/myocamlbuild.ml b/PC_Mainboard/daemons/myocamlbuild.ml deleted file mode 100644 index ba302e3..0000000 --- a/PC_Mainboard/daemons/myocamlbuild.ml +++ /dev/null @@ -1,117 +0,0 @@ -(* - * myocamlbuild.ml - * --------------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -open Printf -open Ocamlbuild_plugin - -(* +-----------------------------------------------------------------+ - | Ocamlfind | - +-----------------------------------------------------------------+ *) - -(* Put here packages you may use in this project: *) -let packages = [ - "type-conv"; - "type-conv.syntax"; - "camlp4"; - "camlp4.extend"; - "camlp4.lib"; - "camlp4.macro"; - "camlp4.quotations.o"; - "camlp4.quotations.r"; - "lwt"; - "lwt.unix"; - "lwt.syntax"; - "str"; - "xmlm"; - "react"; - "usb"; - "obus"; - "obus.syntax"; - "bitstring"; - "bitstring.syntax"; -] - -(* List of available syntaxes :*) -let syntaxes = [ - "camlp4o"; - "camlp4r"; -] - -(* +-----------------------------------------------------------------+ - | Utils | - +-----------------------------------------------------------------+ *) - -let flag_all_stages_except_link tag f = - flag ["ocaml"; "compile"; tag] f; - flag ["ocaml"; "ocamldep"; tag] f; - flag ["ocaml"; "doc"; tag] f - -let flag_all_stages tag f = - flag_all_stages_except_link tag f; - flag ["ocaml"; "link"; tag] f - -let _ = - dispatch begin function - | Before_options -> - - (* override default commands by ocamlfind ones *) - let ocamlfind x = S[A"ocamlfind"; A x] in - Options.ocamlc := ocamlfind "ocamlc"; - Options.ocamlopt := ocamlfind "ocamlopt"; - Options.ocamldep := ocamlfind "ocamldep"; - (* FIXME: sometimes ocamldoc say that elements are not found - even if they are present: *) - Options.ocamldoc := S[A"ocamlfind"; A"ocamldoc"; A"-hide-warnings"] - - | After_rules -> - - (* D-Bus drivers can see the lowlevel interfaces *) - Pathname.define_context "dbus-drivers" [ "usb" ]; - - (* Génération du fichier contenant les détails du protocol à - partir du fichier .h *) - rule "protocol du krobot" ~dep:"PcInterface.h" ~prod:"protocol.ml" - (fun _ _ -> - Cmd(S[Sh"awk '$1 == \"#define\" && $3 != \"\" { print \"let \" tolower($2) \" = \" $3 }' PcInterface.h > protocol.ml"])); - - (* +---------------------------------------------------------+ - | Virtual targets | - +---------------------------------------------------------+ *) - - let virtual_rule name deps = - rule name ~stamp:name ~deps (fun _ _ -> Nop) - in - - virtual_rule "all" ["dbus-drivers/card_interface.native"; - "dbus-drivers/card_sensor.native"; - "dbus-drivers/card_motor.native"; - "dbus-drivers/fake.native"]; - - (* +---------------------------------------------------------+ - | Ocamlfind stuff | - +---------------------------------------------------------+ *) - - (* When one link an OCaml binary, one should use -linkpkg *) - flag ["ocaml"; "link"; "program"] & A"-linkpkg"; - - (* For each ocamlfind package one inject the -package option - when compiling, computing dependencies, generating - documentation and linking. *) - List.iter - (fun package -> flag_all_stages ("pkg_" ^ package) (S[A"-package"; A package])) - packages; - - (* Like -package but for extensions syntax. Morover -syntax is - useless when linking. *) - List.iter - (fun syntax -> flag_all_stages_except_link ("syntax_" ^ syntax) (S[A"-syntax"; A syntax])) - syntaxes; - - | _ -> () - end diff --git a/PC_Mainboard/daemons/usb/RW.ml b/PC_Mainboard/daemons/usb/RW.ml deleted file mode 100644 index f7c417a..0000000 --- a/PC_Mainboard/daemons/usb/RW.ml +++ /dev/null @@ -1,37 +0,0 @@ -(* - * RW.ml - * ----- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -let get_uint8 data ofs = Char.code data.[ofs] -let set_uint8 data ofs v = data.[ofs] <- Char.unsafe_chr v -let get_int8 = get_uint8 -let set_int8 = set_uint8 - -let get_int16 data ofs = - (get_uint8 data ofs lsl 8) - lor (get_uint8 data (ofs + 1)) -let get_uint16 = get_int16 - -let set_int16 data ofs v = - set_uint8 data ofs ((v lsr 8) land 0xff); - set_uint8 data (ofs + 1) (v land 0xff) -let set_uint16 = set_int16 - -let get_int32 data ofs = - (get_uint8 data ofs lsl 24) - lor (get_uint8 data (ofs + 1) lsl 16) - lor (get_uint8 data (ofs + 2) lsl 8) - lor (get_uint8 data (ofs + 3)) -let get_uint32 = get_int32 - -let set_int32 data ofs v = - set_uint8 data ofs ((v lsr 24) land 0xff); - set_uint8 data (ofs + 1) ((v lsr 16) land 0xff); - set_uint8 data (ofs + 2) ((v lsr 8) land 0xff); - set_uint8 data (ofs + 3) (v land 0xff) -let set_uint32 = set_int32 diff --git a/PC_Mainboard/daemons/usb/RW.mli b/PC_Mainboard/daemons/usb/RW.mli deleted file mode 100644 index 4fe39fa..0000000 --- a/PC_Mainboard/daemons/usb/RW.mli +++ /dev/null @@ -1,26 +0,0 @@ -(* - * RW.mli - * ------ - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -val get_int8 : string -> int -> int -val set_int8 : string -> int -> int -> unit - -val get_int16 : string -> int -> int -val set_int16 : string -> int -> int -> unit - -val get_int32 : string -> int -> int -val set_int32 : string -> int -> int -> unit - -val get_uint8 : string -> int -> int -val set_uint8 : string -> int -> int -> unit - -val get_uint16 : string -> int -> int -val set_uint16 : string -> int -> int -> unit - -val get_uint32 : string -> int -> int -val set_uint32 : string -> int -> int -> unit diff --git a/PC_Mainboard/daemons/usb/card.ml b/PC_Mainboard/daemons/usb/card.ml deleted file mode 100644 index c781e78..0000000 --- a/PC_Mainboard/daemons/usb/card.ml +++ /dev/null @@ -1,178 +0,0 @@ -(* - * card.ml - * ------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -open Lwt - -let fatal fmt = Printf.ksprintf (fun txt -> prerr_endline ("Fatal error: " ^ txt); exit 2) fmt - -(* +-----------------------------------------------------------------+ - | Messages | - +-----------------------------------------------------------------+ *) - -let data_length = 52 - (* Taille en octet du corps d'un message *) - -type serial = int - (* Type d'un numéro de série d'un message *) - -type message = { - host_serial : serial; - (* Le numéro de série du message, émis par l'ordinateur. Vaut 0 pour - les messages émis par le PIC. *) - - device_serial : serial; - (* Le numéro de série du message, émis par le PIC. Vaut 0 pour les - messages émis par l'ordinateur. *) - - command : int; - (* La commande, en fait c'est plutôt le type du message *) - - error : int; - (* Si c'est un message d'erreur ce flag est non-nul *) - - data : string; - (* Les données du messages, il y a 52 octets. *) -} - -let make_buffer () = String.make data_length '\000' - -(* Parse un message depuis un buffer brut: *) -let parse_message buf = { - host_serial = Char.code buf.[Protocol.up_hseq]; - device_serial = Char.code buf.[Protocol.up_dseq]; - command = Char.code buf.[Protocol.up_cmd]; - error = Char.code buf.[Protocol.up_err]; - data = String.sub buf Protocol.up_data 52; -} - -(* Créé un buffer brut depuis un message: *) -let forge_message msg = - let buf = String.make 64 '\000' in - buf.[Protocol.up_hseq] <- Char.chr msg.host_serial; - buf.[Protocol.up_dseq] <- Char.chr msg.device_serial; - buf.[Protocol.up_cmd] <- Char.chr msg.command; - buf.[Protocol.up_err] <- Char.chr msg.error; - if String.length msg.data > 52 then - fatal "message trop grand pour être envoyé" - else begin - String.blit msg.data 0 buf Protocol.up_data (String.length msg.data); - buf - end - -(* +-----------------------------------------------------------------+ - | Connections | - +-----------------------------------------------------------------+ *) - -module SerialMap = Map.Make(struct type t = serial let compare = compare end) - -type t = { - - mutable serial_pool : serial list; - (* Pool de serial disponibles, comme il n'y a que 256 serial - disponibles on évite de juste incrémenter un compteur au pif. *) - - mutable reply_waiters : (string Lwt.t * string Lwt.u) SerialMap.t; - (* Threads en attente d'une réponse *) - - handle : USB.handle; - (* Handle pour le périphérique usb *) - - kernel_active : bool; - (* Est-ce qu'un driver noyau était attaché à la carte avant qu'on - l'utilise ? *) - - mutex : Lwt_mutex.t; - (* Mutex pour envoyer des commandes, les cartes n'aiment pas les - appels parallèles. *) - - mutable abort : bool; -} - -let close k = - lwt _ = USB.release_interface k.handle 0 in - if k.kernel_active then USB.attach_kernel_driver k.handle 0; - USB.close k.handle; - return () - -let rec dispatch k = - let buffer = String.create 64 in - lwt len = USB.interrupt_recv ~handle:k.handle ~endpoint:1 buffer 0 64 in - if len <> 64 then - fatal "message de moins de 64 octets reçu!" - else begin - let msg = parse_message buffer in - if msg.command = Protocol.cmd_respond then begin - (* Réponse à un message *) - match try Some(SerialMap.find msg.host_serial k.reply_waiters) with Not_found -> None with - | Some (_, w) -> - k.reply_waiters <- SerialMap.remove msg.host_serial k.reply_waiters; - k.serial_pool <- k.serial_pool @ [msg.host_serial]; - Lwt.wakeup w msg.data - | None -> - () - end; - dispatch k - end - -let open_card ~vendor_id ~product_id = - let handle = USB.open_device_with ~vendor_id ~product_id in - lwt _ = USB.reset_device handle in - let kernel_active = USB.kernel_driver_active handle 0 in - if kernel_active then USB.detach_kernel_driver handle 0; - lwt _ = USB.set_configuration handle 1 in - lwt _ = USB.claim_interface handle 0 in - let k = { serial_pool = (let rec loop = function - | 256 -> [] - | n -> n :: loop (n + 1) - in - loop 1); - reply_waiters = SerialMap.empty; - handle = handle; - kernel_active = kernel_active; - mutex = Lwt_mutex.create (); - abort = false } in - let _ = Lwt_sequence.add_l (fun _ -> close k) Lwt_main.exit_hooks in - ignore (dispatch k); - return k - -(* Envoie une commande et attend une réponse: *) -let send_request k command data = - if k.abort then fail (Failure "abort") else begin - let serial = match k.serial_pool with - | [] -> - fatal "plus aucun serial disponible!" - | s :: l -> - k.serial_pool <- l; - s - in - let (w1, w2) as w = Lwt.wait () in - k.reply_waiters <- SerialMap.add serial w k.reply_waiters; - let buffer = forge_message { host_serial = serial; - device_serial = 0; - command = command; - error = 0; - data = data } in - Lwt_mutex.with_lock k.mutex - (fun _ -> USB.interrupt_send ~handle:k.handle ~endpoint:1 buffer 0 64 >> w1) - end - -(* Envoie une commande et attend une commande: *) -let send_command k command data = - if k.abort then fail (Failure "abort") else begin - let buffer = forge_message { host_serial = 0; - device_serial = 0; - command = command; - error = 0; - data = data } in - lwt _ = USB.interrupt_send ~handle:k.handle ~endpoint:1 buffer 0 64 in - return () - end - - -let connect card command = failwith "not implemented" diff --git a/PC_Mainboard/daemons/usb/card.mli b/PC_Mainboard/daemons/usb/card.mli deleted file mode 100644 index 058d664..0000000 --- a/PC_Mainboard/daemons/usb/card.mli +++ /dev/null @@ -1,32 +0,0 @@ -(* - * card.mli - * -------- - * Copyright : (c) 2009, Jeremie Dimino <je...@di...> - * Licence : BSD3 - * - * This file is a part of [kro]bot. - *) - -(** Lowlevel card interfaces *) - -type t - (** Type of an opened card *) - -val open_card : vendor_id : int -> product_id : int -> t Lwt.t - (** Opten the card with given product-id and vendor-id *) - -val close : t -> unit Lwt.t - -val make_buffer : unit -> string - (** Creates a new buffer for serialization (with the right size) *) - -val send_request : t -> int -> string -> string Lwt.t - (** [send_request card request data] sends a request to the USB - device and wait for the reply *) - -val send_command : t -> int -> string -> unit Lwt.t - (** Sends a command to the device *) - -val connect : t -> int -> < event : string React.event; stop : unit > - (** [connect card command] connects to signals [command] emitted by - [card] *) diff --git a/PC_Mainboard/driver/Makefile b/PC_Mainboard/driver/Makefile new file mode 100644 index 0000000..59cf6b3 --- /dev/null +++ b/PC_Mainboard/driver/Makefile @@ -0,0 +1,36 @@ +# Makefile +# -------- +# Copyright : (c) 2009, Jeremie Dimino <je...@di...> +# Licence : BSD3 +# +# This file is a part of [kro]bot. + +PREFIX=/usr/local + +OC = ocamlbuild +OF = ocamlfind + +ifeq ($(TERM),dumb) +OC += -classic-display +endif + +.PHONY: all +all: + $(OC) all + +.PHONY: clean +clean: + $(OC) -clean + +.PHONY: install +install: + install -m0644 dbus-rules/fr.krobot.conf /etc/dbus-1/system.d/fr.krobot.conf + install _build/src/driver.best $(PREFIX)/bin/krobot-driver + +.PHONY: uninstall +uninstall: + rm -f /etc/dbus-1/system.d/fr.krobot.conf + rm -f $(PREFIX)/bin/krobot-driver + +.PHONY: reinstall +reinstall: uninstall install diff --git a/PC_Mainboard/driver/PcInterface.h b/PC_Mainboard/driver/PcInterface.h new file mode 100644 index 0000000..6928d8e --- /dev/null +++ b/PC_Mainboard/driver/PcInterface.h @@ -0,0 +1,208 @@ +/** + * @file PcInterface.h + * Fichier commun avec le programme hsur la carte m (USB PC). + * Ce fichier dnit de nombreuses constantes utilis pour le protocole + * de communication carte <-> PC. +*/ + +#ifndef PC_INTERFACE_H +#define PC_INTERFACE_H + +#define USB_VID 0x04D8 ///< Vendor ID commun aux diffntes cartes USB +#define USB_PID_USB_DEV_BOARD 0x0001 ///< Product ID de la Carte d'essais +#define USB_PID_PROXIMITY_SENSOR 0x0002 ///< Product ID de la Carte capteurs +#define USB_PID_MOTOR_CONTROLLER 0x0003 ///< Product ID de la Carte d'asservissement +#define USB_PID_ROBOT_INTERFACE 0x0004 ///< Product ID de la Carte d'actionneur +#define USB_PID_BATTERY_MONITORING 0x0005 ///< Product ID de la carte Battery Monitoring +#define USB_PID_BOOTLOADER 0x000b ///< Product ID d'une carte en mode bootloader + +// Protocole USB +#define UP_HSEQ 0 ///< Host sequence number +#define UP_DSEQ 1 ///< Device sequence number +#define UP_CMD 2 +#define UP_ERR 3 +#define UP_RES0 4 +#define UP_RES1 5 +#define UP_RES2 6 +#define UP_RES3 7 +#define UP_RES4 60 +#define UP_RES5 61 +#define UP_RES6 62 +#define UP_RES7 63 +#define UP_DATA 8 + +// Commande (premier bit) +#define CMD_RESET 0 ///< Reset du PIC +#define CMD_BOOTLOADER 1 ///< Reset du PIC en mode bootloader +#define CMD_GET 2 ///< Obtenir une information +#define CMD_RESPOND 3 ///< Rnse ne commande +#define CMD_ERR 4 ///< Envoyer une erreur +#define CMD_SEND 5 ///< Envoyer du texte +#define CMD_SET 6 ///< Dnir l't d'un parame +#define CMD_TEST 7 ///< Commande grique pour dencher une action de test +#define CMD_CALIBRATE 8 ///< Lance la calibration d'un tme [Carte capteurs] +#define CMD_AX12 9 +#define CMD_TRAJ 10 ///< Transmet une trajetoire au Krobot +#define CMD_MOTOR 11 ///< Gestion des moteurs +#define CMD_MOTOR_TOR 12 + +// CMD_GET arguments +#define GET_RESET_SOURCE 0 ///< Demande au PIC la source du Reset +#define GET_BOARD_INFO 1 ///< Demande au PIC le nom de la carte et l'auteur +#define GET_FIRMWARE_BUILD 2 ///< Demande au PIC la date et l'heure de compilation du firmware +#define GET_PORTS_CON... [truncated message content] |