From: Jérémie D. <Ba...@us...> - 2010-01-31 20:30:32
|
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 e007ef2fec366cfa70104c5d23dd9f53fa4b3947 (commit) from 6e15de85f5b0e2ebccb0047fcacd4e3cf2755d50 (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 e007ef2fec366cfa70104c5d23dd9f53fa4b3947 Author: Jérémie Dimino <je...@di...> Date: Sun Jan 31 21:29:34 2010 +0100 add interfaces for cards ----------------------------------------------------------------------- Changes: diff --git a/PC_Mainboard/clients/lib-krobot/krobot.ml b/PC_Mainboard/clients/lib-krobot/krobot.ml index 9f05595..020fc0f 100644 --- a/PC_Mainboard/clients/lib-krobot/krobot.ml +++ b/PC_Mainboard/clients/lib-krobot/krobot.ml @@ -16,12 +16,21 @@ open Lwt type team = Team_red | Team_green +type card = { + card_state : [ `Running | `Opening | `Closed ] React.signal; +} + type t = { (* Basic signals: *) compass : int React.signal; logic_sensors : bool array React.signal; range_finders : int array React.signal; + (* Cards *) + interface : card; + sensor : card; + motor : card; + peer : OBus_peer.t; (* The driver peer *) } @@ -46,12 +55,18 @@ module MakeDevice(Name : sig val name : string end) = - a [get] method - an [update] signal *) -let make_signal ~peer ~name ~get ~update ~typ = +let make_dev_signal ~peer ~name ~get ~update ~typ = let proxy = OBus_proxy.make peer ["fr"; "krobot"; "Devices"; name] in let interface = "fr.krobot.Device." ^ name in lwt initial = OBus_proxy.method_call proxy ~interface ~member:get (OBus_type.reply typ) in return (React.S.hold initial (OBus_signal.connect proxy ~interface ~member:update typ)#event) +let make_card_signal ~peer ~name ~get ~update ~typ = + let proxy = OBus_proxy.make peer ["fr"; "krobot"; "Cards"; name] in + let interface = "fr.krobot.Card" in + lwt initial = OBus_proxy.method_call proxy ~interface ~member:get (OBus_type.reply typ) in + return (React.S.hold initial (OBus_signal.connect proxy ~interface ~member:update typ)#event) + (* +-----------------------------------------------------------------+ | Creation | +-----------------------------------------------------------------+ *) @@ -84,6 +99,11 @@ let get_bus () = Log#exn exn "failed to connect to system bus"; fail exn +let obus_state = + OBus_type.mapping + OBus_pervasives.obus_uint + [(`Running, 0); (`Opening, 1); (`Closed, 2)] + let create ?peer () = lwt peer = match peer with | Some peer -> @@ -92,15 +112,21 @@ let create ?peer () = lwt bus = get_bus () in return (OBus_peer.make bus "fr.krobot") in - lwt compass = make_signal peer "Compass" "Get" "Value" <:obus_type< int >> - and logic_sensors = make_signal peer "LogicSensors" "Get" "Value" <:obus_type< bool array >> - and range_finders = make_signal peer "RangeFinders" "Get" "Value" <:obus_type< int array >> + lwt compass = make_dev_signal peer "Compass" "Get" "Value" <:obus_type< int >> + and logic_sensors = make_dev_signal peer "LogicSensors" "Get" "Value" <:obus_type< bool array >> + and range_finders = make_dev_signal peer "RangeFinders" "Get" "Value" <:obus_type< int array >> + and interface_state = make_card_signal peer "Interface" "GetState" "StateChanged" <:obus_type< state >> + and sensor_state = make_card_signal peer "Sensor" "GetState" "StateChanged" <:obus_type< state >> + and motor_state = make_card_signal peer "Motor" "GetState" "StateChanged" <:obus_type< state >> in return { peer = peer; compass = compass; logic_sensors = logic_sensors; range_finders = range_finders; + interface = { card_state = interface_state }; + sensor = { card_state = sensor_state }; + motor = { card_state = motor_state }; } (* +-----------------------------------------------------------------+ @@ -167,3 +193,38 @@ OP_method Move : int -> int -> int -> unit let turn krobot ~angle ~speed ~acc = turn krobot angle speed acc let move krobot ~dist ~speed ~acc = turn krobot dist speed acc + +(* +-----------------------------------------------------------------+ + | Cards | + +-----------------------------------------------------------------+ *) + +module Card = +struct + type card = [ `Interface | `Sensor | `Motor ] + type state = [ `Running | `Opening | `Closed ] + + let name = function + | `Interface -> "interface" + | `Sensor -> "sensor" + | `Motor -> "motor" + + let state krobot = function + | `Interface -> krobot.interface.card_state + | `Sensor -> krobot.sensor.card_state + | `Motor -> krobot.motor.card_state + + include OBus_interface.Make(struct let name = "fr.krobot.Card" end) + + OP_method GetFirmwareBuild : string + OP_method GetBoardInfo : string + + let proxy krobot card = + OBus_proxy.make krobot.peer + ["fr"; "krobot"; "Cards"; (match card with + | `Interface -> "Interface" + | `Sensor -> "Sensor" + | `Motor -> "Motor")] + + let get_firmware_build krobot card = get_firmware_build (proxy krobot card) + let get_board_info krobot card = get_board_info (proxy krobot card) +end diff --git a/PC_Mainboard/clients/lib-krobot/krobot.mli b/PC_Mainboard/clients/lib-krobot/krobot.mli index 49168e4..546751e 100644 --- a/PC_Mainboard/clients/lib-krobot/krobot.mli +++ b/PC_Mainboard/clients/lib-krobot/krobot.mli @@ -70,3 +70,20 @@ val close_grip : t -> unit Lwt.t val turn : t -> angle : int -> speed : int -> acc : int -> unit Lwt.t val move : t -> dist : int -> speed : int -> acc : int -> unit Lwt.t + +(** {6 Cards} *) + +module Card : sig + type card = [ `Interface | `Sensor | `Motor ] + + type state = [ `Running | `Opening | `Closed ] + + val name : card -> string + (** Returns the name of a card *) + + val state : t -> card -> state React.signal + (** Returns the status of one of the card of the krobot *) + + val get_firmware_build : t -> card -> string Lwt.t + val get_board_info : t -> card -> string Lwt.t +end diff --git a/PC_Mainboard/clients/tools/status.ml b/PC_Mainboard/clients/tools/status.ml index 007cf63..1cfa1bd 100644 --- a/PC_Mainboard/clients/tools/status.ml +++ b/PC_Mainboard/clients/tools/status.ml @@ -10,23 +10,42 @@ (* Print status and exit *) open Lwt +open Lwt_io open Krobot +let print_card krobot card = + match React.S.value (Card.state krobot card) with + | `Running -> + lwt firmware_build = Card.get_firmware_build krobot card + and board_info = Card.get_board_info krobot card in + let name = Card.name card in + lwt () = printlf "card.%s.state = running" name in + lwt () = printlf "card.%s.firmware_build = %s" name firmware_build in + lwt () = printlf "card.%s.board_info = %s" name board_info in + return () + | `Opening -> + printlf "card.%s.state = opening" (Card.name card) + | `Closed -> + printlf "card.%s.state = closed" (Card.name card) + lwt () = lwt krobot = Krobot.create () in - lwt () = Lwt_io.printlf "compass = %d" (React.S.value (compass krobot)) in + lwt () = printlf "compass = %d" (React.S.value (compass krobot)) in let arr = React.S.value (logic_sensors krobot) in lwt () = for_lwt i = 0 to Array.length arr - 1 do - Lwt_io.printlf "logic_sensors[%d] = %s" i (if arr.(i) then "O" else ".") + printlf "logic_sensors[%d] = %s" i (if arr.(i) then "O" else ".") done in let arr = React.S.value (range_finders krobot) in lwt () = for_lwt i = 0 to Array.length arr - 1 do - Lwt_io.printlf "range_finders[%d] = %d" i arr.(i) + printlf "range_finders[%d] = %d" i arr.(i) done in - lwt () = Lwt_io.printlf "team = %s" (match React.S.value (team krobot) with Team_red -> "red" | Team_green -> "green") in - lwt () = Lwt_io.printlf "jack = %s" (match React.S.value (jack krobot) with true -> "present" | false -> "absent") in + lwt () = printlf "team = %s" (match React.S.value (team krobot) with Team_red -> "red" | Team_green -> "green") in + lwt () = printlf "jack = %s" (match React.S.value (jack krobot) with true -> "present" | false -> "absent") in + lwt () = print_card krobot `Interface in + lwt () = print_card krobot `Sensor in + lwt () = print_card krobot `Motor in return () diff --git a/PC_Mainboard/driver/_tags b/PC_Mainboard/driver/_tags index f288f8c..aeaf11e 100644 --- a/PC_Mainboard/driver/_tags +++ b/PC_Mainboard/driver/_tags @@ -1,4 +1,5 @@ # -*- conf -*- <src/*.ml>: syntax_camlp4o, pkg_camlp4, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax +<src/card.mli>: syntax_camlp4o, pkg_obus.syntax <src/*>: thread, pkg_usb, pkg_obus diff --git a/PC_Mainboard/driver/src/card.ml b/PC_Mainboard/driver/src/card.ml index 4c2500a..80196f1 100644 --- a/PC_Mainboard/driver/src/card.ml +++ b/PC_Mainboard/driver/src/card.ml @@ -77,6 +77,11 @@ module SerialMap = Map.Make(struct type t = serial let compare = compare end) type state = Running | Opening | Closed +let obus_state = + OBus_type.mapping + OBus_pervasives.obus_uint + [(Running, 0); (Opening, 1); (Closed, 2)] + (* Type of a up and running card *) type card = { diff --git a/PC_Mainboard/driver/src/card.mli b/PC_Mainboard/driver/src/card.mli index 0e64417..b3ca5bf 100644 --- a/PC_Mainboard/driver/src/card.mli +++ b/PC_Mainboard/driver/src/card.mli @@ -22,6 +22,7 @@ type state = (** The card is being opened *) | Closed (** The card has been closed *) + with obus(basic) val state : t -> state React.signal (** [state card] is the state of a card, as a reactive value *) diff --git a/PC_Mainboard/driver/src/driver.ml b/PC_Mainboard/driver/src/driver.ml index 1ebef34..b3287cc 100644 --- a/PC_Mainboard/driver/src/driver.ml +++ b/PC_Mainboard/driver/src/driver.ml @@ -439,6 +439,57 @@ struct end (* +-----------------------------------------------------------------+ + | Objects for cards | + +-----------------------------------------------------------------+ *) + +module MCard = +struct + type t = { + card : Card.t; + obus : OBus_object.t; + } + + module OBus = OBus_object.Make(struct + type obj = t + let get obj = obj.obus + end) + + include OBus.MakeInterface(struct let name = "fr.krobot.Card" end) + + OL_property_r Name : string = fun card -> + return (Card.name card.card) + + let string_of_azt data = + try + String.sub data 0 (String.index data '\000') + with Not_found -> + data + + OL_method GetFirmwareBuild : string = fun card -> + let data = Card.make_buffer () in + RW.set_uint8 data 0 Protocol.get_firmware_build; + Card.send_request card Protocol.cmd_get data >|= string_of_azt + + OL_method GetBoardInfo : string = fun card -> + let data = Card.make_buffer () in + RW.set_uint8 data 0 Protocol.get_board_info; + Card.send_request card Protocol.cmd_get data >|= string_of_azt + + OL_method GetState : Card.state = fun card -> + return (React.S.value (Card.state card.card)) + + OL_signal StateChanged : Card.state + + let make card path = + let card = { + card = card; + obus = OBus_object.make path; + } in + Lwt_signal.always_notify_s (state_changed card) (Card.state card.card); + card +end + +(* +-----------------------------------------------------------------+ | Entry point | +-----------------------------------------------------------------+ *) @@ -495,6 +546,11 @@ lwt () = (* Motor card *) Motors.OBus.export bus (Motors.make card_motor ["fr"; "krobot"; "Devices"; "Motors"]); + (* Cards *) + MCard.OBus.export bus (MCard.make card_interface ["fr"; "krobot"; "Cards"; "Interface"]); + MCard.OBus.export bus (MCard.make card_sensor ["fr"; "krobot"; "Cards"; "Sensor"]); + MCard.OBus.export bus (MCard.make card_motor ["fr"; "krobot"; "Cards"; "Motor"]); + (* Internal objects *) Manager.OBus.export bus (); hooks/post-receive -- krobot |