Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 6e15de85f5b0e2ebccb0047fcacd4e3cf2755d50
|
From: Jérémie D. <Ba...@us...> - 2010-01-31 19:45: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 6e15de85f5b0e2ebccb0047fcacd4e3cf2755d50 (commit)
from 48ea6eff525ebbd96d2fa14de78f5bff22c6b782 (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 6e15de85f5b0e2ebccb0047fcacd4e3cf2755d50
Author: Jérémie Dimino <je...@di...>
Date: Sun Jan 31 20:44:17 2010 +0100
do not open everything automatically
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/clients/lib-krobot/krobot.ml b/PC_Mainboard/clients/lib-krobot/krobot.ml
index cde6b32..9f05595 100644
--- a/PC_Mainboard/clients/lib-krobot/krobot.ml
+++ b/PC_Mainboard/clients/lib-krobot/krobot.ml
@@ -10,143 +10,160 @@
open OBus_pervasives
open Lwt
-lwt bus =
- let host =
- try
- Sys.getenv "KROBOT"
- with Not_found ->
- if Unix.gethostname () = "mrp" then
- "localhost"
- else
- "mrp.wifi.crans.org"
- in
- if host = "localhost" then
- Lazy.force OBus_bus.system
- else begin
- try_lwt
- let ssh = Lwt_process.open_process ("ssh", [|"ssh"; "-l"; "olivier"; host; "/home/olivier/bin/forward_dbus.native"|]) in
- let transport =
- OBus_transport.make
- ~send:(fun msg -> OBus_wire.write_message ssh#stdin msg)
- ~recv:(fun () -> OBus_wire.read_message ssh#stdout)
- ~shutdown:(fun () -> ssh#close >> return ())
- ()
- in
- let connection = OBus_connection.of_transport transport in
- lwt () = OBus_bus.register_connection connection in
- return connection
- with exn ->
- Log#exn exn "failed to create remote transport";
- fail exn
- end
-
-let driver = OBus_peer.make bus "fr.krobot"
-
(* +-----------------------------------------------------------------+
- | Compass |
+ | Types |
+-----------------------------------------------------------------+ *)
-include OBus_interface.Make(struct let name = "fr.krobot.Device.Compass" end)
+type team = Team_red | Team_green
-OP_signal Value : int
-OP_method Get : int
+type t = {
+ (* Basic signals: *)
+ compass : int React.signal;
+ logic_sensors : bool array React.signal;
+ range_finders : int array React.signal;
-lwt compass =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Compass" ] in
- lwt initial = get proxy in
- return (React.S.hold initial (value proxy)#event)
+ peer : OBus_peer.t;
+ (* The driver peer *)
+}
(* +-----------------------------------------------------------------+
- | AX12 |
+ | Helpers |
+-----------------------------------------------------------------+ *)
-let op_method_call member typ =
- 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
-OP_method CloseClaw : unit -> unit
-OP_method OpenCylinder : unit -> unit
-OP_method CloseCylinder : unit -> unit
+(* Create an interface using [t] as type for proxies *)
+module MakeDevice(Name : sig val name : string end) =
+ OBus_interface.MakeCustom
+ (struct
+ type proxy = t
+ let get krobot = OBus_proxy.make krobot.peer ["fr"; "krobot"; "Devices"; Name.name]
+ end)
+ (struct
+ let name = "fr.krobot.Device." ^ Name.name
+ end)
+
+(* Create a reactive signal from:
+
+ - a [get] method
+ - an [update] signal
+*)
+let make_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)
(* +-----------------------------------------------------------------+
- | Elevator |
+ | Creation |
+-----------------------------------------------------------------+ *)
-let op_method_call member typ =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Elevator" ] in
- OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Elevator" ~member typ
+let get_bus () =
+ match try Some(Sys.getenv "KROBOT") with Not_found -> None with
+ | Some command -> begin
+ try_lwt
+ Log#info "connecting to the krobot with command %S" command;
+ 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 ->
+ Log#exn exn "failed to create remote transport";
+ fail exn
+ end
+ | None ->
+ try_lwt
+ Log#info "connecting to the krobot with the local system bus";
+ Lazy.force OBus_bus.system
+ with exn ->
+ Log#exn exn "failed to connect to system bus";
+ fail exn
+
+let create ?peer () =
+ lwt peer = match peer with
+ | Some peer ->
+ return peer
+ | None ->
+ 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 >>
+ in
+ return {
+ peer = peer;
+ compass = compass;
+ logic_sensors = logic_sensors;
+ range_finders = range_finders;
+ }
-OP_method ElevatorUp : int -> int -> unit
-OP_method ElevatorDown : int -> int -> unit
+(* +-----------------------------------------------------------------+
+ | Reactive signals |
+ +-----------------------------------------------------------------+ *)
-let opt = function
- | Some d -> d
- | None -> -1
+let compass krobot = krobot.compass
+let logic_sensors krobot = krobot.logic_sensors
+let range_finders krobot = krobot.range_finders
-let elevator_up ?speed ?delay () =
- elevator_up (opt speed) (opt delay)
+let team krobot =
+ React.S.map (fun ls -> if ls.(14) then Team_red else Team_green) krobot.logic_sensors
-let elevator_down ?speed ?delay () =
- elevator_down (opt speed) (opt delay)
+let jack krobot =
+ React.S.map (fun ls -> ls.(15)) krobot.logic_sensors
(* +-----------------------------------------------------------------+
- | Grip |
+ | AX12 |
+-----------------------------------------------------------------+ *)
-let op_method_call member typ =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Grip" ] in
- OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Grip" ~member typ
+include MakeDevice(struct let name = "AX12" end)
-OP_method OpenGrip : unit -> unit
-OP_method CloseGrip : unit -> unit
+OP_method OpenClaw : unit
+OP_method CloseClaw : unit
+OP_method OpenCylinder : unit
+OP_method CloseCylinder : unit
(* +-----------------------------------------------------------------+
- | Logic sensors |
+ | Elevator |
+-----------------------------------------------------------------+ *)
-include OBus_interface.Make(struct let name = "fr.krobot.Device.LogicSensors" end)
+include MakeDevice(struct let name = "Elevator" end)
-OP_signal Value : bool array
-OP_method Get : bool array
-
-lwt logic_sensors =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "LogicSensors" ] in
- lwt initial = get proxy in
- return (React.S.hold initial (value proxy)#event)
+OP_method ElevatorUp : int -> int -> unit
+OP_method ElevatorDown : int -> int -> unit
-type team = Team_red | Team_green
+let opt = function
+ | Some d -> d
+ | None -> -1
-let team =
- React.S.map (fun ls -> if ls.(14) then Team_red else Team_green) logic_sensors
+let elevator_up krobot ?speed ?delay () =
+ elevator_up krobot (opt speed) (opt delay)
-let jack =
- React.S.map (fun ls -> ls.(15)) logic_sensors
+let elevator_down krobot ?speed ?delay () =
+ elevator_down krobot (opt speed) (opt delay)
(* +-----------------------------------------------------------------+
- | Range finders |
+ | Grip |
+-----------------------------------------------------------------+ *)
-include OBus_interface.Make(struct let name = "fr.krobot.Device.RangeFinders" end)
-
-OP_signal Value : int array
-OP_method Get : int array
+include MakeDevice(struct let name = "Grip" end)
-lwt range_finders =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "RangeFinders" ] in
- lwt initial = get proxy in
- return (React.S.hold initial (value proxy)#event)
+OP_method OpenGrip : unit
+OP_method CloseGrip : unit
(* +-----------------------------------------------------------------+
| Motors |
+-----------------------------------------------------------------+ *)
-let op_method_call member typ =
- let proxy = OBus_proxy.make driver [ "fr"; "krobot"; "Devices"; "Motors" ] in
- OBus_proxy.method_call proxy ~interface:"fr.krobot.Device.Motors" ~member typ
+include MakeDevice(struct let name = "Motors" end)
OP_method Turn : int -> int -> int -> unit
OP_method Move : int -> int -> int -> unit
-let turn ~angle ~speed ~acc = turn angle speed acc
-let move ~dist ~speed ~acc = turn dist speed acc
+let turn krobot ~angle ~speed ~acc = turn krobot angle speed acc
+let move krobot ~dist ~speed ~acc = turn krobot dist speed acc
diff --git a/PC_Mainboard/clients/lib-krobot/krobot.mli b/PC_Mainboard/clients/lib-krobot/krobot.mli
index 0ec8e9c..49168e4 100644
--- a/PC_Mainboard/clients/lib-krobot/krobot.mli
+++ b/PC_Mainboard/clients/lib-krobot/krobot.mli
@@ -7,50 +7,66 @@
* This file is a part of [kro]bot.
*)
+(** Krobot client library *)
+
+(** {6 Krobot object} *)
+
+type t
+ (** Type of a Krobot client. *)
+
+val create : ?peer : OBus_peer.t -> unit -> t Lwt.t
+ (** [create ?peer ()] makes a Krobot client value. If [peer] is not
+ specified, then:
+
+ - 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
+ *)
+
(** {6 Compass} *)
-val compass : int React.signal
+val compass : t -> int React.signal
(** Signal holding the current value of the compass. *)
(** {6 Logic sensors} *)
-val logic_sensors : bool array React.signal
+val logic_sensors : t -> bool array React.signal
(** Signal holding the current state of logic sensors. *)
(** {6 Team/jack stuff} *)
type team = Team_red | Team_green
-val team : team React.signal
+val team : t -> team React.signal
(** Signal holding the state of the team button *)
-val jack : bool React.signal
+val jack : t -> bool React.signal
(** Signal holding the status of the jack *)
(** {6 Range finders} *)
-val range_finders : int array React.signal
+val range_finders : t -> int array React.signal
(** Signal holding the current range finders state *)
(** {6 Manipulation of AX12s} *)
-val open_claw : unit -> unit Lwt.t
-val close_claw : unit -> unit Lwt.t
+val open_claw : t -> unit Lwt.t
+val close_claw : t -> unit Lwt.t
-val open_cylinder : unit -> unit Lwt.t
-val close_cylinder : unit -> unit Lwt.t
+val open_cylinder : t -> unit Lwt.t
+val close_cylinder : t -> unit Lwt.t
(** {6 Manipulation of the elevator} *)
-val elevator_up : ?speed : int -> ?delay : int -> unit -> unit Lwt.t
-val elevator_down : ?speed : int -> ?delay : int -> unit -> unit Lwt.t
+val elevator_up : t -> ?speed : int -> ?delay : int -> unit -> unit Lwt.t
+val elevator_down : t -> ?speed : int -> ?delay : int -> unit -> unit Lwt.t
(** {6 Manipulation of the grip} *)
-val open_grip : unit -> unit Lwt.t
-val close_grip : unit -> unit Lwt.t
+val open_grip : t -> unit Lwt.t
+val close_grip : t -> unit Lwt.t
(** {6 Motors} *)
-val turn : angle : int -> speed : int -> acc : int -> unit Lwt.t
-val move : dist : int -> speed : int -> acc : int -> 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
diff --git a/PC_Mainboard/clients/tools/monitor.ml b/PC_Mainboard/clients/tools/monitor.ml
index bfada3d..c62812d 100644
--- a/PC_Mainboard/clients/tools/monitor.ml
+++ b/PC_Mainboard/clients/tools/monitor.ml
@@ -24,32 +24,41 @@ let draw_text screen line column txt =
in
loop column (Text.pointer_l txt)
-let print_status size compass logic_sensors range_finders team jack =
- let screen = Array.make_matrix size.lines size.columns blank in
- draw_text screen 1 1 ("team = " ^ match team with Krobot.Team_red -> "red" | Krobot.Team_green -> "green");
- draw_text screen 2 1 ("jack = " ^ if jack then "present" else "absent");
- draw_text screen 3 1 ("compass = " ^ string_of_int compass);
- draw_text screen 4 1 ("logic_sensors = " ^ String.concat "" (List.map (function true -> "O" | false -> ".") (Array.to_list logic_sensors)));
- for i = 0 to Array.length range_finders - 1 do
- draw_text screen (5 + i) 1 (Printf.sprintf "range_finders[%d] = %d" i range_finders.(i))
- done;
- for i = 1 to size.columns - 2 do
- screen.(0).(i) <- { blank with char = "─" };
- screen.(size.lines - 1).(i) <- { blank with char = "─" }
- done;
- for i = 1 to size.lines - 2 do
- screen.(i).(0) <- { blank with char = "│" };
- screen.(i).(size.columns - 1) <- { blank with char = "│" }
- done;
- screen.(0).(0) <- { blank with char = "┌" };
- screen.(size.lines - 1).(0) <- { blank with char = "└" };
- screen.(size.lines - 1).(size.columns - 1) <- { blank with char = "┘" };
- screen.(0).(size.columns - 1) <- { blank with char = "┐" };
- Lwt_term.render screen
+(* Prevent concurrent drawing: *)
+let drawer_mutex = Lwt_mutex.create ()
-let signal =
- React.S.l6 print_status size Krobot.compass Krobot.logic_sensors Krobot.range_finders Krobot.team Krobot.jack
+(* Draw the whole screen *)
+let rec draw size compass logic_sensors range_finders team jack =
+ Lwt_mutex.with_lock drawer_mutex begin fun () ->
+ if Lwt_mutex.is_empty drawer_mutex then begin
+ (* Redraw the screen only if there is no other thread waiting to
+ do it *)
+ let screen = Array.make_matrix size.lines size.columns blank in
+ draw_text screen 1 1 ("team = " ^ match team with Krobot.Team_red -> "red" | Krobot.Team_green -> "green");
+ draw_text screen 2 1 ("jack = " ^ if jack then "present" else "absent");
+ draw_text screen 3 1 ("compass = " ^ string_of_int compass);
+ draw_text screen 4 1 ("logic_sensors = " ^ String.concat "" (List.map (function true -> "O" | false -> ".") (Array.to_list logic_sensors)));
+ for i = 0 to Array.length range_finders - 1 do
+ draw_text screen (5 + i) 1 (Printf.sprintf "range_finders[%d] = %d" i range_finders.(i))
+ done;
+ for i = 1 to size.columns - 2 do
+ screen.(0).(i) <- { blank with char = "─" };
+ screen.(size.lines - 1).(i) <- { blank with char = "─" }
+ done;
+ for i = 1 to size.lines - 2 do
+ screen.(i).(0) <- { blank with char = "│" };
+ screen.(i).(size.columns - 1) <- { blank with char = "│" }
+ done;
+ screen.(0).(0) <- { blank with char = "┌" };
+ screen.(size.lines - 1).(0) <- { blank with char = "└" };
+ screen.(size.lines - 1).(size.columns - 1) <- { blank with char = "┘" };
+ screen.(0).(size.columns - 1) <- { blank with char = "┐" };
+ Lwt_term.render screen
+ end else
+ return ()
+ end
+(* Loop until an exit key is pressed *)
let rec loop_key () =
Lwt_term.read_key () >>= function
| Lwt_term.Key "q" | Lwt_term.Key_control ('c' | '[') ->
@@ -60,6 +69,18 @@ let rec loop_key () =
lwt () =
lwt () = hide_cursor () in
try_lwt
+ lwt krobot = Krobot.create () in
+ let signal =
+ React.S.l6 draw
+ Lwt_term.size
+ (Krobot.compass krobot)
+ (Krobot.logic_sensors krobot)
+ (Krobot.range_finders krobot)
+ (Krobot.team krobot)
+ (Krobot.jack krobot)
+ in
+ (* Make the compiler happy: *)
+ ignore signal;
Lwt_term.with_raw_mode loop_key
finally
show_cursor ()
diff --git a/PC_Mainboard/clients/tools/status.ml b/PC_Mainboard/clients/tools/status.ml
index 09cc72a..007cf63 100644
--- a/PC_Mainboard/clients/tools/status.ml
+++ b/PC_Mainboard/clients/tools/status.ml
@@ -13,15 +13,20 @@ open Lwt
open Krobot
lwt () =
- Lwt_io.printf "\
-compass = %d
-logic_sensors = %s
-range_finders = %s
-team = %s
-jack = %s
-"
- (React.S.value compass)
- (String.concat "" (List.map (function true -> "O" | false -> ".") (Array.to_list (React.S.value logic_sensors))))
- (String.concat " " (List.map string_of_int (Array.to_list (React.S.value range_finders))))
- (match React.S.value team with Team_red -> "red" | Team_green -> "green")
- (match React.S.value jack with true -> "present" | false -> "absent")
+ lwt krobot = Krobot.create () in
+ lwt () = Lwt_io.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 ".")
+ 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)
+ 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
+ return ()
hooks/post-receive
--
krobot
|
