Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 6945591b460b0b5106b07685b69b78d6407cacf1
|
From: Jérémie D. <Ba...@us...> - 2010-02-22 20:52:01
|
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 6945591b460b0b5106b07685b69b78d6407cacf1 (commit)
from d2fd20b4edbeb4c752610066e22224da6de64380 (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 6945591b460b0b5106b07685b69b78d6407cacf1
Author: Jérémie Dimino <je...@di...>
Date: Mon Feb 22 21:51:10 2010 +0100
autogeneration of various part of the code
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/card_tools/bootloader.ml b/PC_Mainboard/card_tools/bootloader.ml
index 28044cc..35b407e 100644
--- a/PC_Mainboard/card_tools/bootloader.ml
+++ b/PC_Mainboard/card_tools/bootloader.ml
@@ -54,8 +54,8 @@ let close k =
let open_card () =
let handle = USB.open_device_with
- ~vendor_id:Protocol.usb_vid
- ~product_id:Protocol.usb_pid_bootloader
+ ~vendor_id:PcInterface.usb_vid
+ ~product_id:PcInterface.usb_pid_bootloader
in
let kernel_active = USB.kernel_driver_active handle 0 in
if kernel_active then USB.detach_kernel_driver handle 0;
@@ -109,7 +109,7 @@ let get_flash k ~address ~length =
let length = min increment total_length in
let response_length = length+header_length in
let address = address+offset in
- put_message send_buffer Protocol.read_flash length address "";
+ put_message send_buffer PcInterface.read_flash length address "";
lwt () = send_receive_packet k send_buffer header_length receive_buffer response_length 1. 3. in
let receive_header = String.sub receive_buffer 0 header_length in
if receive_header <> send_buffer then
@@ -132,10 +132,10 @@ let erase_flash k ~address ~length =
return ()
else begin
let address = address+offset in
- put_message send_buffer Protocol.erase_flash 1 address "";
+ put_message send_buffer PcInterface.erase_flash 1 address "";
lwt () = send_receive_packet k send_buffer header_length receive_buffer response_length 1. 5. in
- if int_of_char receive_buffer.[0] <> Protocol.erase_flash then
- failwith (UnexpectedReply (receive_buffer, String.make 1 (char_of_int Protocol.erase_flash)))
+ if int_of_char receive_buffer.[0] <> PcInterface.erase_flash then
+ failwith (UnexpectedReply (receive_buffer, String.make 1 (char_of_int PcInterface.erase_flash)))
else
loop (offset+increment) (total_length-increment);
end
@@ -162,10 +162,10 @@ let write_flash k ~address data offset length =
loop (address+increment) (offset+increment) (total_length-increment)
end else begin
(* lwt () = printf "Processing address 0x%06X...\n" address in *)
- put_message send_buffer Protocol.write_flash increment address packet;
+ put_message send_buffer PcInterface.write_flash increment address packet;
lwt () = send_receive_packet k send_buffer send_length receive_buffer receive_length 0.5 1. in
- if int_of_char receive_buffer.[0] <> Protocol.write_flash then
- failwith (UnexpectedReply (receive_buffer, String.make 1 (char_of_int Protocol.erase_flash)))
+ if int_of_char receive_buffer.[0] <> PcInterface.write_flash then
+ failwith (UnexpectedReply (receive_buffer, String.make 1 (char_of_int PcInterface.erase_flash)))
else begin
lwt written = get_flash k ~address ~length:increment in
if written <> packet then
@@ -179,6 +179,6 @@ let write_flash k ~address data offset length =
let reset_board k =
let send_buffer = String.create 64 and receive_buffer = String.create 64 in
- send_buffer.[0] <- char_of_int Protocol.reset;
+ send_buffer.[0] <- char_of_int PcInterface.reset;
lwt () = send_receive_packet k send_buffer 1 receive_buffer 64 5. 5. in
return ()
diff --git a/PC_Mainboard/clients/script.ml b/PC_Mainboard/clients/script.ml
index 2d6a19b..e6d4844 100644
--- a/PC_Mainboard/clients/script.ml
+++ b/PC_Mainboard/clients/script.ml
@@ -9,114 +9,13 @@
open Lwt
open Lwt_term
+open Script_commands
module TextSet = Set.Make(Text)
let set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
(* +-----------------------------------------------------------------+
- | Commands |
- +-----------------------------------------------------------------+ *)
-
-type logger = Lwt_term.styled_text -> unit Lwt.t
-
-(* Type of an argument *)
-type arg_type =
- | Int
- | Keyword of string list
-
-type command = {
- c_name : string;
- (* The command name *)
-
- c_exec : (string * string) list -> logger -> Krobot.t -> unit Lwt.t;
- (* The command implementation. It takes as argument the list of
- parameters. *)
-
- c_args : (string * arg_type) list;
- (* Argument description, used for completion. *)
-}
-
-(* An argument description *)
-type 'a arg = {
- a_type : arg_type;
- a_name : string;
- a_cast : string -> 'a;
- a_default : 'a option;
-}
-
-(* A function description *)
-type 'a func = {
- f_args : (string * arg_type) list;
- (* Arguments of the function, for completion *)
-
- f_func : (string * string) list -> 'a -> unit Lwt.t;
- (* [f_func args f] parses arguments [args] and apply them to [f] *)
-}
-
-(* All registred commands *)
-let commands = ref []
-
-(* Register a command *)
-let register name func f =
- let command = {
- c_name = name;
- c_exec = (fun args logger krobot -> func.f_func args (f logger krobot));
- c_args = func.f_args;
- } in
- commands := command :: !commands
-
-exception Argument_error of string
- (* Exception raised when there is a problem with an argument *)
-
-let arg_error msg = raise (Argument_error msg)
-
-(* Returns the value associated to [key] if any, and the list without
- the first occurence of [key] *)
-let rec assoc_remove key = function
- | [] ->
- (None, [])
- | (key', value) :: rest when key = key' ->
- (Some value, rest)
- | pair :: rest ->
- let result, l = assoc_remove key rest in
- (result, pair :: l)
-
-let ( --> ) arg func = {
- f_args = (arg.a_name, arg.a_type) :: func.f_args;
- f_func =
- fun args f ->
- let result, args = assoc_remove arg.a_name args in
- match result with
- | Some str ->
- func.f_func args (f (arg.a_cast str))
- | None ->
- match arg.a_default with
- | Some value ->
- func.f_func args (f value)
- | None ->
- Printf.ksprintf arg_error "argument '%s' is mandatory" arg.a_name
-}
-
-let f0 = {
- f_args = [];
- f_func =
- fun args f ->
- match args with
- | [] ->
- f
- | (key, _) :: _ ->
- Printf.ksprintf arg_error "unused argument '%s'" key
-}
-
-let f1 arg0 = arg0 --> f0
-let f2 arg0 arg1 = arg0 --> (f1 arg1)
-let f3 arg0 arg1 arg2 = arg0 --> (f2 arg1 arg2)
-let f4 arg0 arg1 arg2 arg3 = arg0 --> (f3 arg1 arg2 arg3)
-let f5 arg0 arg1 arg2 arg3 arg4 = arg0 --> (f4 arg1 arg2 arg3 arg4)
-let f6 arg0 arg1 arg2 arg3 arg4 arg5 = arg0 --> (f5 arg1 arg2 arg3 arg4 arg5)
-
-(* +-----------------------------------------------------------------+
| Completion |
+-----------------------------------------------------------------+ *)
@@ -194,32 +93,6 @@ let exec ~krobot ~logger ~command =
logger [fg lred; textf "command '%s' failed with: %s" name (Printexc.to_string exn)]
(* +-----------------------------------------------------------------+
- | Arguments |
- +-----------------------------------------------------------------+ *)
-
-let int ?default name = {
- a_name = name;
- a_type = Int;
- a_cast = (fun str ->
- try
- int_of_string str
- with Failure _ ->
- Printf.ksprintf arg_error "invalid value for argument '%s': an integer was expected" name);
- a_default = default;
-}
-
-let keyword ?default name keywords = {
- a_name = name;
- a_type = Keyword(List.map fst keywords);
- a_cast = (fun key ->
- try
- List.assoc key keywords
- with Not_found ->
- Printf.ksprintf arg_error "invalid value for '%s'" name);
- a_default = default;
-}
-
-(* +-----------------------------------------------------------------+
| All commands |
+-----------------------------------------------------------------+ *)
@@ -331,47 +204,47 @@ let () =
and timeout = int ~default:100 "timeout"
and reg = int "reg"
and value = int "value"
- and now = keyword ~default:true "now" [("true", true); ("false", false)] in
+ and now = keyword ~default:`Now "mode" [("now", `Now); ("action", `Action)] in
register "ax12-goto" (f4 id pos speed now)
(fun logger krobot id pos speed now ->
- Krobot.AX12.goto krobot id pos speed now);
+ Krobot_unsafe.AX12.goto krobot id pos speed now);
register "ax12-ping" (f2 id timeout)
(fun logger krobot id timeout ->
- Krobot.AX12.ping krobot id timeout >>= function
+ Krobot_unsafe.AX12.ping krobot id timeout >>= function
| 0 -> logger [textf "ax12-ping[%d] reply: " id; fg lred; text "timeout"]
| _ -> logger [textf "ax12-ping[%d] reply: " id; fg lgreen; text "success"]);
register "ax12-read8" (f3 id reg timeout)
(fun logger krobot id reg timeout ->
- lwt x = Krobot.AX12.read8 krobot id reg timeout in
+ lwt x = Krobot_unsafe.AX12.read8 krobot id reg timeout in
logger [textf "ax12-read8[%d] reply: %d" id x]);
register "ax12-read16" (f3 id reg timeout)
(fun logger krobot id reg timeout ->
- lwt x = Krobot.AX12.read16 krobot id reg timeout in
+ lwt x = Krobot_unsafe.AX12.read16 krobot id reg timeout in
logger [textf "ax12-read16[%d] reply: %d" id x]);
register "ax12-write8" (f3 id reg value)
(fun logger krobot id reg value ->
- Krobot.AX12.write8 krobot id reg value);
+ Krobot_unsafe.AX12.write8 krobot id reg value);
register "ax12-write16" (f3 id reg value)
(fun logger krobot id reg value ->
- Krobot.AX12.write16 krobot id reg value);
+ Krobot_unsafe.AX12.write16 krobot id reg value);
register "ax12-get-pos" (f2 id timeout)
(fun logger krobot id timeout ->
- lwt x = Krobot.AX12.get_pos krobot id timeout in
+ lwt x = Krobot_unsafe.AX12.get_position krobot id timeout in
logger [textf "ax12-position[%d]: %d" id x]);
register "ax12-get-speed" (f2 id timeout)
(fun logger krobot id timeout ->
- lwt x = Krobot.AX12.get_speed krobot id timeout in
+ lwt x = Krobot_unsafe.AX12.get_velocity krobot id timeout in
logger [textf "ax12-speed[%d]: %d" id x]);
register "ax12-get-load" (f2 id timeout)
(fun logger krobot id timeout ->
- lwt x = Krobot.AX12.get_load krobot id timeout in
+ lwt x = Krobot_unsafe.AX12.get_load krobot id timeout in
logger [textf "ax12-load[%d]: %d" id x]);
register "ax12-stats" (f2 id timeout)
(fun logger krobot id timeout ->
- lwt stats = Krobot.AX12.stats krobot id timeout in
+ lwt stats = Krobot_unsafe.AX12.get_stats krobot id timeout in
lwt () = logger [textf "ax12[%d] position = %d" id stats.Types.ax12_position] in
- lwt () = logger [textf "ax12[%d] speed = %d" id stats.Types.ax12_speed] in
+ lwt () = logger [textf "ax12[%d] velocity = %d" id stats.Types.ax12_velocity] in
lwt () = logger [textf "ax12[%d] torque = %d" id stats.Types.ax12_torque] in
lwt () = logger [textf "ax12[%d] voltage = %d" id stats.Types.ax12_voltage] in
lwt () = logger [textf "ax12[%d] temperature = %d" id stats.Types.ax12_temperature] in
@@ -380,10 +253,12 @@ let () =
return ());
register "ax12-write-reg8" (f3 id reg value)
(fun logger krobot id reg value ->
- Krobot.AX12.write_reg8 krobot id reg value);
+ Krobot_unsafe.AX12.write_register8 krobot id reg value);
register "ax12-write-reg16" (f3 id reg value)
(fun logger krobot id reg value ->
- Krobot.AX12.write_reg16 krobot id reg value);
+ Krobot_unsafe.AX12.write_register16 krobot id reg value);
register "ax12-action" (f1 (int ~default:254 "id"))
(fun logger krobot id ->
- Krobot.AX12.action krobot id)
+ Krobot_unsafe.AX12.action krobot id)
+
+let () = Script_unsafe.register ()
diff --git a/PC_Mainboard/clients/script_commands.ml b/PC_Mainboard/clients/script_commands.ml
new file mode 100644
index 0000000..a86a01d
--- /dev/null
+++ b/PC_Mainboard/clients/script_commands.ml
@@ -0,0 +1,137 @@
+(*
+ * script_commands.ml
+ * ------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+
+(* +-----------------------------------------------------------------+
+ | Types |
+ +-----------------------------------------------------------------+ *)
+
+type logger = Lwt_term.styled_text -> unit Lwt.t
+
+(* Type of an argument *)
+type arg_type =
+ | Int
+ | Keyword of string list
+
+type command = {
+ c_name : string;
+ (* The command name *)
+
+ c_exec : (string * string) list -> logger -> Krobot.t -> unit Lwt.t;
+ (* The command implementation. It takes as argument the list of
+ parameters. *)
+
+ c_args : (string * arg_type) list;
+ (* Argument description, used for completion. *)
+}
+
+(* An argument description *)
+type 'a arg = {
+ a_type : arg_type;
+ a_name : string;
+ a_cast : string -> 'a;
+ a_default : 'a option;
+}
+
+(* A function description *)
+type 'a func = {
+ f_args : (string * arg_type) list;
+ (* Arguments of the function, for completion *)
+
+ f_func : (string * string) list -> 'a -> unit Lwt.t;
+ (* [f_func args f] parses arguments [args] and apply them to [f] *)
+}
+
+(* All registred commands *)
+let commands = ref []
+
+(* Register a command *)
+let register name func f =
+ let command = {
+ c_name = name;
+ c_exec = (fun args logger krobot -> func.f_func args (f logger krobot));
+ c_args = func.f_args;
+ } in
+ commands := command :: !commands
+
+exception Argument_error of string
+ (* Exception raised when there is a problem with an argument *)
+
+let arg_error msg = raise (Argument_error msg)
+
+(* Returns the value associated to [key] if any, and the list without
+ the first occurence of [key] *)
+let rec assoc_remove key = function
+ | [] ->
+ (None, [])
+ | (key', value) :: rest when key = key' ->
+ (Some value, rest)
+ | pair :: rest ->
+ let result, l = assoc_remove key rest in
+ (result, pair :: l)
+
+let ( --> ) arg func = {
+ f_args = (arg.a_name, arg.a_type) :: func.f_args;
+ f_func =
+ fun args f ->
+ let result, args = assoc_remove arg.a_name args in
+ match result with
+ | Some str ->
+ func.f_func args (f (arg.a_cast str))
+ | None ->
+ match arg.a_default with
+ | Some value ->
+ func.f_func args (f value)
+ | None ->
+ Printf.ksprintf arg_error "argument '%s' is mandatory" arg.a_name
+}
+
+let f0 = {
+ f_args = [];
+ f_func =
+ fun args f ->
+ match args with
+ | [] ->
+ f
+ | (key, _) :: _ ->
+ Printf.ksprintf arg_error "unused argument '%s'" key
+}
+
+let f1 arg0 = arg0 --> f0
+let f2 arg0 arg1 = arg0 --> (f1 arg1)
+let f3 arg0 arg1 arg2 = arg0 --> (f2 arg1 arg2)
+let f4 arg0 arg1 arg2 arg3 = arg0 --> (f3 arg1 arg2 arg3)
+let f5 arg0 arg1 arg2 arg3 arg4 = arg0 --> (f4 arg1 arg2 arg3 arg4)
+let f6 arg0 arg1 arg2 arg3 arg4 arg5 = arg0 --> (f5 arg1 arg2 arg3 arg4 arg5)
+
+(* +-----------------------------------------------------------------+
+ | Arguments |
+ +-----------------------------------------------------------------+ *)
+
+let int ?default name = {
+ a_name = name;
+ a_type = Int;
+ a_cast = (fun str ->
+ try
+ int_of_string str
+ with Failure _ ->
+ Printf.ksprintf arg_error "invalid value for argument '%s': an integer was expected" name);
+ a_default = default;
+}
+
+let keyword ?default name keywords = {
+ a_name = name;
+ a_type = Keyword(List.map fst keywords);
+ a_cast = (fun key ->
+ try
+ List.assoc key keywords
+ with Not_found ->
+ Printf.ksprintf arg_error "invalid value for '%s'" name);
+ a_default = default;
+}
diff --git a/PC_Mainboard/common/types.ml b/PC_Mainboard/common/types.ml
index 60ab4ce..07199cb 100644
--- a/PC_Mainboard/common/types.ml
+++ b/PC_Mainboard/common/types.ml
@@ -43,10 +43,21 @@ let obus_goto_mode = OBus_type.mapping obus_int
type ax12_stats = {
ax12_position : int;
- ax12_speed : int;
+ ax12_velocity : int;
ax12_torque : int;
ax12_voltage : int;
ax12_temperature : int;
ax12_cw_angle_limit : int;
ax12_ccw_angle_limit : int;
} with obus
+
+type exec_mode = [ `Now | `Action ]
+
+let obus_exec_mode = OBus_type.mapping obus_int
+ [(`Now, 0); (`Action, 1)]
+
+type direction = [ `Forward | `Backward ]
+
+let obus_direction = OBus_type.mapping obus_int
+ [(`Forward, 0); (`Backward, 1)]
+
diff --git a/PC_Mainboard/common/types.mli b/PC_Mainboard/common/types.mli
index 164f85a..ec1598d 100644
--- a/PC_Mainboard/common/types.mli
+++ b/PC_Mainboard/common/types.mli
@@ -25,15 +25,20 @@ type motor = [ `Left | `Right | `Both ] with obus(basic)
type stop_mode = [ `Off | `Abrupt | `Smooth ] with obus(basic)
(** Mode for stopping motors *)
+type direction = [ `Forward | `Backward ] with obus(basic)
+
type card_state = [ `Present | `Absent ] with obus(basic)
(** State of a card *)
type goto_mode = [ `Straight | `Curve_right | `Curve_left ] with obus(basic)
(** Form of the trajectory for the goto command *)
+type exec_mode = [ `Now | `Action ] with obus(basic)
+ (** Mode of execution of the goto command for ax12 *)
+
type ax12_stats = {
ax12_position : int;
- ax12_speed : int;
+ ax12_velocity : int;
ax12_torque : int;
ax12_voltage : int;
ax12_temperature : int;
diff --git a/PC_Mainboard/driver/RW.ml b/PC_Mainboard/driver/RW.ml
index f7c417a..4406039 100644
--- a/PC_Mainboard/driver/RW.ml
+++ b/PC_Mainboard/driver/RW.ml
@@ -7,31 +7,75 @@
* 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
+type pointer = {
+ mutable offset : int;
+ buffer : string;
+}
+
+type writer = pointer
+type reader = pointer
+
+let writer buffer = { buffer = buffer; offset = 0 }
+let reader buffer = { buffer = buffer; offset = 0 }
+
+let get_uint8 pointer =
+ let offset = pointer.offset in
+ pointer.offset <- offset + 1;
+ int_of_char pointer.buffer.[offset]
+let put_uint8 pointer value =
+ let offset = pointer.offset in
+ pointer.offset <- offset + 1;
+ pointer.buffer.[offset] <- char_of_int value
+let get_sint8 = get_uint8
+let put_sint8 = put_uint8
+
+let get_sint16 pointer =
+ let v0 = get_uint8 pointer in
+ let v1 = get_uint8 pointer in
+ (v0 lsl 8) lor v1
+let get_uint16 = get_sint16
+
+let put_sint16 pointer value =
+ put_uint8 pointer ((value lsr 8) land 0xff);
+ put_uint8 pointer (value land 0xff)
+let put_uint16 = put_sint16
+
+let get_sint32 pointer =
+ let v0 = get_uint8 pointer in
+ let v1 = get_uint8 pointer in
+ let v2 = get_uint8 pointer in
+ let v3 = get_uint8 pointer in
+ (v0 lsl 24) lor (v1 lsl 16) lor (v2 lsl 8) lor v3
+let get_uint32 = get_sint32
+
+let put_sint32 pointer value =
+ put_uint8 pointer ((value lsr 24) land 0xff);
+ put_uint8 pointer ((value lsr 16) land 0xff);
+ put_uint8 pointer ((value lsr 8) land 0xff);
+ put_uint8 pointer (value land 0xff)
+let put_uint32 = put_sint32
+
+let get_string pointer =
+ let index =
+ try
+ String.index_from pointer.buffer pointer.offset '\000'
+ with Not_found ->
+ String.length pointer.buffer
+ in
+ let offset = pointer.offset in
+ pointer.offset <- index + 1;
+ String.sub pointer.buffer offset (index - offset)
+
+let put_string pointer value =
+ let len = String.length value in
+ if len > String.length pointer.buffer - pointer.offset then
+ invalid_arg "RW.put_string: string too long"
+ else begin
+ String.blit value 0 pointer.buffer pointer.offset len;
+ let offset = pointer.offset + len in
+ if offset < String.length pointer.buffer then begin
+ pointer.buffer.[offset] <- '\x00';
+ pointer.offset <- offset + 1
+ end else
+ pointer.offset <- offset
+ end
diff --git a/PC_Mainboard/driver/RW.mli b/PC_Mainboard/driver/RW.mli
index 4fe39fa..92948c0 100644
--- a/PC_Mainboard/driver/RW.mli
+++ b/PC_Mainboard/driver/RW.mli
@@ -7,20 +7,38 @@
* This file is a part of [kro]bot.
*)
-val get_int8 : string -> int -> int
-val set_int8 : string -> int -> int -> unit
+(** Serialisation/deserialisation *)
-val get_int16 : string -> int -> int
-val set_int16 : string -> int -> int -> unit
+(** {6 Writing} *)
-val get_int32 : string -> int -> int
-val set_int32 : string -> int -> int -> unit
+type writer
-val get_uint8 : string -> int -> int
-val set_uint8 : string -> int -> int -> unit
+val writer : string -> writer
+ (** [writer buffer] creates a writer which writes into [buffer] *)
-val get_uint16 : string -> int -> int
-val set_uint16 : string -> int -> int -> unit
+val put_sint8 : writer -> int -> unit
+val put_sint16 : writer -> int -> unit
+val put_sint32 : writer -> int -> unit
-val get_uint32 : string -> int -> int
-val set_uint32 : string -> int -> int -> unit
+val put_uint8 : writer -> int -> unit
+val put_uint16 : writer -> int -> unit
+val put_uint32 : writer -> int -> unit
+
+val put_string : writer -> string -> unit
+
+(** {6 Reading} *)
+
+type reader
+
+val reader : string -> reader
+ (** [reader buffer] creates a reader which reads from [buffer] *)
+
+val get_sint8 : reader -> int
+val get_sint16 : reader -> int
+val get_sint32 : reader -> int
+
+val get_uint8 : reader -> int
+val get_uint16 : reader -> int
+val get_uint32 : reader -> int
+
+val get_string : reader -> string
diff --git a/PC_Mainboard/driver/card.ml b/PC_Mainboard/driver/card.ml
index 5ecf347..4956a72 100644
--- a/PC_Mainboard/driver/card.ml
+++ b/PC_Mainboard/driver/card.ml
@@ -44,24 +44,24 @@ 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;
+ host_serial = Char.code buf.[PcInterface.up_hseq];
+ device_serial = Char.code buf.[PcInterface.up_dseq];
+ command = Char.code buf.[PcInterface.up_cmd];
+ error = Char.code buf.[PcInterface.up_err];
+ data = String.sub buf PcInterface.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;
+ buf.[PcInterface.up_hseq] <- Char.chr msg.host_serial;
+ buf.[PcInterface.up_dseq] <- Char.chr msg.device_serial;
+ buf.[PcInterface.up_cmd] <- Char.chr msg.command;
+ buf.[PcInterface.up_err] <- Char.chr msg.error;
if String.length msg.data > 52 then
Printf.ksprintf invalid_arg "message body too big: %d > 52" (String.length msg.data)
else begin
- String.blit msg.data 0 buf Protocol.up_data (String.length msg.data);
+ String.blit msg.data 0 buf PcInterface.up_data (String.length msg.data);
buf
end
@@ -190,7 +190,7 @@ let rec dispatch card =
return ()
end else begin
let msg = parse_message buffer in
- if msg.command = Protocol.cmd_respond then begin
+ if msg.command = PcInterface.cmd_respond then begin
match try Some(Int_map.find msg.host_serial card.reply_waiters) with Not_found -> None with
| Some wakener ->
card.reply_waiters <- Int_map.remove msg.host_serial card.reply_waiters;
diff --git a/PC_Mainboard/driver/commands.ml b/PC_Mainboard/driver/commands.ml
deleted file mode 100644
index 49b7eb2..0000000
--- a/PC_Mainboard/driver/commands.ml
+++ /dev/null
@@ -1,315 +0,0 @@
-(*
- * commands.ml
- * -----------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Lwt
-open Types
-
-let string_of_azt data =
- try
- String.sub data 0 (String.index data '\000')
- with Not_found ->
- data
-
-let get_firmware_build 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
-
-let get_board_info 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
-
-let bootloader card =
- Card.send_command card Protocol.cmd_bootloader ""
-
-let reset card =
- Card.send_command card Protocol.cmd_reset ""
-
-let test card =
- Card.send_command card Protocol.cmd_test ""
-
-module Compass =
-struct
- let get card =
- lwt data = Card.send_request card Protocol.get_cmp03_data "" in
- return (RW.get_int16 data 2)
-end
-
-module AX12 =
-struct
- let goto card id pos speed now =
- 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;
- RW.set_uint8 data 6 (if now then
- Protocol.ax12_exec_now
- else
- Protocol.ax12_exec_action);
- lwt _ = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-
- let ping card id timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_ping;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint8 data 0)
-
- let read8 card id reg timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_read;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value8;
- RW.set_uint8 data 4 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint8 data 0)
-
- let read16 card id reg timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_read;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value16;
- RW.set_uint8 data 4 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint16 data 0)
-
- let write8 card id reg value =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_write;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value8;
- RW.set_uint8 data 4 value;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-
- let write16 card id reg value =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_write;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value16;
- RW.set_uint16 data 4 value;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-
- let get_pos card id timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_get_pos;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint16 data 0)
-
- let get_speed card id timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_get_speed;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint16 data 0)
-
- let get_load card id timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_get_load;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return (RW.get_uint16 data 0)
-
- let stats card id timeout =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.ax12_get_stats;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 timeout;
- lwt data = Card.send_request card Protocol.cmd_ax12 data in
- return { ax12_position = RW.get_int16 data 0;
- ax12_speed = RW.get_int16 data 2;
- ax12_torque = RW.get_int16 data 4;
- ax12_voltage = RW.get_uint8 data 6;
- ax12_temperature = RW.get_uint8 data 7;
- ax12_cw_angle_limit = RW.get_int16 data 8;
- ax12_ccw_angle_limit = RW.get_int16 data 10 }
-
- let write_reg8 card id reg value =
- let data = String.create 5 in
- RW.set_uint8 data 0 Protocol.ax12_write_reg;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value8;
- RW.set_uint8 data 4 value;
- lwt _ = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-
- let write_reg16 card id reg value =
- let data = String.create 6 in
- RW.set_uint8 data 0 Protocol.ax12_write_reg;
- RW.set_uint8 data 1 id;
- RW.set_uint8 data 2 reg;
- RW.set_uint8 data 3 Protocol.ax12_value16;
- RW.set_int16 data 4 value;
- lwt _ = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-
- let action card id =
- let data = String.create 2 in
- RW.set_uint8 data 0 Protocol.ax12_action;
- RW.set_uint8 data 1 id;
- lwt _ = Card.send_request card Protocol.cmd_ax12 data in
- return ()
-end
-
-module Logic_sensors =
-struct
- 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))
-end
-
-module Range_finders =
-struct
- 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 get_calibration card num =
- if num < 0 || num > 7 then invalid_arg "Commands.Range_finders.get_calibration";
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.get_rangefinder_calibration;
- RW.set_uint8 data 1 num;
- lwt data = Card.send_request card Protocol.cmd_get data in
- return (Array.init 8 (fun i -> RW.get_uint8 data i))
-
- let calibration_start card num skip_meas =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.cal_start;
- RW.set_uint8 data 1 num;
- RW.set_uint8 data 2 (if skip_meas then 1 else 0);
- Card.send_command card Protocol.cmd_calibrate data
-
- let calibration_continue card =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.cal_continue;
- Card.send_command card Protocol.cmd_calibrate data
-
- let calibration_stop card =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.cal_stop;
- Card.send_command card Protocol.cmd_calibrate data
-end
-
-module Motor =
-struct
- type t = [ `Left | `Right | `Both ]
- type stop_mode = [ `Off | `Abrupt | `Smooth ]
- type direction = [ `Forward | `Backward ]
-
- let backend 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 card ~dist ~speed ~acc =
- if dist < 0 then
- backend Protocol.traj_backward card (-dist) speed acc
- else
- backend Protocol.traj_forward card dist speed acc
-
- let turn card ~angle ~speed ~acc =
- if angle < 0 then
- backend Protocol.traj_tr card (-angle) speed acc
- else
- backend Protocol.traj_tl card angle speed acc
-
- let goto card ~x ~y ~speed ~acc ~mode ~bypass_dist =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.traj_goto;
- RW.set_int16 data 1 x;
- RW.set_int16 data 3 y;
- RW.set_int16 data 5 speed;
- RW.set_int16 data 7 acc;
- RW.set_uint8 data 9 (match mode with (* lm629.h:157 *)
- | `Straight -> 0
- | `Curve_right -> 1
- | `Curve_left -> 2);
- RW.set_int16 data 10 bypass_dist;
- Card.send_command card Protocol.cmd_traj data
-
- (* Values comming from lm629.h *)
- let int_of_direction motor dir = match motor, dir with
- | `Right, `Forward -> -1
- | `Right, `Backward -> 1
- | _, `Forward -> 1
- | _, `Backward -> -1
-
- let int_of_motor = function
- | `Left -> Protocol.motor_left
- | `Both -> Protocol.motor_both
- | `Right -> Protocol.motor_right
-
- let int_of_stop_mode = function
- | `Off -> Protocol.traj_stop_motor_off
- | `Abrupt -> Protocol.traj_stop_abrupt
- | `Smooth -> Protocol.traj_stop_smooth
-
- let traj_new_velocity card ~motor ~speed ~acc ~dir =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.traj_new_velocity;
- RW.set_uint8 data 1 (int_of_motor motor);
- RW.set_int16 data 2 speed;
- RW.set_int16 data 4 acc;
- RW.set_uint8 data 6 (int_of_direction motor dir);
- Card.send_command card Protocol.cmd_traj data
-
- let traj_change_velocity card ~motor ~speed ~dir =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.traj_change_velocity;
- RW.set_uint8 data 1 (int_of_motor motor);
- RW.set_int16 data 2 speed;
- RW.set_uint8 data 4 (int_of_direction motor dir);
- Card.send_command card Protocol.cmd_traj data
-
- let traj_start card ~motor =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.traj_start;
- RW.set_uint8 data 1 (int_of_motor motor);
- Card.send_command card Protocol.cmd_traj data
-
- let init_lm629 card =
- let data = Card.make_buffer () in
- RW.set_uint8 data 0 Protocol.traj_init;
- Card.send_command card Protocol.cmd_traj data
-
- let 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
-
- let stop card ~motor ~mode =
- let data = String.create 4 in
- RW.set_uint8 data 0 Protocol.traj_stop;
- RW.set_uint8 data 1 (int_of_motor motor);
- RW.set_uint16 data 2 (int_of_stop_mode mode);
- Card.send_command card Protocol.cmd_traj data
-end
diff --git a/PC_Mainboard/driver/commands.mli b/PC_Mainboard/driver/commands.mli
deleted file mode 100644
index 3832838..0000000
--- a/PC_Mainboard/driver/commands.mli
+++ /dev/null
@@ -1,72 +0,0 @@
-(*
- * commands.mli
- * ------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-(** All commands, by card *)
-
-(** {6 Common commands} *)
-
-val get_firmware_build : Card.t -> string Lwt.t
-val get_board_info : Card.t -> string Lwt.t
-val bootloader : Card.t -> unit Lwt.t
-val reset : Card.t -> unit Lwt.t
-val test : Card.t -> unit Lwt.t
-
-module Compass : sig
- val get : Card.t -> int Lwt.t
-end
-
-module AX12 : sig
- val goto : Card.t -> int -> int -> int -> bool -> unit Lwt.t
- val ping : Card.t -> int -> int -> int Lwt.t
- val read8 : Card.t -> int -> int -> int -> int Lwt.t
- val read16 : Card.t -> int -> int -> int -> int Lwt.t
- val write8 : Card.t -> int -> int -> int -> unit Lwt.t
- val write16 : Card.t -> int -> int -> int -> unit Lwt.t
- val get_pos : Card.t -> int -> int -> int Lwt.t
- val get_speed : Card.t -> int -> int -> int Lwt.t
- val get_load : Card.t -> int -> int -> int Lwt.t
- val stats : Card.t -> int -> int -> Types.ax12_stats Lwt.t
- val write_reg8 : Card.t -> int -> int -> int -> unit Lwt.t
- val write_reg16 : Card.t -> int -> int -> int -> unit Lwt.t
- val action : Card.t -> int -> unit Lwt.t
-end
-
-module Logic_sensors : sig
- val get : Card.t -> bool array Lwt.t
-end
-
-module Range_finders : sig
- val get : Card.t -> int array Lwt.t
- val get_calibration : Card.t -> int -> int array Lwt.t
- val calibration_start : Card.t -> int -> bool -> unit Lwt.t
- val calibration_continue : Card.t -> unit Lwt.t
- val calibration_stop : Card.t -> unit Lwt.t
-end
-
-module Motor : sig
- type t = [ `Left | `Right | `Both ]
-
- val move : Card.t -> dist : int -> speed : int -> acc : int -> unit Lwt.t
- val turn : Card.t -> angle : int -> speed : int -> acc : int -> unit Lwt.t
-
- val goto : Card.t -> x : int -> y : int -> speed : int -> acc : int -> mode : Types.goto_mode -> bypass_dist : int -> unit Lwt.t
-
- type stop_mode = [ `Off | `Abrupt | `Smooth ]
-
- val stop : Card.t -> motor : t -> mode : stop_mode -> unit Lwt.t
-
- type direction = [ `Forward | `Backward ]
-
- val traj_new_velocity : Card.t -> motor : t -> speed : int -> acc : int -> dir : direction -> unit Lwt.t
- val traj_change_velocity : Card.t -> motor : t -> speed : int -> dir : direction -> unit Lwt.t
- val traj_start : Card.t -> motor : t -> unit Lwt.t
-
- val enable : Card.t -> unit Lwt.t
- val init_lm629 : Card.t -> unit Lwt.t
-end
diff --git a/PC_Mainboard/driver/driver.ml b/PC_Mainboard/driver/driver.ml
index 0003dcc..06ef21d 100644
--- a/PC_Mainboard/driver/driver.ml
+++ b/PC_Mainboard/driver/driver.ml
@@ -31,6 +31,8 @@ struct
let get obj = obj.obus
end)
+ include DBus_exports.Compass(OBus)(struct let get dev = dev.card end)(struct let name = "fr.krobot.Device.Compass.Unsafe" end)
+
include OBus.MakeInterface(struct let name = "fr.krobot.Device.Compass" end)
OL_signal Value : int
@@ -74,23 +76,9 @@ struct
let get obj = obj.obus
end)
- include OBus.MakeInterface(struct let name = "fr.krobot.Device.AX12" end)
+ include DBus_exports.AX12(OBus)(struct let get dev = dev.card end)(struct let name = "fr.krobot.Device.AX12.Unsafe" end)
- let wrap f dev = f dev.card
-
- OL_method Goto : int -> int -> int -> bool -> unit = wrap Commands.AX12.goto
- OL_method Ping : int -> int -> int = wrap Commands.AX12.ping
- OL_method Read8 : int -> int -> int -> int = wrap Commands.AX12.read8
- OL_method Read16 : int -> int -> int -> int = wrap Commands.AX12.read16
- OL_method Write8 : int -> int -> int -> unit = wrap Commands.AX12.write8
- OL_method Write16 : int -> int -> int -> unit = wrap Commands.AX12.write16
- OL_method GetPos : int -> int -> int = wrap Commands.AX12.get_pos
- OL_method GetSpeed : int -> int -> int = wrap Commands.AX12.get_speed
- OL_method GetLoad : int -> int -> int = wrap Commands.AX12.get_load
- OL_method Stats : int -> int -> Types.ax12_stats = wrap Commands.AX12.stats
- OL_method WriteReg8 : int -> int -> int -> unit = wrap Commands.AX12.write_reg8
- OL_method WriteReg16 : int -> int -> int -> unit = wrap Commands.AX12.write_reg16
- OL_method Action : int -> unit = wrap Commands.AX12.action
+ include OBus.MakeInterface(struct let name = "fr.krobot.Device.AX12" end)
let make card path =
return {
@@ -116,13 +104,15 @@ struct
let get obj = obj.obus
end)
+ include DBus_exports.Logic_sensors(OBus)(struct let get dev = dev.card end)(struct let name = "fr.krobot.Device.LogicSensors.Unsafe" 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 rec loop dev =
- lwt data = Commands.Logic_sensors.get dev.card in
+ lwt data = Commands.Logic_sensors.get_state dev.card in
if data <> dev.data then begin
dev.data <- data;
lwt () = value dev data in
@@ -159,6 +149,8 @@ struct
let get obj = obj.obus
end)
+ include DBus_exports.Range_finders(OBus)(struct let get dev = dev.card end)(struct let name = "fr.krobot.Device.RangeFinders.Unsafe" end)
+
include OBus.MakeInterface(struct let name = "fr.krobot.Device.RangeFinders" end)
OL_signal Value : int array
@@ -174,7 +166,7 @@ struct
Commands.Range_finders.calibration_continue dev.card
let rec loop dev =
- lwt data = Commands.Range_finders.get dev.card in
+ lwt data = Commands.Range_finders.get_state dev.card in
if data <> dev.data then begin
dev.data <- data;
lwt () = value dev data in
@@ -246,6 +238,8 @@ struct
let get obj = obj.obus
end)
+ include DBus_exports.Motor(OBus)(struct let get dev = dev.card end)(struct let name = "fr.krobot.Device.Motors.Unsafe" end)
+
include OBus.MakeInterface(struct let name = "fr.krobot.Device.Motors" end)
(* +---------------------------------------------------------------+
@@ -283,7 +277,12 @@ struct
else begin
reset_speed dev;
dev.move_state <- Ms_moving(if dist > 0 then `Forward else `Backward);
- lwt () = Commands.Motor.move dev.card dist speed acc and _ = Lwt_event.next dev.traj_completed in
+ lwt () =
+ if dist > 0 then
+ Commands.Motor.forward dev.card dist speed acc
+ else
+ Commands.Motor.backward dev.card (-dist) speed acc
+ and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
`Stopped
@@ -302,7 +301,12 @@ struct
| Ms_static ->
reset_speed dev;
dev.move_state <- Ms_moving `Turn;
- lwt () = Commands.Motor.turn dev.card angle speed acc and _ = Lwt_event.next dev.traj_completed in
+ lwt () =
+ if angle > 0 then
+ Commands.Motor.right dev.card angle speed acc
+ else
+ Commands.Motor.left dev.card (-angle) speed acc
+ and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
`Stopped
@@ -312,14 +316,14 @@ struct
dev.move_state <- Ms_static;
return result
- let goto dev x y speed acc mode bypass_dist =
+ let goto dev x y speed acc mode bypass_distance =
match dev.move_state with
| Ms_moving _ | Ms_stopping ->
fail (Failure "already moving")
| Ms_static ->
reset_speed dev;
dev.move_state <- Ms_moving `Goto;
- lwt () = Commands.Motor.goto dev.card ~x ~y ~speed ~acc ~mode ~bypass_dist and _ = Lwt_event.next dev.traj_completed in
+ lwt () = Commands.Motor.goto dev.card ~x ~y ~velocity:speed ~acceleration:acc ~mode ~bypass_distance and _ = Lwt_event.next dev.traj_completed in
let result = match dev.move_state with
| Ms_stopping ->
`Stopped
@@ -350,7 +354,7 @@ struct
let stop_motors dev motor mode =
lwt () = Log.info_f "motor: stopping(motor=%s, mode=%s)" (string_of_motor motor) (string_of_stop_mode mode) in
stop_move dev;
- Commands.Motor.stop dev.card motor mode
+ Commands.Motor.traj_stop dev.card motor mode
let set_speed dev motor speed acc =
lwt () = Log.info_f "motor: set_speed(motor=%s, speed=%d, acc=%d)" (string_of_motor motor) speed acc in
@@ -431,7 +435,7 @@ struct
return ()
let make card path =
- let commands = React.E.map (fun data -> Char.code data.[0]) (Card.connect card Protocol.cmd_traj)#event in
+ let commands = React.E.map (fun data -> Char.code data.[0]) (Card.connect card PcInterface.cmd_traj)#event in
let dev = {
obus = OBus_object.make path;
card = card;
@@ -440,7 +444,7 @@ struct
inhibit_backward_until = 0.0;
move_state = Ms_static;
commands = commands;
- traj_completed = React.E.filter ((=) Protocol.traj_completed) commands;
+ traj_completed = React.E.filter ((=) PcInterface.traj_completed) commands;
speed_left = 0;
speed_right = 0;
stop_rthread = return ();
@@ -514,14 +518,16 @@ struct
let get obj = obj.obus
end)
- include OBus.MakeInterface(struct let name = "fr.krobot.Card" end)
-
let get_card dev = match React.S.value dev.card with
| None ->
Printf.ksprintf failwith "%s card is not available" dev.name
| Some card ->
card
+ include DBus_exports.Common(OBus)(struct let get = get_card end)(struct let name = "fr.krobot.Card.Unsafe" end)
+
+ include OBus.MakeInterface(struct let name = "fr.krobot.Card" end)
+
OL_property_r Name : string = fun dev ->
return (Card.name (get_card dev))
@@ -663,9 +669,9 @@ lwt () =
in
ignore begin
- monitor_card ~name:"interace" ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_robot_interface ~set:set_card_interface
+ monitor_card ~name:"interace" ~vendor_id:PcInterface.usb_vid ~product_id:PcInterface.usb_pid_robot_interface ~set:set_card_interface
(fun card ->
- lwt () = Commands.Motor.enable card in
+ lwt () = Commands.Motor.enable card `Both in
lwt () = Compass.OBus.export bus =|< Compass.make card ["fr"; "krobot"; "Devices"; "Compass"]
and () = AX12.OBus.export bus =|< AX12.make card ["fr"; "krobot"; "Devices"; "AX12"] in
return ())
@@ -676,7 +682,7 @@ lwt () =
end;
ignore begin
- monitor_card ~name:"sensor" ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_proximity_sensor ~set:set_card_sensor
+ monitor_card ~name:"sensor" ~vendor_id:PcInterface.usb_vid ~product_id:PcInterface.usb_pid_proximity_sensor ~set:set_card_sensor
(fun card ->
lwt () = Logic_sensors.OBus.export bus =|< Logic_sensors.make card ["fr"; "krobot"; "Devices"; "LogicSensors"]
and () = Range_finders.OBus.export bus =|< Range_finders.make card ["fr"; "krobot"; "Devices"; "RangeFinders"] in
@@ -688,9 +694,9 @@ lwt () =
end;
ignore begin
- monitor_card ~name:"motor" ~vendor_id:Protocol.usb_vid ~product_id:Protocol.usb_pid_motor_controller ~set:set_card_motor
+ monitor_card ~name:"motor" ~vendor_id:PcInterface.usb_vid ~product_id:PcInterface.usb_pid_motor_controller ~set:set_card_motor
(fun card ->
- lwt () = Commands.Motor.enable card and () = Commands.Motor.init_lm629 card in
+ lwt () = Commands.Motor.enable card `Both and () = Commands.Motor.traj_init card in
lwt () = Motors.OBus.export bus =|< Motors.make card ["fr"; "krobot"; "Devices"; "Motors"] in
return ())
(fun () ->
diff --git a/PC_Mainboard/driver/object.ml b/PC_Mainboard/driver/object.ml
new file mode 100644
index 0000000..e676ed1
--- /dev/null
+++ b/PC_Mainboard/driver/object.ml
@@ -0,0 +1,27 @@
+(*
+ * object.ml
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+module type S = sig
+ type t
+ module MakeInterface(Name : OBus_interface.Name) : sig
+ val ol_interface : OBus_name.interface
+ val ol_method_call : OBus_name.member -> ('a, 'b Lwt.t, 'b) OBus_type.func -> (t -> 'a) -> unit
+ val ol_signal : OBus_name.member -> ('a, _) OBus_type.cl_sequence -> (t -> ?peer : OBus_peer.t -> 'a -> unit Lwt.t)
+ val ol_property_r : OBus_name.member ->
+ ('a, _) OBus_type.cl_single ->
+ (t -> 'a Lwt.t) -> unit
+ val ol_property_w : OBus_name.member ->
+ ('a, _) OBus_type.cl_single ->
+ (t -> 'a -> unit Lwt.t) -> unit
+ val ol_property_rw : OBus_name.member ->
+ ('a, _) OBus_type.cl_single ->
+ (t -> 'a Lwt.t) ->
+ (t -> 'a -> unit Lwt.t) -> unit
+ end
+end
diff --git a/PC_Mainboard/interface/gen_dbus_exports.ml b/PC_Mainboard/interface/gen_dbus_exports.ml
new file mode 100644
index 0000000..a4e192b
--- /dev/null
+++ b/PC_Mainboard/interface/gen_dbus_exports.ml
@@ -0,0 +1,99 @@
+(*
+ * gen_dbus_exports.ml
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let rec print_apply cmd args =
+ printf "(fun dev ";
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s " (Utils.caml_lid name)
+ | Cst _ ->
+ ())
+ args;
+ printf "-> %s" cmd;
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf " %s" (Utils.caml_lid name)
+ | Cst _ ->
+ ())
+ args;
+ printf ")\n"
+
+let rec print path indent = function
+ | Request req ->
+ printf "%sOL_method %s : " indent (Utils.caml_case req.req_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ req.req_args;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) -> (name, typ)
+ | Cst _ -> failwith "constants are not allowed in replies")
+ req.req_repl
+ in
+ let () =
+ match repl with
+ | [] ->
+ printf "unit"
+ | (name, typ) :: rest ->
+ printf "%s" typ.caml_type;
+ List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
+ in
+ printf " = ";
+ print_apply (sprintf "Commands.%s%s (Get.get dev)" path (Utils.caml_lid req.req_name)) req.req_args
+
+ | Command cmd ->
+ printf "%sOL_method %s : " indent (Utils.caml_case cmd.cmd_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ cmd.cmd_args;
+ printf "unit = ";
+ print_apply (sprintf "Commands.%s%s (Get.get dev)" path (Utils.caml_lid cmd.cmd_name)) cmd.cmd_args
+
+ | Module(name, items) ->
+ printf "%smodule %s(M : Object.S)(Get : sig val get : M.t -> Card.t end)(Name : OBus_interface.Name) = struct\n"
+ indent (Utils.caml_uid name);
+ printf "%s include M.MakeInterface(Name)\n" indent;
+ List.iter (print (path ^ Utils.caml_uid name ^ ".") (indent ^ " ")) items;
+ printf "%send\n" indent
+
+ | _ ->
+ ()
+
+let rec split_top = function
+ | [] ->
+ ([], [])
+ | Module _ as item :: items ->
+ let modules, items = split_top items in
+ (item :: modules, items)
+ | item :: items ->
+ let modules, items = split_top items in
+ (modules, item :: items)
+
+let () =
+ let modules, items = split_top interface in
+ printf "open OBus_pervasives\n";
+ printf "module Common(M : Object.S)(Get : sig val get : M.t -> Card.t end)(Name : OBus_interface.Name) = struct\n";
+ printf " include M.MakeInterface(Name)\n";
+ List.iter (print "" " ") items;
+ printf "end\n";
+ List.iter (print "" "") modules
diff --git a/PC_Mainboard/interface/gen_dbus_imports.ml b/PC_Mainboard/interface/gen_dbus_imports.ml
new file mode 100644
index 0000000..098e686
--- /dev/null
+++ b/PC_Mainboard/interface/gen_dbus_imports.ml
@@ -0,0 +1,73 @@
+(*
+ * gen_dbus_imports.ml
+ * -------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let rec print indent = function
+ | Request req ->
+ printf "%sOP_method %s : " indent (Utils.caml_case req.req_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ req.req_args;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) -> (name, typ)
+ | Cst _ -> failwith "constants are not allowed in replies")
+ req.req_repl
+ in
+ let () =
+ match repl with
+ | [] ->
+ printf "unit"
+ | (name, typ) :: rest ->
+ printf "%s" typ.caml_type;
+ List.iter (fun (name, typ) -> printf " * %s" typ.caml_type) rest
+ in
+ printf "\n"
+
+ | Command cmd ->
+ printf "%sOP_method %s : " indent (Utils.caml_case cmd.cmd_name);
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s -> " typ.caml_type
+ | Cst _ ->
+ ())
+ cmd.cmd_args;
+ printf "unit\n";
+
+ | Module(name, items) ->
+ printf "%smodule %s = struct\n" indent (Utils.caml_uid name);
+ printf "%s include MakeDevice(struct let name = \"%s\" end)\n" indent (Utils.caml_case name);
+ List.iter (print (indent ^ " ")) items;
+ printf "%send\n" indent
+
+ | _ ->
+ ()
+
+let () =
+ print_string "\
+open OBus_pervasives
+module MakeDevice(Name : sig val name : string end) =
+ OBus_interface.MakeCustom
+ (struct
+ type proxy = Krobot.t
+ let get krobot = OBus_proxy.make (Krobot.peer krobot) [\"fr\"; \"krobot\"; \"Devices\"; Name.name]
+ end)
+ (struct
+ let name = \"fr.krobot.Device.\" ^ Name.name
+ end)
+";
+ List.iter (print "") (List.filter (function Module _ -> true | _ -> false) interface)
diff --git a/PC_Mainboard/interface/gen_script_commands.ml b/PC_Mainboard/interface/gen_script_commands.ml
new file mode 100644
index 0000000..c78c853
--- /dev/null
+++ b/PC_Mainboard/interface/gen_script_commands.ml
@@ -0,0 +1,67 @@
+(*
+ * gen_script_commands.ml
+ * ----------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Printf
+open Interface
+
+let print_common prefix path name args =
+ printf " register \"unsafe-%s%s\" (f%d" prefix name
+ (List.fold_left (fun n arg -> match arg with
+ | Arg _ -> n + 1
+ | Cst _ -> n) 0 args);
+ List.iter (function
+ | Arg(name, { caml_type = "int" }) ->
+ printf " (int \"%s\")" name
+ | Arg(name, { caml_type = "bool" }) ->
+ printf " (keyword \"%s\" [(\"false\", false); (\"true\", true)])" name
+ | Arg(name, { caml_type = caml_type }) ->
+ if try String.sub caml_type 0 6 = "Types." with _ -> false then
+ printf " (__type_%s \"%s\")" (String.sub caml_type 6 (String.length caml_type - 6)) name
+ else
+ printf " (prout \"caca\")"
+ | Cst _ ->
+ ()) args;
+ printf ")\n";
+ printf " (fun logger krobot";
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " %s" (Utils.caml_lid name)
+ | Cst _ ->
+ ()) args;
+ printf " ->\n";
+ printf " lwt _ = Krobot_unsafe.%s%s krobot" path (Utils.caml_lid name);
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " %s" (Utils.caml_lid name)
+ | Cst _ ->
+ ()) args;
+ printf " in\n";
+ printf " Lwt.return ());\n"
+
+let rec print prefix path = function
+ | Request req ->
+ print_common prefix path req.req_name req.req_args
+ | Command cmd ->
+ print_common prefix path cmd.cmd_name cmd.cmd_args
+ | Enum enum ->
+ printf " let __type_%s name = keyword name [" (Utils.caml_lid enum.enm_name);
+ List.iter (fun (name, code) ->
+ printf "(\"%s\", `%s);" name (Utils.caml_uid name))
+ enum.enm_keys;
+ printf "] in\n"
+ | Record _ ->
+ ()
+ | Module(name, items) ->
+ List.iter (print (prefix ^ String.lowercase name ^ "-") (path ^ Utils.caml_uid name ^ ".")) items
+
+let () =
+ printf "open Script_commands\n";
+ printf "let register () =\n";
+ List.iter (print "" "") (List.filter (function Module _ -> true | _ -> false) interface);
+ printf " ()"
diff --git a/PC_Mainboard/interface/gen_usb_commands_impl.ml b/PC_Mainboard/interface/gen_usb_commands_impl.ml
new file mode 100644
index 0000000..97ef956
--- /dev/null
+++ b/PC_Mainboard/interface/gen_usb_commands_impl.ml
@@ -0,0 +1,120 @@
+(*
+ * gen_usb_commands_impl.ml
+ * ------------------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* Generate implementation for all USB commands used by the driver *)
+
+open Printf
+open Interface
+
+let print_common indent name args =
+ printf "%slet %s card" indent (Utils.caml_lid name);
+ List.iter (function
+ | Arg(name, typ) ->
+ printf " ~%s" (Utils.caml_lid name)
+ | Cst _ ->
+ ()) args;
+ printf " =\n";
+ printf "%s let data = Card.make_buffer () in\n" indent;
+ if args <> [] then begin
+ printf "%s let writer = RW.writer data in\n" indent;
+ List.iter
+ (function
+ | Arg(name, typ) ->
+ printf "%s %s;\n" indent (typ.writer (Utils.caml_lid name))
+ | Cst(typ, value) ->
+ printf "%s %s;\n" indent (typ.writer (string_of_int value)))
+ args
+ end
+
+let rec print indent = function
+ | Request req ->
+ print_common indent req.req_name req.req_args;
+ printf "%s lwt data = Card.send_request card %d data in\n" indent req.req_code;
+ if req.req_repl <> [] then begin
+ printf "%s let reader = RW.reader data in\n" indent;
+ let repl =
+ List.map
+ (function
+ | Arg(name, typ) ->
+ (Utils.caml_lid name, typ)
+ | Cst _ ->
+ failwith "constant are not allowed in replies")
+ req.req_repl
+ in
+ List.iter
+ (fun (name, typ) ->
+ printf "%s let %s = %s in\n" indent name typ.reader)
+ repl;
+ printf "%s return (%s)\n" indent (String.concat ", " (List.map fst repl))
+ end else
+ printf "return ()\n"
+ | Command cmd ->
+ print_common indent cmd.cmd_name cmd.cmd_args;
+ printf "%s Card.send_command card %d data\n" indent cmd.cmd_code
+ | Enum enum ->
+ if not enum.enm_extern then
+ printf "%stype %s = [ %s ]\n"
+ indent (Utils.caml_lid enum.enm_name)
+ (String.concat " | "
+ (List.map
+ (fun (name, code) -> "`" ^ Utils.caml_uid name)
+ enum.enm_keys));
+
+ printf "%slet put_%s writer value =\n" indent (Utils.caml_lid enum.enm_name);
+ printf "%s let code = match value with\n" indent;
+ List.iter
+ ...
[truncated message content] |
