Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. c3fc7c1c016367f1518bb71e6e309086efecf9a7
|
From: Jérémie D. <Ba...@us...> - 2010-04-05 12:03: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 c3fc7c1c016367f1518bb71e6e309086efecf9a7 (commit)
from 63a56a07ebda717cedfd5527b1b2af1721d4e12f (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 c3fc7c1c016367f1518bb71e6e309086efecf9a7
Author: Jérémie Dimino <je...@di...>
Date: Mon Apr 5 14:01:44 2010 +0200
Use D-Bus properties with automatic notifications
-----------------------------------------------------------------------
Changes:
diff --git a/info/control/_tags b/info/control/_tags
index bf46a8a..23ffcf3 100644
--- a/info/control/_tags
+++ b/info/control/_tags
@@ -41,6 +41,7 @@
<common/krobot_{types,util}.{ml,mli}>: syntax_camlp4o, pkg_obus.syntax, pkg_lwt.syntax
<common/krobot_{types,util}.*>: pkg_obus
+<common/var.*>: pkg_react
# +------------------------------------------------------------------+
# | Driver |
diff --git a/info/control/clients/krobot_controller.ml b/info/control/clients/krobot_controller.ml
index 16e1018..f6d3fbd 100644
--- a/info/control/clients/krobot_controller.ml
+++ b/info/control/clients/krobot_controller.ml
@@ -150,9 +150,6 @@ let check_services bus =
| Drawing |
+-----------------------------------------------------------------+ *)
-(* Thread currently redrawing the screen: *)
-let renderer = ref (return ())
-
(* Draw the whole screen *)
let rec draw krobot =
let size = React.S.value Lwt_term.size in
@@ -207,12 +204,12 @@ let rec draw krobot =
let zone = Zone.inner screen in
- let range_finders = React.S.value (Krobot.range_finders krobot) in
+ lwt range_finders = OBus_property.get (Krobot.range_finders krobot) in
for i = 0 to Array.length range_finders - 1 do
Draw.textc zone 0 i [textf "%d : " i; text (Text.repeat (range_finders.(i) * 14 / 3146) "=")]
done;
- let logic_sensors = React.S.value (Krobot.logic_sensors krobot) in
+ lwt logic_sensors = OBus_property.get (Krobot.logic_sensors krobot) in
for i = 0 to Array.length logic_sensors / 2 - 1 do
let j = i * 2 in
Draw.textf zone 20 i "%02d : %s %02d : %s"
@@ -235,16 +232,21 @@ let rec draw krobot =
| `Absent -> [fg lred; text name]
| `Present -> [text name]
in
- Draw.textc zone x 0 (text_of_state "interface" (React.S.value (Krobot.Card.state (krobot, `Interface))));
- Draw.textc zone x 1 (text_of_state "sensor" (React.S.value (Krobot.Card.state (krobot, `Sensor))));
- Draw.textc zone x 2 (text_of_state "motor" (React.S.value (Krobot.Card.state (krobot, `Motor))));
- Draw.textc zone x 3 (text_of_state "monitoring" (React.S.value (Krobot.Card.state (krobot, `Monitoring))));
+ lwt interface_state = OBus_property.get (Krobot.Card.state (krobot, `Interface))
+ and sensor_state = OBus_property.get (Krobot.Card.state (krobot, `Sensor))
+ and motor_state = OBus_property.get (Krobot.Card.state (krobot, `Motor))
+ and monitoring_state = OBus_property.get (Krobot.Card.state (krobot, `Monitoring)) in
+ Draw.textc zone x 0 (text_of_state "interface" interface_state);
+ Draw.textc zone x 1 (text_of_state "sensor" sensor_state);
+ Draw.textc zone x 2 (text_of_state "motor" motor_state);
+ Draw.textc zone x 3 (text_of_state "monitoring" monitoring_state);
let x = x + 12 in
- Draw.textf zone x 0 "team = %s" (match React.S.value (Krobot.team krobot) with
+(* Draw.textf zone x 0 "team = %s" (match React.S.value (Krobot.team krobot) with
| Krobot.Team_red -> "red"
| Krobot.Team_green -> "green");
- Draw.textf zone x 1 "jack = %s" (if React.S.value (Krobot.jack krobot) then "present" else "absent");
- Draw.textf zone x 2 "compass = %d" (React.S.value (Krobot.compass krobot));
+ Draw.textf zone x 1 "jack = %s" (if React.S.value (Krobot.jack krobot) then "present" else "absent");*)
+ lwt compass = OBus_property.get (Krobot.compass krobot) in
+ Draw.textf zone x 2 "compass = %d" compass;
let date = Unix.gettimeofday () in
let text_of_motor_state mode until =
if date < until then
@@ -252,8 +254,10 @@ let rec draw krobot =
else
[text mode; text "OK"]
in
- Draw.textc zone x 3 (text_of_motor_state "move forward: " (React.S.value (Krobot.inhibited_forward_until krobot)));
- Draw.textc zone x 4 (text_of_motor_state "move backward: " (React.S.value (Krobot.inhibited_backward_until krobot)));
+ lwt forward = OBus_property.get (Krobot.inhibit_forward_until krobot)
+ and backward = OBus_property.get (Krobot.inhibit_backward_until krobot) in
+ Draw.textc zone x 3 (text_of_motor_state "move forward: " forward);
+ Draw.textc zone x 4 (text_of_motor_state "move backward: " backward);
(* ===== History ===== *)
@@ -351,8 +355,7 @@ let rec draw krobot =
words 0)
end;
- Lwt.cancel !renderer;
- renderer := Lwt_term.render (Zone.points screen)
+ Lwt_term.render (Zone.points screen)
(* Wether the screen need to be refreshed *)
let refresh_needed = ref false
@@ -365,8 +368,7 @@ let refresh krobot =
refresh_needed := true;
lwt () = Lwt.pause () in
refresh_needed := false;
- draw krobot;
- return ()
+ draw krobot
end
(* +-----------------------------------------------------------------+
@@ -375,8 +377,8 @@ let refresh krobot =
lwt () =
lwt () = Lwt_log.notice "connecting to the krobot bus..." in
- lwt bus = Lazy.force Krobot.bus in
lwt krobot = Krobot.create () in
+ let bus = OBus_peer.connection (Krobot.to_peer krobot) in
(* Put the terminal into drawing mode: *)
lwt () = Lwt_term.enter_drawing_mode () in
@@ -410,23 +412,23 @@ lwt () =
let notify signal = Lwt_signal.always_notify (fun _ -> push ()) signal in
notify box;
notify logs;
- notify (Krobot.compass krobot);
- notify (Krobot.logic_sensors krobot);
- notify (Krobot.range_finders krobot);
- notify (Krobot.team krobot);
- notify (Krobot.jack krobot);
- notify (Krobot.inhibited_forward_until krobot);
- notify (Krobot.inhibited_backward_until krobot);
- notify (Krobot.Card.state (krobot, `Interface));
- notify (Krobot.Card.state (krobot, `Sensor));
- notify (Krobot.Card.state (krobot, `Motor));
+ lwt () = notify =|< OBus_property.monitor (Krobot.compass krobot)
+ and () = notify =|< OBus_property.monitor (Krobot.logic_sensors krobot)
+ and () = notify =|< OBus_property.monitor (Krobot.range_finders krobot)
+ (*and () = notify =|< OBus_property.monitor (Krobot.team krobot)
+ and () = notify =|< OBus_property.monitor (Krobot.jack krobot)*)
+ and () = notify =|< OBus_property.monitor (Krobot.inhibit_forward_until krobot)
+ and () = notify =|< OBus_property.monitor (Krobot.inhibit_backward_until krobot)
+ and () = notify =|< OBus_property.monitor (Krobot.Card.state (krobot, `Interface))
+ and () = notify =|< OBus_property.monitor (Krobot.Card.state (krobot, `Sensor))
+ and () = notify =|< OBus_property.monitor (Krobot.Card.state (krobot, `Motor)) in
notify services;
List.iter
(fun card ->
Lwt_event.always_notify
(fun error -> log_add_line [fg lred; textf "error on card %s: %s" (Krobot.Card.name card) error])
- (Krobot.Card.errors (krobot, card)))
+ (OBus_signal.event (Krobot.Card.errors (krobot, card))))
[`Interface; `Sensor; `Motor; `Monitoring];
(* Redraw immedlatly the screen when [signal] changes: *)
diff --git a/info/control/clients/krobot_info.ml b/info/control/clients/krobot_info.ml
index b0906dc..496a66e 100644
--- a/info/control/clients/krobot_info.ml
+++ b/info/control/clients/krobot_info.ml
@@ -13,7 +13,7 @@ open Lwt
open Lwt_io
let print_card krobot card =
- match React.S.value (Krobot.Card.state (krobot, card)) with
+ OBus_property.get (Krobot.Card.state (krobot, card)) >>= function
| `Present ->
lwt firmware_build = Krobot.Card.get_firmware_build (krobot, card)
and board_info = Krobot.Card.get_board_info (krobot, card) in
diff --git a/info/control/clients/krobot_script.ml b/info/control/clients/krobot_script.ml
index 7322c89..a3922dc 100644
--- a/info/control/clients/krobot_script.ml
+++ b/info/control/clients/krobot_script.ml
@@ -213,7 +213,7 @@ let () =
register "motors-state" f0
(fun logger krobot ->
- lwt state = Krobot.motors_state krobot in
+ lwt state = OBus_property.get (Krobot.motors_state krobot) in
logger [text "motors state: "; text state]);
register "stop-motors" (f1 stop_mode)
(fun logger krobot mode ->
diff --git a/info/control/driver/krobot_driver.ml b/info/control/driver/krobot_driver.ml
index 5d37d75..6b73a5a 100644
--- a/info/control/driver/krobot_driver.ml
+++ b/info/control/driver/krobot_driver.ml
@@ -15,6 +15,16 @@ open OBus_pervasives
open Krobot_types
open Lwt
+let make_signal ?(update_delay=Krobot_config.update_delay) get card =
+ lwt value = get card in
+ return (React.S.hold value (Lwt_event.from
+ (fun () ->
+ lwt () = Lwt_unix.sleep update_delay in
+ get card)))
+
+(* THe notification mode for all interfaces: *)
+let notify = OBus_object.notify_update "PropertiesChanged"
+
(* +-----------------------------------------------------------------+
| Battery monitoring |
+-----------------------------------------------------------------+ *)
@@ -34,10 +44,12 @@ struct
module Unsafe = Krobot_exports.Power(OBus)(struct let get dev = dev.card end)
let make card path =
- return {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface] path;
- card = card;
- }
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -49,7 +61,7 @@ struct
type t = {
obus : OBus_object.t;
card : Krobot_card.t;
- mutable data : int;
+ value : int React.signal;
}
module OBus = OBus_object.Make(struct
@@ -59,31 +71,19 @@ struct
module Unsafe = Krobot_exports.Compass(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.Compass"
-
- OL_signal Value : int
- OL_method Get : int = fun dev -> return dev.data
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.Compass"
- let rec loop dev =
- lwt _, data = Krobot_commands.Compass.get dev.card in
- if data <> dev.data then begin
- dev.data <- data;
- lwt () = value dev data in
- lwt () = Lwt_unix.sleep (Krobot_config.update_delay *. 2.) in
- loop dev
- end else
- lwt () = Lwt_unix.sleep (Krobot_config.update_delay *. 2.) in
- loop dev
+ OL_property_r Value : int
let make card path =
- lwt _, data = Krobot_commands.Compass.get card in
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- data = data;
- } in
- ignore (loop dev);
- return dev
+ lwt value = make_signal ~update_delay:(Krobot_config.update_delay *. 2.) (fun card -> snd =|< Krobot_commands.Compass.get card) card in
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ value = value;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -104,7 +104,7 @@ struct
module Unsafe = Krobot_exports.LCD(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.LCD"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.LCD"
OL_method SetLCD : string list -> unit = fun dev lines ->
if List.length lines > 4 || List.exists (fun line -> String.length line > 20) lines then
@@ -126,11 +126,12 @@ struct
OL_method BacklightOff : unit = Unsafe.backlight_off
let make card path =
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- } in
- return dev
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -151,7 +152,7 @@ struct
module Unsafe = Krobot_exports.Servo(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.Servo"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.Servo"
OL_method ClawsEnable : unit = fun dev ->
Unsafe.set_config dev 0b10100 0
@@ -169,11 +170,12 @@ struct
Unsafe.set_state dev 0b10100 0 0 (-40) 0 (-20)
let make card path =
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- } in
- return dev
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -202,7 +204,7 @@ struct
| High-level commands |
+---------------------------------------------------------------+ *)
- let ol_interface = OBus.make_interface "fr.krobot.Device.AX12"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.AX12"
OL_method SetAX12 : Krobot_types.ax12_action structure list -> unit = fun dev actions ->
lwt () =
@@ -257,10 +259,12 @@ struct
Krobot_commands.AX12.goto dev.card ~id:3 ~position:200 ~velocity:200 ~mode:`Now
let make card path =
- return {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- }
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -272,7 +276,7 @@ struct
type t = {
obus : OBus_object.t;
card : Krobot_card.t;
- mutable data : bool array;
+ value : bool array React.signal;
}
module OBus = OBus_object.Make(struct
@@ -282,30 +286,19 @@ struct
module Unsafe = Krobot_exports.Logic_sensors(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.LogicSensors"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.LogicSensors"
- OL_signal Value : bool array
- OL_method Get : bool array = fun dev -> return dev.data
-
- let rec loop dev =
- lwt data = Krobot_commands.Logic_sensors.get_state dev.card in
- if data <> dev.data then begin
- dev.data <- data;
- lwt () = value dev data in
- lwt () = Lwt_unix.sleep Krobot_config.update_delay in
- loop dev
- end else
- lwt () = Lwt_unix.sleep Krobot_config.update_delay in
- loop dev
+ OL_property_r Value : bool array
let make card path =
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- data = Array.create 16 false;
- } in
- ignore (loop dev);
- return dev
+ lwt value = make_signal Krobot_commands.Logic_sensors.get_state card in
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ value = value;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -317,7 +310,7 @@ struct
type t = {
obus : OBus_object.t;
card : Krobot_card.t;
- mutable data : int array;
+ value : int array React.signal;
}
module OBus = OBus_object.Make(struct
@@ -327,10 +320,10 @@ struct
module Unsafe = Krobot_exports.Range_finders(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.RangeFinders"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.RangeFinders"
+
+ OL_property_r Value : int array
- OL_signal Value : int array
- OL_method Get : int array = fun dev -> return dev.data
OL_method GetCalibration : int -> int array = fun dev num ->
Krobot_commands.Range_finders.get_calibration dev.card num
@@ -341,25 +334,15 @@ struct
OL_method CalibrationContinue : unit = fun dev ->
Krobot_commands.Range_finders.calibration_continue dev.card
- let rec loop dev =
- lwt data = Krobot_commands.Range_finders.get_state dev.card in
- if data <> dev.data then begin
- dev.data <- data;
- lwt () = value dev data in
- lwt () = Lwt_unix.sleep Krobot_config.update_delay in
- loop dev
- end else
- lwt () = Lwt_unix.sleep Krobot_config.update_delay in
- loop dev
-
let make card path =
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- data = Array.create 8 0;
- } in
- ignore (loop dev);
- return dev
+ lwt value = make_signal Krobot_commands.Range_finders.get_state card in
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ value = value;
+ }))
end
(* +-----------------------------------------------------------------+
@@ -397,15 +380,15 @@ struct
obus : OBus_object.t;
card : Krobot_card.t;
- mutable inhibit_forward_until : float;
- mutable inhibit_backward_until : float;
+ inhibit_forward_until : float Var.t;
+ inhibit_backward_until : float Var.t;
(* Date after which motor's inhibition should be stopped *)
traj_completed : (int * string) React.event;
(* Event which occurs each time a TRAJ_COMPLETED command is
received *)
- mutable state : state;
+ state : state Var.t;
(* The current state of the two motors *)
}
@@ -416,29 +399,33 @@ struct
module Unsafe = Krobot_exports.Motors(OBus)(struct let get dev = dev.card end)
- let ol_interface = OBus.make_interface "fr.krobot.Device.Motors"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Device.Motors"
let string_of_direction = function
| `Forward -> "forward"
| `Backward -> "backward"
- OL_method GetState : string = fun dev ->
- return (match dev.state with
- | Static ->
- "static"
- | Trajectory traj ->
- Printf.sprintf "trajectory: trajectory=%s stopped=%B"
- (match traj.trajectory with
- | `Forward -> "forward"
- | `Backward -> "backward"
- | `Left -> "left"
- | `Right -> "right"
- | `Goto -> "goto")
- traj.stopped
- | Manual(_, settings_l, settings_r) ->
- Printf.sprintf "manual: left={ direction=%s; velocity=%d; acceleration=%d } right={ direction=%s; velocity=%d; acceleration=%d }"
- (string_of_direction settings_l.direction) settings_l.velocity settings_l.acceleration
- (string_of_direction settings_r.direction) settings_r.velocity settings_r.acceleration)
+ let obus_state = OBus_type.map obus_string
+ (fun str ->
+ failwith "not implemented")
+ (function
+ | Static ->
+ "static"
+ | Trajectory traj ->
+ Printf.sprintf "trajectory: trajectory=%s stopped=%B"
+ (match traj.trajectory with
+ | `Forward -> "forward"
+ | `Backward -> "backward"
+ | `Left -> "left"
+ | `Right -> "right"
+ | `Goto -> "goto")
+ traj.stopped
+ | Manual(_, settings_l, settings_r) ->
+ Printf.sprintf "manual: left={ direction=%s; velocity=%d; acceleration=%d } right={ direction=%s; velocity=%d; acceleration=%d }"
+ (string_of_direction settings_l.direction) settings_l.velocity settings_l.acceleration
+ (string_of_direction settings_r.direction) settings_r.velocity settings_r.acceleration)
+
+ OL_property_r State : state = fun dev -> Var.signal dev.state
(* +---------------------------------------------------------------+
| High-level movement |
@@ -449,7 +436,7 @@ struct
Lwt_log.info_f ~section "move: distance=%d velocity=%d acceleration=%d"
dist velocity acc
in
- match dev.state with
+ match Var.get dev.state with
| Trajectory _ ->
lwt () = Lwt_log.info ~section "move: state=trajectory" in
fail (Failure "already in a trajectory")
@@ -459,7 +446,7 @@ struct
| Static ->
lwt () = Lwt_log.info ~section "move: state=static" in
let date = Unix.gettimeofday () in
- if (dist > 0 && date < dev.inhibit_forward_until) || (dist < 0 && date < dev.inhibit_backward_until) then
+ if (dist > 0 && date < Var.get dev.inhibit_forward_until) || (dist < 0 && date < Var.get dev.inhibit_backward_until) then
fail (Failure "inhibited move")
else begin
let waiter, wakener = Lwt.wait () in
@@ -468,7 +455,7 @@ struct
trajectory = if dist > 0 then `Forward else `Backward;
stopped = false
} in
- dev.state <- Trajectory trajectory;
+ Var.set dev.state (Trajectory trajectory);
let thread = Lwt_event.next dev.traj_completed >> return () in
lwt () =
pick [waiter;
@@ -480,7 +467,7 @@ struct
in
thread)]
in
- dev.state <- Static;
+ Var.set dev.state Static;
return (if trajectory.stopped then `Stopped else `OK)
end
@@ -489,7 +476,7 @@ struct
Lwt_log.info_f ~section "turn: angle=%d velocity=%d acceleration=%d"
angle velocity acc
in
- match dev.state with
+ match Var.get dev.state with
| Trajectory _ ->
lwt () = Lwt_log.info ~section "turn: state=trajectory" in
fail (Failure "already in a trajectory")
@@ -504,7 +491,7 @@ struct
trajectory = if angle > 0 then `Left else `Right;
stopped = false
} in
- dev.state <- Trajectory trajectory;
+ Var.set dev.state (Trajectory trajectory);
let thread = Lwt_event.next dev.traj_completed >> return () in
lwt () =
pick [waiter;
@@ -516,7 +503,7 @@ struct
in
thread)]
in
- dev.state <- Static;
+ Var.set dev.state Static;
return (if trajectory.stopped then `Stopped else `OK)
let string_of_goto_mode = function
@@ -529,7 +516,7 @@ struct
Lwt_log.info_f ~section "goto: x=%d y=%d velocity=%d acceleration=%d mode=%s bypass_distance=%d"
x y velocity acc (string_of_goto_mode mode) bypass_distance
in
- match dev.state with
+ match Var.get dev.state with
| Trajectory _ ->
lwt () = Lwt_log.info ~section "goto: state=trajectory" in
fail (Failure "already in a trajectory")
@@ -539,7 +526,7 @@ struct
| Static ->
lwt () = Lwt_log.info ~section "goto: state=static" in
let date = Unix.gettimeofday () in
- if date < dev.inhibit_forward_until then
+ if date < Var.get dev.inhibit_forward_until then
fail (Failure "inhibited move")
else begin
let waiter, wakener = Lwt.wait () in
@@ -548,7 +535,7 @@ struct
trajectory = `Goto;
stopped = false
} in
- dev.state <- Trajectory trajectory;
+ Var.set dev.state (Trajectory trajectory);
let thread = Lwt_event.next dev.traj_completed >> return () in
lwt () =
pick [waiter;
@@ -562,7 +549,7 @@ struct
in
thread)]
in
- dev.state <- Static;
+ Var.set dev.state Static;
return (if trajectory.stopped then `Stopped else `OK)
end
@@ -581,7 +568,7 @@ struct
let stop_motors dev mode =
lwt () = Lwt_log.info_f ~section "stop-motors: mode=%s" (string_of_stop_mode mode) in
- match dev.state with
+ match Var.get dev.state with
| Trajectory trajectory ->
lwt () = Lwt_log.info ~section "stop-motors: state=trajectory" in
trajectory.stopped <- true;
@@ -591,7 +578,7 @@ struct
| Manual(stopper, left, right) ->
lwt () = Lwt_log.info ~section "stop-motors: state=manual" in
lwt () = Krobot_commands.Motors.traj_stop dev.card `Both mode in
- dev.state <- Static;
+ Var.set dev.state Static;
cancel stopper;
return ()
| Static ->
@@ -602,15 +589,15 @@ struct
let direction_l, velocity_l = if velocity_l < 0 then (`Backward, -velocity_l) else (`Forward, velocity_l) in
let direction_r, velocity_r = if velocity_r < 0 then (`Backward, -velocity_r) else (`Forward, velocity_r) in
let date = Unix.gettimeofday () in
- if (((direction_l = `Forward && velocity_l > 0) || (direction_r = `Forward && velocity_r > 0)) && date < dev.inhibit_forward_until)
- || (((direction_l = `Backward && velocity_l > 0) || (direction_r = `Backward && velocity_r > 0)) && date < dev.inhibit_backward_until) then
+ if (((direction_l = `Forward && velocity_l > 0) || (direction_r = `Forward && velocity_r > 0)) && date < Var.get dev.inhibit_forward_until)
+ || (((direction_l = `Backward && velocity_l > 0) || (direction_r = `Backward && velocity_r > 0)) && date < Var.get dev.inhibit_backward_until) then
fail (Failure "inhibited move")
else begin
cancel stopper;
if velocity_l <> 0 || velocity_r <> 0 then begin
- dev.state <- Manual(Lwt_unix.sleep duration >> stop_motors dev `Smooth,
- { velocity = velocity_l; acceleration = acceleration_l; direction = direction_l },
- { velocity = velocity_r; acceleration = acceleration_r; direction = direction_r });
+ Var.set dev.state (Manual(Lwt_unix.sleep duration >> stop_motors dev `Smooth,
+ { velocity = velocity_l; acceleration = acceleration_l; direction = direction_l },
+ { velocity = velocity_r; acceleration = acceleration_r; direction = direction_r }));
lwt () =
if acceleration_l <> settings_l.acceleration then
Krobot_commands.Motors.traj_new_velocity dev.card `Left velocity_l acceleration_l direction_l
@@ -634,7 +621,7 @@ struct
(fst accelerations) (snd accelerations)
duration
in
- match dev.state with
+ match Var.get dev.state with
| Trajectory _ ->
lwt () = Lwt_log.info ~section "set-velocities: state=trajectory" in
fail (Failure "currently in trajectory mode")
@@ -653,55 +640,47 @@ struct
| Motors inhbition |
+---------------------------------------------------------------+ *)
- OL_method InhibitedForward : float = fun dev ->
- return dev.inhibit_forward_until
-
- OL_method InhibitedBackward : float = fun dev ->
- return dev.inhibit_backward_until
-
- OL_signal InhibitedForwardChanged : float
- OL_signal InhibitedBackwardChanged : float
-
- OL_method InhibitForward : float -> unit =
- fun dev delay ->
- let until = Unix.gettimeofday () +. delay in
- dev.inhibit_forward_until <- until;
- ignore (inhibited_forward_changed dev until);
- match dev.state with
- | Trajectory{ trajectory = (`Forward | `Goto) } ->
- stop_motors dev `Abrupt
- | Manual(_, settings_l, settings_r)
- when (settings_l.direction = `Forward && settings_l.velocity > 0)
- || (settings_r.direction = `Forward && settings_r.velocity > 0) ->
- stop_motors dev `Abrupt
- | _ ->
- return ()
-
- OL_method InhibitBackward : float -> unit =
- fun dev delay ->
- let until = Unix.gettimeofday () +. delay in
- dev.inhibit_backward_until <- until;
- ignore (inhibited_backward_changed dev until);
- match dev.state with
- | Trajectory{ trajectory = `Backward } ->
- stop_motors dev `Abrupt
- | Manual(_, settings_l, settings_r)
- when (settings_l.direction = `Backward && settings_l.velocity > 0)
- || (settings_r.direction = `Backward && settings_r.velocity > 0) ->
- stop_motors dev `Abrupt
- | _ ->
- return ()
+ OL_property_rw InhibitForwardUntil : float =
+ (fun dev -> Var.signal dev.inhibit_forward_until)
+ (fun dev delay ->
+ let until = Unix.gettimeofday () +. delay in
+ Var.set dev.inhibit_forward_until until;
+ match Var.get dev.state with
+ | Trajectory{ trajectory = (`Forward | `Goto) } ->
+ stop_motors dev `Abrupt
+ | Manual(_, settings_l, settings_r)
+ when (settings_l.direction = `Forward && settings_l.velocity > 0)
+ || (settings_r.direction = `Forward && settings_r.velocity > 0) ->
+ stop_motors dev `Abrupt
+ | _ ->
+ return ())
+
+ OL_property_rw InhibitBackwardUntil : float =
+ (fun dev -> Var.signal dev.inhibit_backward_until)
+ (fun dev delay ->
+ let until = Unix.gettimeofday () +. delay in
+ Var.set dev.inhibit_backward_until until;
+ match Var.get dev.state with
+ | Trajectory{ trajectory = `Backward } ->
+ stop_motors dev `Abrupt
+ | Manual(_, settings_l, settings_r)
+ when (settings_l.direction = `Backward && settings_l.velocity > 0)
+ || (settings_r.direction = `Backward && settings_r.velocity > 0) ->
+ stop_motors dev `Abrupt
+ | _ ->
+ return ())
let make card path =
- let dev = {
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- card = card;
- inhibit_forward_until = 0.0;
- inhibit_backward_until = 0.0;
- state = Static;
- traj_completed = React.E.filter (fun (cmd, data) -> cmd = PcInterface.cmd_traj && Char.code data.[0] = PcInterface.traj_completed) (Krobot_card.commands card);
- } in
- return dev
+ return
+ (OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ obus = obus;
+ card = card;
+ inhibit_forward_until = Var.create 0.0;
+ inhibit_backward_until = Var.create 0.0;
+ state = Var.create Static;
+ traj_completed = React.E.filter (fun (cmd, data) -> cmd = PcInterface.cmd_traj && Char.code data.[0] = PcInterface.traj_completed) (Krobot_card.commands card);
+ }))
end
(* +-----------------------------------------------------------------+
@@ -717,7 +696,7 @@ let card_motor, set_card_motor = React.S.create None
module Manager =
struct
- let ol_interface = OBus_object.make_interface "fr.krobot.Manager"
+ let ol_interface = OBus_object.make_interface ~notify "fr.krobot.Manager"
let close card = match React.S.value card with
| None ->
@@ -725,7 +704,7 @@ struct
| Some card ->
Krobot_card.close card
- OL_method CardStates : OBus_connection.t -> Krobot_types.card_state * Krobot_types.card_state * Krobot_types.card_state * Krobot_types.card_state = fun manager connection ->
+ OL_method CardStates : context -> Krobot_types.card_state * Krobot_types.card_state * Krobot_types.card_state * Krobot_types.card_state = fun manager (connection, message) ->
let state card = match React.S.value card with
| Some _ -> `Present
| None -> `Absent
@@ -735,7 +714,7 @@ struct
state card_motor,
state card_monitoring)
- OL_method Shutdown : OBus_connection.t -> unit = fun manager connection ->
+ OL_method Shutdown : context -> unit = fun manager (connection, message) ->
lwt () = Lwt_log.info ~section "exiting" in
quit := true;
lwt () = close card_interface
@@ -746,7 +725,7 @@ struct
Lwt.wakeup done_wakener ();
return ()
- let manager = OBus_object.make ~interfaces:[ol_interface] ["fr"; "krobot"; "Manager"]
+ let manager = OBus_object.make ~interfaces:[ol_interface] ["fr"; "krobot"; "Manager"] (fun x -> x)
end
(* +-----------------------------------------------------------------+
@@ -759,8 +738,8 @@ struct
card : Krobot_card.t option React.signal;
obus : OBus_object.t;
name : string;
- mutable state : unit Lwt.t React.signal;
- mutable errors : unit Lwt.t React.event;
+ state : Krobot_types.card
_state React.signal;
+ mutable errors : unit React.event;
}
module OBus = OBus_object.Make(struct
@@ -776,17 +755,11 @@ struct
module Unsafe = Krobot_exports.Card(OBus)(struct let get = get_card end)
- let ol_interface = OBus.make_interface "fr.krobot.Card"
+ let ol_interface = OBus.make_interface ~notify "fr.krobot.Card"
- OL_property_r Name : string = fun dev ->
- return (Krobot_card.name (get_card dev))
+ OL_property_r Name : string = fun dev -> React.S.const dev.name
- OL_method GetState : Krobot_types.card_state = fun dev ->
- match React.S.value dev.card with
- | None ->
- return `Absent
- | Some _ ->
- return `Present
+ OL_property_r State : Krobot_types.card_state
OL_method GetFirmwareBuild : string = fun dev ->
Krobot_commands.Card.get_firmware_build (get_card dev)
@@ -803,23 +776,29 @@ struct
OL_method Test : unit = fun dev ->
Krobot_commands.Card.test (get_card dev)
- OL_signal StateChanged : Krobot_types.card_state
OL_signal Error : string
let make name card path =
- let dev = {
- card = card;
- obus = OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path;
- name = name;
- state = React.S.const (return ());
- errors = React.E.never;
- } in
- dev.state <- React.S.map (function
- | None ->
- state_changed dev `Absent
- | Some card ->
- dev.errors <- React.E.map (error dev) (Krobot_card.errors card);
- state_changed dev `Present) card;
+ let dev =
+ OBus.make ~interfaces:[Unsafe.ol_interface; ol_interface] path
+ (fun obus -> {
+ card = card;
+ obus = obus;
+ name = name;
+ state = React.S.map (function None -> `Absent | Some _ -> `Present) card;
+ errors = React.E.never;
+ })
+ in
+ dev.errors <- (
+ React.E.switch React.E.never
+ (React.E.map
+ (function
+ | None ->
+ React.E.never
+ | Some card ->
+ Lwt_event.map_p (error dev) (Krobot_card.errors card))
+ (React.S.changes card))
+ );
dev
end
@@ -888,7 +867,8 @@ lwt () =
lwt () =
try_lwt
lwt () = Lwt_log.info ~section "Killing any running driver" in
- OBus_connection.method_call bus
+ OBus_method.call
+ ~connection:bus
~path:["fr"; "krobot"; "Manager"]
~interface:"fr.krobot.Manager"
~member:"Shutdown"
diff --git a/info/control/krobot.mllib b/info/control/krobot.mllib
index 03fb8f1..567016e 100644
--- a/info/control/krobot.mllib
+++ b/info/control/krobot.mllib
@@ -3,3 +3,4 @@ lib_krobot/Krobot_unsafe
lib_krobot/Krobot_move
common/Krobot_types
common/Krobot_config
+common/Var
diff --git a/info/control/lib_krobot/krobot.ml b/info/control/lib_krobot/krobot.ml
index 0969eec..477213c 100644
--- a/info/control/lib_krobot/krobot.ml
+++ b/info/control/lib_krobot/krobot.ml
@@ -14,42 +14,17 @@ open Lwt
open Krobot_types
(* +-----------------------------------------------------------------+
- | Krobot_types |
+ | Krobot_types |
+-----------------------------------------------------------------+ *)
-type team = Team_red | Team_green
-
-type card_info = {
- card_state : Krobot_types.card_state React.signal;
- card_errors : string React.event;
-}
-
-type t = {
- (* Basic signals: *)
- compass : int React.signal;
- logic_sensors : bool array React.signal;
- range_finders : int array React.signal;
-
- (* Cards *)
- interface : card_info;
- sensor : card_info;
- motor : card_info;
- monitoring : card_info;
-
- (* Motors state *)
- inhibited_forward_until : float React.signal;
- inhibited_backward_until : float React.signal;
+include OBus_peer.Private
- peer : OBus_peer.t;
- (* The driver peer *)
-}
+type team = Team_red | Team_green
type card = [ `Interface | `Sensor | `Motor | `Monitoring ]
-let peer krobot = krobot.peer
-
let card krobot card =
- OBus_proxy.make krobot.peer
+ OBus_proxy.make krobot
["fr"; "krobot"; "Cards"; (match card with
| `Interface -> "Interface"
| `Sensor -> "Sensor"
@@ -57,7 +32,7 @@ let card krobot card =
| `Monitoring -> "Monitoring" )]
let device krobot name =
- OBus_proxy.make krobot.peer ["fr"; "krobot"; "Devices"; name]
+ OBus_proxy.make krobot ["fr"; "krobot"; "Devices"; name]
(* +-----------------------------------------------------------------+
| Helpers |
@@ -65,153 +40,52 @@ let device krobot name =
(* Create an interface using [t] as type for proxies *)
module Make_device(Name : sig val name : string end) =
- OBus_proxy.Make
+struct
+ module OBus = OBus_proxy.Make
(struct
type proxy = t
- let cast krobot = OBus_proxy.make krobot.peer ["fr"; "krobot"; "Devices"; Name.name]
+ let cast krobot = OBus_proxy.make krobot ["fr"; "krobot"; "Devices"; Name.name]
let make _ = failwith "not implemented"
end)
-let make_dev_signal ~peer ~name ~get ~update ~typ ~default =
- let proxy = OBus_proxy.make peer ["fr"; "krobot"; "Devices"; name] in
- let interface = "fr.krobot.Device." ^ name in
- lwt initial =
- try_lwt
- OBus_proxy.method_call proxy ~interface ~member:get (OBus_type.reply typ)
- with exn ->
- return default
- in
- return (React.S.hold initial (OBus_signal.event (OBus_proxy.connect proxy ~interface ~member:update typ)))
-
-let make_card_signal ~peer ~name ~get ~update ~typ ~default =
- let proxy = OBus_proxy.make peer ["fr"; "krobot"; "Cards"; name] in
- let interface = "fr.krobot.Card" in
- lwt initial =
- try_lwt
- OBus_proxy.method_call proxy ~interface ~member:get (OBus_type.reply typ)
- with exn ->
- return default
- in
- return (React.S.hold initial (OBus_signal.event (OBus_proxy.connect proxy ~interface ~member:update typ)))
-
-(* +-----------------------------------------------------------------+
- | Creation |
- +-----------------------------------------------------------------+ *)
-
-let bus = lazy(
- match try Some(Sys.getenv "KROBOT") with Not_found -> None with
- | Some command -> begin
- try_lwt
- lwt () = Lwt_log.info_f ~section "connecting to the krobot with command %S" command in
- let process = Lwt_process.open_process (Lwt_process.shell command) in
- let transport =
- OBus_transport.make
- ~send:(fun msg -> OBus_wire.write_message process#stdin msg)
- ~recv:(fun () -> OBus_wire.read_message process#stdout)
- ~shutdown:(fun () -> process#close >> return ())
- ()
- in
- let connection = OBus_connection.of_transport transport in
- lwt () = OBus_bus.register_connection connection in
- return connection
- with exn ->
- lwt () = Lwt_log.error ~section ~exn "failed to create remote transport" in
- fail exn
- end
- | None ->
- try_lwt
- lwt () = Lwt_log.info ~section "connecting to the krobot with the local krobot bus" in
- OBus_bus.of_addresses (OBus_address.of_string Krobot_config.bus_address)
- with exn ->
- lwt () = Lwt_log.error ~section ~exn "failed to connect to the local krobot bus" in
- fail exn
-)
-
-let create ?peer () =
- lwt peer = match peer with
- | Some peer ->
- return peer
- | None ->
- lwt bus = Lazy.force bus in
- return (OBus_peer.make bus "fr.krobot.Driver")
- in
- lwt compass = make_dev_signal peer "Compass" "Get" "Value" <:obus_type< int >> 0
- and logic_sensors = make_dev_signal peer "LogicSensors" "Get" "Value" <:obus_type< bool array >> (Array.make 16 false)
- and range_finders = make_dev_signal peer "RangeFinders" "Get" "Value" <:obus_type< int array >> (Array.make 8 0)
- and inhibited_forward_until = make_dev_signal peer "Motors" "InhibitedForward" "InhibitedForwardChanged" <:obus_type< float >> 0.
- and inhibited_backward_until = make_dev_signal peer "Motors" "InhibitedBackward" "InhibitedBackwardChanged" <:obus_type< float >> 0.
- and card_interface = make_card_signal peer "Interface" "GetState" "StateChanged" <:obus_type< Krobot_types.card_state >> `Absent
- and card_sensor = make_card_signal peer "Sensor" "GetState" "StateChanged" <:obus_type< Krobot_types.card_state >> `Absent
- and card_motor = make_card_signal peer "Motor" "GetState" "StateChanged" <:obus_type< Krobot_types.card_state >> `Absent
- and card_monitoring = make_card_signal peer "Monitoring" "GetState" "StateChanged" <:obus_type< Krobot_types.card_state >> `Absent
- in
- return {
- peer = peer;
- compass = compass;
- logic_sensors = logic_sensors;
- range_finders = range_finders;
- inhibited_forward_until = inhibited_forward_until;
- inhibited_backward_until = inhibited_backward_until;
- interface = {
- card_state = card_interface;
- card_errors = (OBus_signal.event
- (OBus_proxy.connect
- (OBus_proxy.make peer ["fr"; "krobot"; "Cards"; "Interface"])
- ~interface:"fr.krobot.Card"
- ~member:"Error"
- <:obus_type< string >>));
- };
- sensor = {
- card_state = card_sensor;
- card_errors = (OBus_signal.event
- (OBus_proxy.connect
- (OBus_proxy.make peer ["fr"; "krobot"; "Cards"; "Sensor"])
- ~interface:"fr.krobot.Card"
- ~member:"Error"
- <:obus_type< string >>));
- };
- motor = {
- card_state = card_motor;
- card_errors = (OBus_signal.event
- (OBus_proxy.connect
- (OBus_proxy.make peer ["fr"; "krobot"; "Cards"; "Motor"])
- ~interface:"fr.krobot.Card"
- ~member:"Error"
- <:obus_type< string >>));
- };
- monitoring = {
- card_state = card_monitoring;
- card_errors = (OBus_signal.event
- (OBus_proxy.connect
- (OBus_proxy.make peer ["fr"; "krobot"; "Cards"; "Monitoring"])
- ~interface:"fr.krobot.Card"
- ~member:"Error"
- <:obus_type< string >>));
- };
- }
+ let op_interface = OBus.make_interface ~notify:(OBus_property.notify_update "PropertiesChanged") "fr.krobot.Device.Compass"
+end
(* +-----------------------------------------------------------------+
| Reactive signals |
+-----------------------------------------------------------------+ *)
-let compass krobot = krobot.compass
-let logic_sensors krobot = krobot.logic_sensors
-let range_finders krobot = krobot.range_finders
-let inhibited_forward_until krobot = krobot.inhibited_forward_until
-let inhibited_backward_until krobot = krobot.inhibited_backward_until
-
+(*
let team krobot =
React.S.map (fun ls -> if ls.(14) then Team_red else Team_green) krobot.logic_sensors
let jack krobot =
React.S.map (fun ls -> ls.(15)) krobot.logic_sensors
+*)
+(* +-----------------------------------------------------------------+
+ | Compass |
+ +-----------------------------------------------------------------+ *)
+
+module Compass = Make_device(struct let name = "Compass" end)
+let op_interface = Compass.op_interface
+
+OP_property_r Value as compass : int
+
+(* +-----------------------------------------------------------------+
+ | Logic sensors |
+ +-----------------------------------------------------------------+ *)
+
+module LS = Make_device(struct let name = "LogicSensors" end)
+let op_interface = Compass.op_interface
+
+OP_property_r Value as logic_sensors : bool array
(* +-----------------------------------------------------------------+
| LCD |
+-----------------------------------------------------------------+ *)
module LCD = Make_device(struct let name = "LCD" end)
-let op_interface = LCD.make_interface "fr.krobot.Device.LCD"
+let op_interface = Compass.op_interface
OP_method SetLCD : string list -> unit
OP_method BacklightOn : unit
@@ -222,8 +96,9 @@ OP_method BacklightOff : unit
+-----------------------------------------------------------------+ *)
module RF = Make_device(struct let name = "RangeFinders" end)
-let op_interface = RF.make_interface "fr.krobot.Device.RangeFinders"
+let op_interface = Compass.op_interface
+OP_property_r Value as range_finders : int array
OP_method GetCalibration : int -> int array
OP_method CalibrationStart : int -> bool -> unit
OP_method CalibrationStop : unit
@@ -234,7 +109,7 @@ OP_method CalibrationContinue : unit
+-----------------------------------------------------------------+ *)
module AX12 = Make_device(struct let name = "AX12" end)
-let op_interface = AX12.make_interface "fr.krobot.Device.AX12"
+let op_interface = Compass.op_interface
OP_method SetAX12 : Krobot_types.ax12_action structure list -> unit
OP_method GripUp : unit
@@ -248,7 +123,7 @@ OP_method GripRelease : unit
+-----------------------------------------------------------------+ *)
module Servo = Make_device(struct let name = "Servo" end)
-let op_interface = Servo.make_interface "fr.krobot.Device.Servo"
+let op_interface = Compass.op_interface
OP_method ClawsEnable : unit
OP_method ClawsDisable : unit
@@ -261,16 +136,16 @@ OP_method ClawsTake : unit
+-----------------------------------------------------------------+ *)
module Motors = Make_device(struct let name = "Motors" end)
-let op_interface = Motors.make_interface "fr.krobot.Device.Motors"
+let op_interface = Compass.op_interface
OP_method Turn : angle : int -> velocity : int -> acceleration : int -> Krobot_types.move_result
OP_method Move : distance : int -> velocity : int -> acceleration : int -> Krobot_types.move_result
OP_method Goto : x : int -> y : int -> velocity : int -> acceleration : int -> mode : Krobot_types.goto_mode -> bypass_distance : int -> Krobot_types.move_result
OP_method StopMotors : mode : Krobot_types.stop_mode -> unit
OP_method SetVelocities : velocities : int * int -> accelerations : int * int -> duration : float -> unit
-OP_method InhibitForward : float -> unit
-OP_method InhibitBackward : float -> unit
-OP_method GetState as motors_state : string
+OP_property_rw InhibitForwardUntil : float
+OP_property_rw InhibitBackwardUntil : float
+OP_property_r State as motors_state : string
(* +-----------------------------------------------------------------+
| Cards |
@@ -278,25 +153,12 @@ OP_method GetState as motors_state : string
module Card =
struct
-
let name = function
| `Interface -> "interface"
| `Sensor -> "sensor"
| `Motor -> "motor"
| `Monitoring -> "monitoring"
- let state (krobot, card) = match card with
- | `Interface -> krobot.interface.card_state
- | `Sensor -> krobot.sensor.card_state
- | `Motor -> krobot.motor.card_state
- | `Monitoring -> krobot.monitoring.card_state
-
- let errors (krobot, card) = match card with
- | `Interface -> krobot.interface.card_errors
- | `Sensor -> krobot.sensor.card_errors
- | `Motor -> krobot.motor.card_errors
- | `Monitoring -> krobot.monitoring.card_errors
-
module Proxy = OBus_proxy.Make
(struct
type proxy = t * card
@@ -305,9 +167,61 @@ struct
end)
let op_interface = Proxy.make_interface "fr.krobot.Card"
+
OP_method GetFirmwareBuild : string
OP_method GetBoardInfo : string
OP_method Bootloader : unit
OP_method Reset : unit
OP_method Test : unit
+ OP_property_r State : Krobot_types.card_state
+ OP_signal Errors : string
end
+
+(* +-----------------------------------------------------------------+
+ | Creation |
+ +-----------------------------------------------------------------+ *)
+
+let bus_state = ref None
+let bus_mutex = Lwt_mutex.create ()
+
+let bus () =
+ Lwt_mutex.with_lock bus_mutex
+ (fun () ->
+ match !bus_state with
+ | Some bus when React.S.value (OBus_connection.running bus) ->
+ return bus
+ | _ ->
+ match try Some(Sys.getenv "KROBOT") with Not_found -> None with
+ | Some command -> begin
+ try_lwt
+ lwt () = Lwt_log.info_f ~section "connecting to the krobot with command %S" command in
+ let process = Lwt_process.open_process (Lwt_process.shell command) in
+ let transport =
+ OBus_transport.make
+ ~send:(fun msg -> OBus_wire.write_message process#stdin msg)
+ ~recv:(fun () -> OBus_wire.read_message process#stdout)
+ ~shutdown:(fun () -> process#close >> return ())
+ ()
+ in
+ let connection = OBus_connection.of_transport transport in
+ lwt () = OBus_bus.register_connection connection in
+ bus_state := Some connection;
+ return connection
+ with exn ->
+ lwt () = Lwt_log.error ~section ~exn "failed to create remote transport" in
+ fail exn
+ end
+ | None ->
+ try_lwt
+ lwt () = Lwt_log.info ~section "connecting to the krobot with the local krobot bus" in
+ lwt bus = OBus_bus.of_addresses (OBus_address.of_string Krobot_config.bus_address) in
+ bus_state := Some bus;
+ return bus
+ with exn ->
+ lwt () = Lwt_log.error ~section ~exn "failed to connect to the local krobot bus" in
+ fail exn)
+
+
+let create () =
+ lwt bus = bus () in
+ return (OBus_peer.make bus "fr.krobot.Driver")
diff --git a/info/control/lib_krobot/krobot.mli b/info/control/lib_krobot/krobot.mli
index e75e5b2..18802d2 100644
--- a/info/control/lib_krobot/krobot.mli
+++ b/info/control/lib_krobot/krobot.mli
@@ -11,24 +11,19 @@
(** {6 Krobot object} *)
-type t
- (** Type of a Krobot client. *)
+include OBus_peer.Private
-val bus : OBus_bus.t Lwt.t Lazy.t
- (** The bus daemon used for the krobot *)
+val create : unit -> t Lwt.t
+ (** [create ()] makes a Krobot valie *)
-val create : ?peer : OBus_peer.t -> unit -> t Lwt.t
- (** [create ?peer ()] makes a Krobot client value. If [peer] is not
- specified, then:
+val bus : unit -> OBus_bus.t Lwt.t
+ (** [bus ()] returns the bus used by the krobot.
- if the environment variable [KROBOT] is set, it is used as a
- command to connect to the message bus the krobot is using.
- - otherwise it uses the local system bus
+ command to connect to the bus used by the robot,
+ - otherwise it uses the local krobot bus
*)
-val peer : t -> OBus_peer.t
- (** Returns the driver peer *)
-
val device : t -> string -> OBus_proxy.t
(** [device name] returns a proxy for the given device *)
@@ -52,27 +47,27 @@ val backlight_off : t -> unit Lwt.t
(** {6 Compass} *)
-val compass : t -> int React.signal
+val compass : t -> int OBus_property.r
(** Signal holding the current value of the compass. *)
(** {6 Logic sensors} *)
-val logic_sensors : t -> bool array React.signal
+val logic_sensors : t -> bool array OBus_property.r
(** Signal holding the current state of logic sensors. *)
(** {6 Team/jack stuff} *)
-
+(*
type team = Team_red | Team_green
-val team : t -> team React.signal
+val team : t -> team OBus_property.r
(** Signal holding the state of the team button *)
-val jack : t -> bool React.signal
+val jack : t -> bool OBus_property.r
(** Signal holding the status of the jack *)
-
+*)
(** {6 Range finders} *)
-val range_finders : t -> int array React.signal
+val range_finders : t -> int array OBus_property.r
(** Signal holding the current range finders state *)
val get_calibration : t -> int -> int array Lwt.t
@@ -105,8 +100,8 @@ val claws_take : t -> unit Lwt.t
(** {6 Motors} *)
-val motors_state : t -> string Lwt.t
- (** Return a string describing the current state of motors *)
+val motors_state : t -> string OBus_property.r
+ (** String describing the current state of motors *)
val turn : t -> angle : int -> velocity : int -> acceleration : int -> Krobot_types.move_result Lwt.t
val move : t -> distance : int -> velocity : int -> acceleration : int -> Krobot_types.move_result Lwt.t
@@ -129,21 +124,11 @@ val set_velocities : t ->
and stop the motors, unless [set_velocities] is called again
before. *)
-val inhibit_forward : t -> float -> unit Lwt.t
- (** [inhibit_forward krobot delay] forbid forward moves during
- [delay] seconds *)
+val inhibit_forward_until : t -> float OBus_property.rw
+ (** The date until which the robot is reallowed to move forward *)
-val inhibit_backward : t -> float -> unit Lwt.t
- (** [inhibit_backward krobot delay] forbid backward moves during
- [delay] seconds *)
-
-val inhibited_forward_until : t -> float React.signal
- (** Signal holding the date until which the robot is reallowed to
- move forward *)
-
-val inhibited_backward_until : t -> float React.signal
- (** Signal holding the date until which the robot is reallowed to
- move backward *)
+val inhibit_backward_until : t -> float OBus_property.rw
+ (** The date until which the robot is reallowed to move backward *)
(** {6 Cards} *)
@@ -151,16 +136,17 @@ module Card : sig
val name : card -> string
(** Returns the name of a card *)
- val state : t * card -> Krobot_types.card_state React.signal
+ val state : t * card -> Krobot_types.card_state OBus_property.r
(** Returns the status of one of the card of the krobot *)
val bootloader : t * card -> unit Lwt.t
(** Put the card into bootloader mode *)
- val errors : t * card -> string React.event
-
val get_firmware_build : t * card -> string Lwt.t
val get_board_info : t * card -> string Lwt.t
val reset : t * card -> unit Lwt.t
val test : t * card -> unit Lwt.t
+
+ val errors : t * card -> string OBus_signal.t
+ (** Errors on the given card *)
end
diff --git a/info/control/services/krobot_hard_stop.ml b/info/control/services/krobot_hard_stop.ml
index 51b832c..a8e04be 100644
--- a/info/control/services/krobot_hard_stop.ml
+++ b/info/control/services/krobot_hard_stop.ml
@@ -27,12 +27,12 @@ let handle_collide krobot sensors =
join [
(if Krobot_util.front_collide sensors then begin
lwt () = Lwt_log.notice "front collision detected, inhibit motors" in
- Krobot.inhibit_forward krobot duration
+ OBus_property.set (Krobot.inhibit_forward_until krobot) duration
end else
return ());
(if Krobot_util.back_collide sensors then begin
lwt () = Lwt_log.notice "back collision detected, inhibit motors" in
- Krobot.inhibit_backward krobot duration
+ OBus_property.set (Krobot.inhibit_backward_until krobot) duration
end else
return ());
]
@@ -42,7 +42,7 @@ let handle_collide krobot sensors =
lwt () =
Arg.parse args ignore usage;
- lwt bus = Lazy.force Krobot.bus in
+ lwt bus = Krobot.bus () in
(* Ensure there is only one running instance of the service: *)
lwt () = Krobot_util.single_instance bus "fr.krobot.HardStop" in
@@ -59,11 +59,12 @@ lwt () =
lwt krobot = Krobot.create () in
(* Stop motors as soon as possible: *)
- Lwt_signal.always_notify_p (handle_collide krobot) (Krobot.logic_sensors krobot);
+ lwt logic_sensors = OBus_property.monitor (Krobot.logic_sensors krobot) in
+ Lwt_signal.always_notify_p (handle_collide krobot) logic_sensors;
(* Continue the inhibition: *)
let rec loop () =
- lwt () = handle_collide krobot (React.S.value (Krobot.logic_sensors krobot)) in
+ lwt () = handle_collide krobot (React.S.value logic_sensors) in
lwt () = Lwt_unix.sleep (duration /. 2.) in
loop ()
in
hooks/post-receive
--
krobot
|
