Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 1256ef0e489d201041ef5b9adab1b329cff3ef21
|
From: Jérémie D. <Ba...@us...> - 2010-04-18 14:57:21
|
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 1256ef0e489d201041ef5b9adab1b329cff3ef21 (commit)
via bcd46c2c5803bd50ca3772949f753449837ff805 (commit)
from 31edfc54f06d6f388a443d87e3644d1829505f63 (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 1256ef0e489d201041ef5b9adab1b329cff3ef21
Merge: 31edfc54f06d6f388a443d87e3644d1829505f63 bcd46c2c5803bd50ca3772949f753449837ff805
Author: Jérémie Dimino <dim@gaia.(none)>
Date: Sun Apr 18 16:55:44 2010 +0200
Merge commit 'bcd46c2'
commit bcd46c2c5803bd50ca3772949f753449837ff805
Author: Jérémie Dimino <dim@gaia.(none)>
Date: Sun Apr 18 16:33:13 2010 +0200
update code for the new obus api
-----------------------------------------------------------------------
Changes:
diff --git a/info/control/Makefile b/info/control/Makefile
index bbaf447..fd92830 100644
--- a/info/control/Makefile
+++ b/info/control/Makefile
@@ -7,7 +7,7 @@
PREFIX := $(HOME)
-OC := ocamlbuild -Is common,lib_krobot
+OC := ocamlbuild -Is common,protocol,lib-krobot
OF := ocamlfind
ifeq ($(TERM),dumb)
@@ -25,15 +25,15 @@ clean:
.PHONY: install
install:
$(OF) install krobot META \
- lib_krobot/krobot.mli \
- $(wildcard _build/lib_krobot/*.cmi) \
- $(wildcard _build/lib_krobot/*.cmx) \
+ lib-krobot/krobot.mli \
+ $(wildcard _build/lib-krobot/*.cmi) \
+ $(wildcard _build/lib-krobot/*.cmx) \
$(wildcard _build/*.cma) \
$(wildcard _build/*.cmxa) \
$(wildcard _build/*.cmxs) \
$(wildcard _build/*.a)
- install -m 0755 _build/card_tools/krobot_send_firmware.best $(PREFIX)/bin/krobot-send-firmware
- install -m 0755 _build/card_tools/krobot_dump_memory.best $(PREFIX)/bin/krobot-dump-memory
+ install -m 0755 _build/card-tools/krobot_send_firmware.best $(PREFIX)/bin/krobot-send-firmware
+ install -m 0755 _build/card-tools/krobot_dump_memory.best $(PREFIX)/bin/krobot-dump-memory
install -m 0755 _build/tools/krobot_forward_dbus.best $(PREFIX)/bin/krobot-forward-dbus
install -m 0755 _build/clients/krobot_info.best $(PREFIX)/bin/krobot-info
install -m 0755 _build/clients/krobot_joy_control.best $(PREFIX)/bin/krobot-joystick
diff --git a/info/control/README b/info/control/README
index a595631..c952455 100644
--- a/info/control/README
+++ b/info/control/README
@@ -1,6 +1,6 @@
Organisation des dossiers:
-* "card_tools" contient des outils pour les cartes usb, notamment pour
+* "card-tools" contient des outils pour les cartes usb, notamment pour
flasher les firmwares
* "clients" contient les divers programmes pour monitorer et
@@ -11,7 +11,7 @@ Organisation des dossiers:
* "driver" contient le driver qui accède au cartes usb
-* "lib_krobot" contient la librairie cliente pour utiliser le robot,
+* "lib-krobot" contient la librairie cliente pour utiliser le robot,
qui se connecte au driver via D-Bus
* "services" contient des services tels que l'arrêt des moteurs en cas
diff --git a/info/control/_tags b/info/control/_tags
index 23ffcf3..937c55b 100644
--- a/info/control/_tags
+++ b/info/control/_tags
@@ -1,27 +1,30 @@
# -*- conf -*-
-"common": include
-"lib_krobot": include
-
# +------------------------------------------------------------------+
# | Krobot library |
# +------------------------------------------------------------------+
-<lib_krobot/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
-<lib_krobot/**>: pkg_lwt.unix, pkg_obus
+<lib-krobot/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
+<lib-krobot/**>: pkg_lwt.unix, pkg_obus
+
+# +------------------------------------------------------------------+
+# | Protocol |
+# +------------------------------------------------------------------+
+
+<protocol/krobot_interfaces.*>: pkg_obus
# +------------------------------------------------------------------+
# | Card tools |
# +------------------------------------------------------------------+
-<card_tools/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<card_tools/**>: thread, pkg_usb, pkg_lwt.unix
+<card-tools/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
+<card-tools/**>: thread, pkg_usb, pkg_lwt.unix
# +------------------------------------------------------------------+
# | Clients |
# +------------------------------------------------------------------+
-<clients/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
+<clients/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
<clients/**>: pkg_lwt.unix, pkg_obus
<clients/krobot_joy_control.*>: pkg_sdl
<clients/krobot_controller.*>: pkg_lwt.text
@@ -32,14 +35,14 @@
# | Services |
# +------------------------------------------------------------------+
-<services/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
+<services/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
<services/**>: pkg_lwt.unix, pkg_obus
# +------------------------------------------------------------------+
# | Common |
# +------------------------------------------------------------------+
-<common/krobot_{types,util}.{ml,mli}>: syntax_camlp4o, pkg_obus.syntax, pkg_lwt.syntax
+<common/krobot_{types,util}.{ml,mli}>: syntax_camlp4o, pkg_lwt.syntax
<common/krobot_{types,util}.*>: pkg_obus
<common/var.*>: pkg_react
@@ -47,19 +50,19 @@
# | Driver |
# +------------------------------------------------------------------+
-<driver/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
+<driver/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
<driver/**>: thread, pkg_lwt.unix, pkg_obus, pkg_usb
# +------------------------------------------------------------------+
# | Tools |
# +------------------------------------------------------------------+
-<tools/krobot_forward_dbus.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
+<tools/krobot_forward_dbus.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
<tools/krobot_forward_dbus.*>: pkg_obus
# +------------------------------------------------------------------+
# | Tests |
# +------------------------------------------------------------------+
-<tests/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_obus.syntax
+<tests/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
<tests/**>: pkg_lwt.unix, pkg_obus
diff --git a/info/control/card-tools/krobot_boardname.mli b/info/control/card-tools/krobot_boardname.mli
new file mode 100644
index 0000000..51dc1b5
--- /dev/null
+++ b/info/control/card-tools/krobot_boardname.mli
@@ -0,0 +1,12 @@
+(*
+ * krobot_boardname.mli
+ * --------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+val get_board_name : string -> string option
+ (** [get_board_name dump] recherche dans le [dump] mémoire (peut
+ être également un fichier .hex chargé) le nom de la carte. *)
diff --git a/info/control/card-tools/krobot_boardname.mll b/info/control/card-tools/krobot_boardname.mll
new file mode 100644
index 0000000..96b39b6
--- /dev/null
+++ b/info/control/card-tools/krobot_boardname.mll
@@ -0,0 +1,22 @@
+(*
+ * krobot_boardname.mll
+ * --------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+
+let boardname_regex = ("Carte " | "Robot Interface" | "Battery Monitoring ") [^'\n']+
+
+rule boardname = parse
+ | (boardname_regex as name) '\n' { Some name }
+ | _ { boardname lexbuf }
+ | eof { None }
+
+{
+ let get_board_name str =
+ let lexbuf = Lexing.from_string str in
+ boardname lexbuf
+}
diff --git a/info/control/card-tools/krobot_bootloader.ml b/info/control/card-tools/krobot_bootloader.ml
new file mode 100644
index 0000000..1deb632
--- /dev/null
+++ b/info/control/card-tools/krobot_bootloader.ml
@@ -0,0 +1,184 @@
+(*
+ * krobot_bootloader.ml
+ * --------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+open Lwt
+open Lwt_io
+
+(* Code très inspiré de kard.ml, mais mis à part car le mode de
+ communication avec la carte est différent (bulk au lieu
+ d'interrupt). *)
+
+type t = {
+ mutable is_open : bool;
+ (* La carte est-elle ouverte ? *)
+
+ handle : USB.handle;
+ (* Handle pour le périphérique usb *)
+
+ kernel_active : bool;
+ (* Est-ce qu'un driver noyau était attaché à la carte avant qu'on
+ l'utilise ? *)
+}
+
+type error =
+ | IncompleteWrite of int * int
+ | IncompleteRead of int * int
+ | UnexpectedReply of string * string
+ | WriteError of string * string
+
+let string_of_error = function
+ | IncompleteWrite (a, b) -> Printf.sprintf "%d byte(s) written instead of %d" a b
+ | IncompleteRead (a, b) -> Printf.sprintf "%d byte(s) read instead of %d" a b
+ | UnexpectedReply (a, b) -> Printf.sprintf "received unexpected reply %S instead of %S" a b
+ | WriteError (a, b) -> Printf.sprintf "written: %S, read back: %S" a b
+
+exception Error of error
+
+let failwith e = fail (Error e)
+
+let close k =
+ if k.is_open then begin
+ lwt _ = USB.release_interface k.handle 0 in
+ lwt _ = USB.reset_device k.handle in
+ (*if k.kernel_active then USB.attach_kernel_driver k.handle 0;*)
+ (*USB.close k.handle;*)
+ k.is_open <- false;
+ return ()
+ end else return ()
+
+let open_card () =
+ let handle = USB.open_device_with
+ ~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;
+ lwt _ = USB.set_configuration handle 1 in
+ lwt _ = USB.claim_interface handle 0 in
+ let k = { is_open = true;
+ handle = handle;
+ kernel_active = kernel_active } in
+ let _ = Lwt_sequence.add_l (fun _ -> close k) Lwt_main.exit_hooks in
+ return k
+
+let header_length = 5
+
+let put_message buffer cmd length address data =
+ let body_length = String.length data in
+ assert (String.length buffer >= header_length+body_length);
+ let set i n = buffer.[i] <- char_of_int n in
+ set 0 cmd;
+ assert (length < 0x100);
+ set 1 length;
+ assert (address <= 0x1000000);
+ set 2 (address land 0xff);
+ set 3 ((address lsr 8) land 0xff);
+ set 4 ((address lsr 16) land 0xff);
+ String.blit data 0 buffer 5 body_length
+
+let send_receive_packet k send_buffer send_length receive_buffer receive_length send_delay receive_delay =
+ let handle = k.handle and endpoint = 1 in
+ lwt sent = USB.bulk_send ~handle ~endpoint ~timeout:1. send_buffer 0 send_length in
+ if sent <> send_length then
+ failwith (IncompleteWrite (sent, send_length))
+ else begin
+ lwt received = USB.bulk_recv ~handle ~endpoint ~timeout:3. receive_buffer 0 receive_length in
+ if received <> receive_length then
+ failwith (IncompleteRead (received, receive_length))
+ else
+ return ()
+ end
+
+let get_flash k ~address ~length =
+ let response_length = 64 in
+ let increment = response_length-header_length in
+ assert (increment < 256);
+ let send_buffer = String.create header_length in
+ let receive_buffer = String.create response_length in
+ let result_buffer = String.create length in
+ let rec loop offset total_length =
+ if total_length <= 0 then
+ return result_buffer
+ else begin
+ let length = min increment total_length in
+ let response_length = length+header_length in
+ let address = address+offset in
+ 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
+ failwith (UnexpectedReply (receive_header, send_buffer))
+ else begin
+ String.blit receive_buffer header_length result_buffer offset length;
+ loop (offset+length) (total_length-length);
+ end
+ end
+ in loop 0 length
+
+let erase_flash k ~address ~length =
+ let response_length = 1 in
+ (* les effacements se font par blocs de 64 octets *)
+ let increment = 64 in
+ let send_buffer = String.create header_length in
+ let receive_buffer = String.create response_length in
+ let rec loop offset total_length =
+ if total_length <= 0 then
+ return ()
+ else begin
+ let address = address+offset in
+ 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] <> 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
+ in loop 0 length
+
+let reference = String.make 16 '\255'
+
+let write_flash k ~address data offset length =
+ let send_length = 64 and receive_length = 1 in
+ (* les écritures se font par blocs de 16 octets *)
+ let increment = 16 in
+ let send_buffer = String.create send_length in
+ let receive_buffer = String.create receive_length in
+ let rec loop address offset total_length =
+ (* address: sur le PIC, offset: dans data, total_length: taille restante *)
+ if total_length <= 0 then
+ return ()
+ else begin
+ let packet = String.make increment '\255' in
+ String.blit data offset packet 0 (min total_length increment);
+ if packet = reference then begin
+ (* le paquet n'a pas de contenu, on l'ignore *)
+ (* lwt () = printf "Skipping address 0x%06X...\n" address in *)
+ loop (address+increment) (offset+increment) (total_length-increment)
+ end else begin
+ (* lwt () = printf "Processing address 0x%06X...\n" address in *)
+ 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] <> 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
+ failwith (WriteError (packet, written))
+ else
+ loop (address+increment) (offset+increment) (total_length-increment)
+ end
+ end
+ end
+ in loop address 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 PcInterface.reset;
+ lwt () = send_receive_packet k send_buffer 1 receive_buffer 64 5. 5. in
+ return ()
diff --git a/info/control/card-tools/krobot_dump_memory.ml b/info/control/card-tools/krobot_dump_memory.ml
new file mode 100644
index 0000000..91b80d1
--- /dev/null
+++ b/info/control/card-tools/krobot_dump_memory.ml
@@ -0,0 +1,28 @@
+(*
+ * krobot_dump_memory.ml
+ * ---------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+open Printf
+open Lwt
+open Lwt_io
+
+lwt () =
+ lwt k = Krobot_bootloader.open_card () in
+ try_lwt
+ lwt data = Krobot_bootloader.get_flash k ~address:0x0 ~length:0x8000 in
+ let msg = match Krobot_boardname.get_board_name data with
+ | Some s -> sprintf "Board: %S" s
+ | None -> "Unable to identify board!"
+ in
+ lwt () = eprintlf "%s" msg in
+ (if Unix.isatty Unix.stdout then hexdump else write) stdout data >> flush stdout
+ with
+ | Krobot_bootloader.Error e ->
+ eprintlf "%s" (Krobot_bootloader.string_of_error e)
+ | e ->
+ eprintlf "%s" (Printexc.to_string e)
diff --git a/info/control/card-tools/krobot_hexfile.ml b/info/control/card-tools/krobot_hexfile.ml
new file mode 100644
index 0000000..2d2c361
--- /dev/null
+++ b/info/control/card-tools/krobot_hexfile.ml
@@ -0,0 +1,112 @@
+(*
+ * krobot_hexfile.ml
+ * -----------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+open Lwt
+open Lwt_io
+
+type hex_record =
+ | Data of int * string
+ | ExtendedLinearAddress of int
+ | EndOfFile of int
+
+let string_of_hexline str =
+ let n = String.length str in
+ assert (n > 0 && n mod 2 = 1 && str.[0] = ':');
+ let m = n/2 in
+ let result = String.create m in
+ for i = 0 to m-1 do
+ let j = 2*i+1 in
+ result.[i] <- char_of_int (int_of_string ("0x"^(String.sub str j 2)))
+ done;
+ result
+
+let compute_checksum str =
+ let rec aux i accu =
+ if i < 0 then
+ (-accu) land 0xff
+ else
+ aux (i-1) (accu+(int_of_char str.[i]))
+ in aux (String.length str - 2) 0
+
+let parse_line str =
+ let str = string_of_hexline str in
+ let get i = int_of_char str.[i] in
+ let n = String.length str in
+ assert (n >= 5 && compute_checksum str = int_of_char str.[n-1]);
+ let count = get 0 in
+ assert (count+5 = n);
+ let address = ((get 1) lsl 8) lor (get 2) in
+ let record_type = get 3 in
+ let data = String.sub str 4 count in
+ match record_type with
+ | 0x00 ->
+ Data (address, data)
+ | 0x01 ->
+ assert (count = 0);
+ EndOfFile address
+ | 0x04 ->
+ assert (count = 2 && address = 0);
+ let msb = int_of_char data.[0] and lsb = int_of_char data.[1] in
+ (* check for possible overflow *)
+ assert (msb land 0x80 = 0);
+ ExtendedLinearAddress ((msb lsl 8) lor lsb)
+ | _ -> assert false
+
+let parse_file file =
+ let ic = Lwt_io.open_file ~mode:input file in
+ let lines = Lwt_io.read_lines ic in
+ let lines = Lwt_stream.map parse_line lines in
+ lwt lines = Lwt_stream.get_while (fun _ -> true) lines in
+ lwt _ = Lwt_io.close ic in
+ return lines
+
+let print_record = function
+ | Data (address, data) ->
+ Printf.printf "DAT %04x" address;
+ String.iter (fun c -> Printf.printf " %02x" (int_of_char c)) data;
+ Printf.printf "\n"
+ | ExtendedLinearAddress address ->
+ Printf.printf "ELA %04x\n" address
+ | EndOfFile address ->
+ Printf.printf "EOF %04x\n" address
+
+let validate_and_copy hex addr_base buffer offset length =
+ assert (offset+length <= String.length buffer);
+ let min_address = addr_base+offset in
+ let max_address = min_address+length in
+ let addr_high = ref 0 in
+ let execute_record = function
+ | Data (address, data) ->
+ assert (address land 0xFFFF = address);
+ let address = !addr_high lor address in
+ if address < min_address || address >= max_address then
+ Printf.eprintf
+ "0x%04x is outside range, all bytes dropped\n"
+ address
+ else begin
+ let length =
+ let n = String.length data in
+ if address+n >= max_address then begin
+ Printf.eprintf
+ "some bytes at address 0x%04x are outside range (dropped)\n"
+ address;
+ max_address-address
+ end else n
+ in
+ let offset2 = address-addr_base in
+ String.blit data 0 buffer offset2 length;
+ end
+ | ExtendedLinearAddress address ->
+ assert (address land 0x8000 = 0);
+ addr_high := address lsl 16
+ | EndOfFile address ->
+ assert (address = 0);
+ raise Exit
+ in
+ try List.iter execute_record hex with Exit -> ()
diff --git a/info/control/card-tools/krobot_hexfile.mli b/info/control/card-tools/krobot_hexfile.mli
new file mode 100644
index 0000000..932e32e
--- /dev/null
+++ b/info/control/card-tools/krobot_hexfile.mli
@@ -0,0 +1,26 @@
+(*
+ * krobot_hexfile.mli
+ * ------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+type hex_record =
+ | Data of int * string
+ | ExtendedLinearAddress of int
+ | EndOfFile of int
+
+val parse_file : string -> hex_record list Lwt.t
+
+val print_record : hex_record -> unit
+ (** Prints one record on standard output. *)
+
+val validate_and_copy : hex_record list -> int -> string -> int -> int -> unit
+ (** [validate_and_copy hex addr_base buffer offset length] copies
+ the contents of the (parsed) [hex] file to [buffer]. [offset]
+ and [length] denote the valid range inside [buffer] that can be
+ written. [addr_base] is the address [buffer] is mapped to on the
+ microcontroller. Bytes outside the range are ignored (and a
+ warning is printed on standard error. *)
diff --git a/info/control/card-tools/krobot_send_firmware.ml b/info/control/card-tools/krobot_send_firmware.ml
new file mode 100644
index 0000000..82261c5
--- /dev/null
+++ b/info/control/card-tools/krobot_send_firmware.ml
@@ -0,0 +1,69 @@
+(*
+ * krobot_send_firmware.ml
+ * -----------------------
+ * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
+ * Licence : BSD3
+ *
+ * This file is a part of Krobot.
+ *)
+
+open Lwt
+open Lwt_io
+
+let do_flash force filename =
+ lwt hex = Krobot_hexfile.parse_file filename in
+ let memory =
+ let buffer = String.make 0x8000 '\255' in
+ Krobot_hexfile.validate_and_copy hex 0x0 buffer 0 0x8000;
+ buffer
+ in
+ let firmware_name = Krobot_boardname.get_board_name memory in
+ lwt () = match firmware_name with
+ | Some s -> printf "Detected firmware: %S\n" s
+ | None -> printf "Unable to identify firmware!\n"
+ in
+ let address = 0x800 and length = 0x8000-0x800 in
+ lwt k = Krobot_bootloader.open_card () in
+ lwt () = printf "Card opened\n" in
+ lwt data = Krobot_bootloader.get_flash k ~address:0x0 ~length:0x8000 in
+ let board_name = Krobot_boardname.get_board_name data in
+ lwt () = match board_name with
+ | Some s -> printf "Detected card: %S\n" s
+ | None -> printf "Unable to identify card!\n"
+ in
+ lwt () =
+ if not force && (board_name = None || firmware_name = None || board_name <> firmware_name) then begin
+ lwt () = eprintf "board name and firmware name do not match, use --force\n" in
+ exit 1
+ end else return ()
+ in
+ lwt () = Krobot_bootloader.erase_flash k ~address ~length in
+ lwt () = printf "Flash erased\n" in
+ lwt () = Krobot_bootloader.write_flash k ~address memory address length in
+ lwt () = printf "Flashing completed\n" in
+ lwt () = Krobot_bootloader.reset_board k in
+ return ()
+
+lwt () =
+ let force = ref false in
+ let filename = ref None in
+ let speclist = [
+ "--force", Arg.Set force, "Force flashing even if board id and firmware id do not match";
+ ] in
+ Arg.parse speclist
+ (fun s ->
+ match !filename with
+ | None -> filename := Some s
+ | Some _ -> raise (Arg.Bad s))
+ "Send a firmware to a board in bootloader mode";
+ let filename = match !filename with
+ | None -> Printf.eprintf "You must specify a .hex file!\n"; exit 1
+ | Some s -> s
+ in
+ try_lwt
+ do_flash !force filename
+ with
+ | Krobot_bootloader.Error e ->
+ eprintl (Krobot_bootloader.string_of_error e)
+ | e ->
+ eprintl (Printexc.to_string e)
diff --git a/info/control/card_tools/krobot_boardname.mli b/info/control/card_tools/krobot_boardname.mli
deleted file mode 100644
index 51dc1b5..0000000
--- a/info/control/card_tools/krobot_boardname.mli
+++ /dev/null
@@ -1,12 +0,0 @@
-(*
- * krobot_boardname.mli
- * --------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-val get_board_name : string -> string option
- (** [get_board_name dump] recherche dans le [dump] mémoire (peut
- être également un fichier .hex chargé) le nom de la carte. *)
diff --git a/info/control/card_tools/krobot_boardname.mll b/info/control/card_tools/krobot_boardname.mll
deleted file mode 100644
index 96b39b6..0000000
--- a/info/control/card_tools/krobot_boardname.mll
+++ /dev/null
@@ -1,22 +0,0 @@
-(*
- * krobot_boardname.mll
- * --------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-
-let boardname_regex = ("Carte " | "Robot Interface" | "Battery Monitoring ") [^'\n']+
-
-rule boardname = parse
- | (boardname_regex as name) '\n' { Some name }
- | _ { boardname lexbuf }
- | eof { None }
-
-{
- let get_board_name str =
- let lexbuf = Lexing.from_string str in
- boardname lexbuf
-}
diff --git a/info/control/card_tools/krobot_bootloader.ml b/info/control/card_tools/krobot_bootloader.ml
deleted file mode 100644
index 1deb632..0000000
--- a/info/control/card_tools/krobot_bootloader.ml
+++ /dev/null
@@ -1,184 +0,0 @@
-(*
- * krobot_bootloader.ml
- * --------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-open Lwt
-open Lwt_io
-
-(* Code très inspiré de kard.ml, mais mis à part car le mode de
- communication avec la carte est différent (bulk au lieu
- d'interrupt). *)
-
-type t = {
- mutable is_open : bool;
- (* La carte est-elle ouverte ? *)
-
- handle : USB.handle;
- (* Handle pour le périphérique usb *)
-
- kernel_active : bool;
- (* Est-ce qu'un driver noyau était attaché à la carte avant qu'on
- l'utilise ? *)
-}
-
-type error =
- | IncompleteWrite of int * int
- | IncompleteRead of int * int
- | UnexpectedReply of string * string
- | WriteError of string * string
-
-let string_of_error = function
- | IncompleteWrite (a, b) -> Printf.sprintf "%d byte(s) written instead of %d" a b
- | IncompleteRead (a, b) -> Printf.sprintf "%d byte(s) read instead of %d" a b
- | UnexpectedReply (a, b) -> Printf.sprintf "received unexpected reply %S instead of %S" a b
- | WriteError (a, b) -> Printf.sprintf "written: %S, read back: %S" a b
-
-exception Error of error
-
-let failwith e = fail (Error e)
-
-let close k =
- if k.is_open then begin
- lwt _ = USB.release_interface k.handle 0 in
- lwt _ = USB.reset_device k.handle in
- (*if k.kernel_active then USB.attach_kernel_driver k.handle 0;*)
- (*USB.close k.handle;*)
- k.is_open <- false;
- return ()
- end else return ()
-
-let open_card () =
- let handle = USB.open_device_with
- ~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;
- lwt _ = USB.set_configuration handle 1 in
- lwt _ = USB.claim_interface handle 0 in
- let k = { is_open = true;
- handle = handle;
- kernel_active = kernel_active } in
- let _ = Lwt_sequence.add_l (fun _ -> close k) Lwt_main.exit_hooks in
- return k
-
-let header_length = 5
-
-let put_message buffer cmd length address data =
- let body_length = String.length data in
- assert (String.length buffer >= header_length+body_length);
- let set i n = buffer.[i] <- char_of_int n in
- set 0 cmd;
- assert (length < 0x100);
- set 1 length;
- assert (address <= 0x1000000);
- set 2 (address land 0xff);
- set 3 ((address lsr 8) land 0xff);
- set 4 ((address lsr 16) land 0xff);
- String.blit data 0 buffer 5 body_length
-
-let send_receive_packet k send_buffer send_length receive_buffer receive_length send_delay receive_delay =
- let handle = k.handle and endpoint = 1 in
- lwt sent = USB.bulk_send ~handle ~endpoint ~timeout:1. send_buffer 0 send_length in
- if sent <> send_length then
- failwith (IncompleteWrite (sent, send_length))
- else begin
- lwt received = USB.bulk_recv ~handle ~endpoint ~timeout:3. receive_buffer 0 receive_length in
- if received <> receive_length then
- failwith (IncompleteRead (received, receive_length))
- else
- return ()
- end
-
-let get_flash k ~address ~length =
- let response_length = 64 in
- let increment = response_length-header_length in
- assert (increment < 256);
- let send_buffer = String.create header_length in
- let receive_buffer = String.create response_length in
- let result_buffer = String.create length in
- let rec loop offset total_length =
- if total_length <= 0 then
- return result_buffer
- else begin
- let length = min increment total_length in
- let response_length = length+header_length in
- let address = address+offset in
- 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
- failwith (UnexpectedReply (receive_header, send_buffer))
- else begin
- String.blit receive_buffer header_length result_buffer offset length;
- loop (offset+length) (total_length-length);
- end
- end
- in loop 0 length
-
-let erase_flash k ~address ~length =
- let response_length = 1 in
- (* les effacements se font par blocs de 64 octets *)
- let increment = 64 in
- let send_buffer = String.create header_length in
- let receive_buffer = String.create response_length in
- let rec loop offset total_length =
- if total_length <= 0 then
- return ()
- else begin
- let address = address+offset in
- 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] <> 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
- in loop 0 length
-
-let reference = String.make 16 '\255'
-
-let write_flash k ~address data offset length =
- let send_length = 64 and receive_length = 1 in
- (* les écritures se font par blocs de 16 octets *)
- let increment = 16 in
- let send_buffer = String.create send_length in
- let receive_buffer = String.create receive_length in
- let rec loop address offset total_length =
- (* address: sur le PIC, offset: dans data, total_length: taille restante *)
- if total_length <= 0 then
- return ()
- else begin
- let packet = String.make increment '\255' in
- String.blit data offset packet 0 (min total_length increment);
- if packet = reference then begin
- (* le paquet n'a pas de contenu, on l'ignore *)
- (* lwt () = printf "Skipping address 0x%06X...\n" address in *)
- loop (address+increment) (offset+increment) (total_length-increment)
- end else begin
- (* lwt () = printf "Processing address 0x%06X...\n" address in *)
- 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] <> 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
- failwith (WriteError (packet, written))
- else
- loop (address+increment) (offset+increment) (total_length-increment)
- end
- end
- end
- in loop address 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 PcInterface.reset;
- lwt () = send_receive_packet k send_buffer 1 receive_buffer 64 5. 5. in
- return ()
diff --git a/info/control/card_tools/krobot_dump_memory.ml b/info/control/card_tools/krobot_dump_memory.ml
deleted file mode 100644
index 91b80d1..0000000
--- a/info/control/card_tools/krobot_dump_memory.ml
+++ /dev/null
@@ -1,28 +0,0 @@
-(*
- * krobot_dump_memory.ml
- * ---------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-open Printf
-open Lwt
-open Lwt_io
-
-lwt () =
- lwt k = Krobot_bootloader.open_card () in
- try_lwt
- lwt data = Krobot_bootloader.get_flash k ~address:0x0 ~length:0x8000 in
- let msg = match Krobot_boardname.get_board_name data with
- | Some s -> sprintf "Board: %S" s
- | None -> "Unable to identify board!"
- in
- lwt () = eprintlf "%s" msg in
- (if Unix.isatty Unix.stdout then hexdump else write) stdout data >> flush stdout
- with
- | Krobot_bootloader.Error e ->
- eprintlf "%s" (Krobot_bootloader.string_of_error e)
- | e ->
- eprintlf "%s" (Printexc.to_string e)
diff --git a/info/control/card_tools/krobot_hexfile.ml b/info/control/card_tools/krobot_hexfile.ml
deleted file mode 100644
index 2d2c361..0000000
--- a/info/control/card_tools/krobot_hexfile.ml
+++ /dev/null
@@ -1,112 +0,0 @@
-(*
- * krobot_hexfile.ml
- * -----------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-open Lwt
-open Lwt_io
-
-type hex_record =
- | Data of int * string
- | ExtendedLinearAddress of int
- | EndOfFile of int
-
-let string_of_hexline str =
- let n = String.length str in
- assert (n > 0 && n mod 2 = 1 && str.[0] = ':');
- let m = n/2 in
- let result = String.create m in
- for i = 0 to m-1 do
- let j = 2*i+1 in
- result.[i] <- char_of_int (int_of_string ("0x"^(String.sub str j 2)))
- done;
- result
-
-let compute_checksum str =
- let rec aux i accu =
- if i < 0 then
- (-accu) land 0xff
- else
- aux (i-1) (accu+(int_of_char str.[i]))
- in aux (String.length str - 2) 0
-
-let parse_line str =
- let str = string_of_hexline str in
- let get i = int_of_char str.[i] in
- let n = String.length str in
- assert (n >= 5 && compute_checksum str = int_of_char str.[n-1]);
- let count = get 0 in
- assert (count+5 = n);
- let address = ((get 1) lsl 8) lor (get 2) in
- let record_type = get 3 in
- let data = String.sub str 4 count in
- match record_type with
- | 0x00 ->
- Data (address, data)
- | 0x01 ->
- assert (count = 0);
- EndOfFile address
- | 0x04 ->
- assert (count = 2 && address = 0);
- let msb = int_of_char data.[0] and lsb = int_of_char data.[1] in
- (* check for possible overflow *)
- assert (msb land 0x80 = 0);
- ExtendedLinearAddress ((msb lsl 8) lor lsb)
- | _ -> assert false
-
-let parse_file file =
- let ic = Lwt_io.open_file ~mode:input file in
- let lines = Lwt_io.read_lines ic in
- let lines = Lwt_stream.map parse_line lines in
- lwt lines = Lwt_stream.get_while (fun _ -> true) lines in
- lwt _ = Lwt_io.close ic in
- return lines
-
-let print_record = function
- | Data (address, data) ->
- Printf.printf "DAT %04x" address;
- String.iter (fun c -> Printf.printf " %02x" (int_of_char c)) data;
- Printf.printf "\n"
- | ExtendedLinearAddress address ->
- Printf.printf "ELA %04x\n" address
- | EndOfFile address ->
- Printf.printf "EOF %04x\n" address
-
-let validate_and_copy hex addr_base buffer offset length =
- assert (offset+length <= String.length buffer);
- let min_address = addr_base+offset in
- let max_address = min_address+length in
- let addr_high = ref 0 in
- let execute_record = function
- | Data (address, data) ->
- assert (address land 0xFFFF = address);
- let address = !addr_high lor address in
- if address < min_address || address >= max_address then
- Printf.eprintf
- "0x%04x is outside range, all bytes dropped\n"
- address
- else begin
- let length =
- let n = String.length data in
- if address+n >= max_address then begin
- Printf.eprintf
- "some bytes at address 0x%04x are outside range (dropped)\n"
- address;
- max_address-address
- end else n
- in
- let offset2 = address-addr_base in
- String.blit data 0 buffer offset2 length;
- end
- | ExtendedLinearAddress address ->
- assert (address land 0x8000 = 0);
- addr_high := address lsl 16
- | EndOfFile address ->
- assert (address = 0);
- raise Exit
- in
- try List.iter execute_record hex with Exit -> ()
diff --git a/info/control/card_tools/krobot_hexfile.mli b/info/control/card_tools/krobot_hexfile.mli
deleted file mode 100644
index 932e32e..0000000
--- a/info/control/card_tools/krobot_hexfile.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(*
- * krobot_hexfile.mli
- * ------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-type hex_record =
- | Data of int * string
- | ExtendedLinearAddress of int
- | EndOfFile of int
-
-val parse_file : string -> hex_record list Lwt.t
-
-val print_record : hex_record -> unit
- (** Prints one record on standard output. *)
-
-val validate_and_copy : hex_record list -> int -> string -> int -> int -> unit
- (** [validate_and_copy hex addr_base buffer offset length] copies
- the contents of the (parsed) [hex] file to [buffer]. [offset]
- and [length] denote the valid range inside [buffer] that can be
- written. [addr_base] is the address [buffer] is mapped to on the
- microcontroller. Bytes outside the range are ignored (and a
- warning is printed on standard error. *)
diff --git a/info/control/card_tools/krobot_send_firmware.ml b/info/control/card_tools/krobot_send_firmware.ml
deleted file mode 100644
index 82261c5..0000000
--- a/info/control/card_tools/krobot_send_firmware.ml
+++ /dev/null
@@ -1,69 +0,0 @@
-(*
- * krobot_send_firmware.ml
- * -----------------------
- * Copyright : (c) 2009, Stéphane Glondu <st...@gl...>
- * Licence : BSD3
- *
- * This file is a part of Krobot.
- *)
-
-open Lwt
-open Lwt_io
-
-let do_flash force filename =
- lwt hex = Krobot_hexfile.parse_file filename in
- let memory =
- let buffer = String.make 0x8000 '\255' in
- Krobot_hexfile.validate_and_copy hex 0x0 buffer 0 0x8000;
- buffer
- in
- let firmware_name = Krobot_boardname.get_board_name memory in
- lwt () = match firmware_name with
- | Some s -> printf "Detected firmware: %S\n" s
- | None -> printf "Unable to identify firmware!\n"
- in
- let address = 0x800 and length = 0x8000-0x800 in
- lwt k = Krobot_bootloader.open_card () in
- lwt () = printf "Card opened\n" in
- lwt data = Krobot_bootloader.get_flash k ~address:0x0 ~length:0x8000 in
- let board_name = Krobot_boardname.get_board_name data in
- lwt () = match board_name with
- | Some s -> printf "Detected card: %S\n" s
- | None -> printf "Unable to identify card!\n"
- in
- lwt () =
- if not force && (board_name = None || firmware_name = None || board_name <> firmware_name) then begin
- lwt () = eprintf "board name and firmware name do not match, use --force\n" in
- exit 1
- end else return ()
- in
- lwt () = Krobot_bootloader.erase_flash k ~address ~length in
- lwt () = printf "Flash erased\n" in
- lwt () = Krobot_bootloader.write_flash k ~address memory address length in
- lwt () = printf "Flashing completed\n" in
- lwt () = Krobot_bootloader.reset_board k in
- return ()
-
-lwt () =
- let force = ref false in
- let filename = ref None in
- let speclist = [
- "--force", Arg.Set force, "Force flashing even if board id and firmware id do not match";
- ] in
- Arg.parse speclist
- (fun s ->
- match !filename with
- | None -> filename := Some s
- | Some _ -> raise (Arg.Bad s))
- "Send a firmware to a board in bootloader mode";
- let filename = match !filename with
- | None -> Printf.eprintf "You must specify a .hex file!\n"; exit 1
- | Some s -> s
- in
- try_lwt
- do_flash !force filename
- with
- | Krobot_bootloader.Error e ->
- eprintl (Krobot_bootloader.string_of_error e)
- | e ->
- eprintl (Printexc.to_string e)
diff --git a/info/control/clients/krobot_controller.ml b/info/control/clients/krobot_controller.ml
index f6d3fbd..be77781 100644
--- a/info/control/clients/krobot_controller.ml
+++ b/info/control/clients/krobot_controller.ml
@@ -232,10 +232,10 @@ let rec draw krobot =
| `Absent -> [fg lred; text name]
| `Present -> [text name]
in
- 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
+ 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);
@@ -419,16 +419,16 @@ lwt () =
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
+ 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])
- (OBus_signal.event (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 496a66e..bcebf65 100644
--- a/info/control/clients/krobot_info.ml
+++ b/info/control/clients/krobot_info.ml
@@ -13,10 +13,10 @@ open Lwt
open Lwt_io
let print_card krobot card =
- OBus_property.get (Krobot.Card.state (krobot, card)) >>= function
+ 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
+ lwt firmware_build = Krobot.Card.get_firmware_build krobot card
+ and board_info = Krobot.Card.get_board_info krobot card in
let name = Krobot.Card.name card in
lwt () = printl "==========" in
lwt () = printlf "card.%s.state = present" name in
diff --git a/info/control/clients/krobot_script.ml b/info/control/clients/krobot_script.ml
index a3922dc..639a230 100644
--- a/info/control/clients/krobot_script.ml
+++ b/info/control/clients/krobot_script.ml
@@ -9,13 +9,164 @@
open Lwt
open Lwt_term
-open Krobot_script_types
module TextSet = Set.Make(Text)
let set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
(* +-----------------------------------------------------------------+
+ | Types |
+ +-----------------------------------------------------------------+ *)
+
+type logger = Lwt_term.styled_text -> unit Lwt.t
+
+(* Type of an argument *)
+type arg_type =
+ | Int
+ | Float
+ | String
+ | Keyword of string list
+
+type command = {
+ c_name : string;
+ (* The command name *)
+
+ c_path : string list;
+ (* The path of the command *)
+
+ 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 ?(path=[]) name func f =
+ let command = {
+ c_name = name;
+ c_path = path;
+ 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 string ?default name = {
+ a_name = name;
+ a_type = String;
+ a_cast = (fun str -> str);
+ a_default = default;
+}
+
+let float ?default name = {
+ a_name = name;
+ a_type = Float;
+ a_cast = (fun str ->
+ try
+ float_of_string str
+ with Failure _ ->
+ Printf.ksprintf arg_error "invalid value for argument '%s': a float 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;
+}
+
+(* +-----------------------------------------------------------------+
| Completion |
+-----------------------------------------------------------------+ *)
@@ -235,11 +386,11 @@ let () =
("monitoring", `Monitoring)] in
register ~path:["card"] "bootloader" (f1 card)
- (fun logger krobot card -> Krobot.Card.bootloader (krobot, card));
+ (fun logger krobot card -> Krobot.Card.bootloader krobot card);
register ~path:["card"] "reset" (f1 card)
- (fun logger krobot card -> Krobot.Card.reset (krobot, card));
+ (fun logger krobot card -> Krobot.Card.reset krobot card);
register ~path:["card"] "test" (f1 card)
- (fun logger krobot card -> Krobot.Card.test (krobot, card));
+ (fun logger krobot card -> Krobot.Card.test krobot card);
(* +---------------------------------------------------------------+
| Range finders |
@@ -278,7 +429,7 @@ let () =
and velocity = int ~default:50 "velocity"
and timeout = int ~default:100 "timeout"
and goto_mode = keyword ~default:`Now "mode" [("now", `Now); ("action", `Action)] in
-
+(*
register ~path:["ax12"] "goto" (f4 id position velocity goto_mode)
(fun logger krobot id position velocity goto_mode ->
Krobot_unsafe.AX12.goto krobot id position velocity goto_mode);
@@ -313,7 +464,7 @@ let () =
register ~path:["ax12"] "action" (f1 (int ~default:254 "id"))
(fun logger krobot id ->
Krobot_unsafe.AX12.action krobot id);
-
+*)
(* +---------------------------------------------------------------+
| Grip |
+---------------------------------------------------------------+ *)
@@ -354,5 +505,51 @@ let () =
(fun logger krobot ->
Krobot.claws_take krobot)
+(* +-----------------------------------------------------------------+
+ | Unsafe commands |
+ +-----------------------------------------------------------------+ *)
+(*
+
+let arg_type_of_proto env = function
+ | Protocol.Sint8 | Protocol.Uint8
+ | Protocol.Sint16 | Protocol.Uint16
+ | Protocol.Sint32 | Protocol.Uint32 ->
+ Int
+ | Protocol.String ->
+ String
+ | Protocol.Bool ->
+ Keyword ["true"; "false"]
+ | Protocol.Enum(_, l) ->
+ Keyword (List.map fst l)
+ | Protocol.Bit_mask _ ->
+ Int
+ | Protocol.Array _ ->
+ Int
+ | Protocol.Tuple _ ->
+ Int
+ | Protocol.Alias name ->
+ env (String_map.find name env)
+
+open Protocol
+
+let register_command component env cmd =
+ let cmd = {
+ c_args =
+ List.map
+ (fun (arg, typ) ->
+ (arg, arg_type_of_proto env typ))
+ cmd.send;
+ c_name = cmd.name;
+ c_path = ["unsafe"; component];
+ c_exec = fun args logger krobot ->
+
+ }
+ in
+ commands := cmd :: !commands
+
+let make_interface
+
+let () =
-let () = Krobot_script_unsafe.register ()
+ f_args : (string * arg_type) list;
+*)
diff --git a/info/control/clients/krobot_script_types.ml b/info/control/clients/krobot_script_types.ml
deleted file mode 100644
index caed0fb..0000000
--- a/info/control/clients/krobot_script_types.ml
+++ /dev/null
@@ -1,160 +0,0 @@
-(*
- * krobot_script_types.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
- | Float
- | String
- | Keyword of string list
-
-type command = {
- c_name : string;
- (* The command name *)
-
- c_path : string list;
- (* The path of the command *)
-
- 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 ?(path=[]) name func f =
- let command = {
- c_name = name;
- c_path = path;
- 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 string ?default name = {
- a_name = name;
- a_type = String;
- a_cast = (fun str -> str);
- a_default = default;
-}
-
-let float ?default name = {
- a_name = name;
- a_type = Float;
- a_cast = (fun str ->
- try
- float_of_string str
- with Failure _ ->
- Printf.ksprintf arg_error "invalid value for argument '%s': a float 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/info/control/common/krobot_types.ml b/info/control/common/krobot_types.ml
index b10800c..4d3215c 100644
--- a/info/control/common/krobot_types.ml
+++ b/info/control/common/krobot_types.ml
@@ -7,39 +7,66 @@
* This file is a part of [kro]bot.
*)
-open OBus_pervasives
+(* Note: integers value must be taken from PcInterface.h *)
+
+let make_map l =
+ ((fun x ->
+ let rec loop = function
+ | [] -> failwith "Krobot_types: invalid value"
+ | (x', y) :: _ when x = x' -> y
+ | _ :: l -> loop l
+ in
+ loop l),
+ (fun y ->
+ let rec loop = function
+ | [] -> failwith "Krobot_types: invalid value"
+ | (x, y') :: _ when y = y' -> x
+ | _ :: l -> loop l
+ in
+ loop l))
type move_result = [ `OK | `Stopped ]
-let obus_move_result =
- OBus_type.mapping obus_int [(`OK, 0); (`Stopped, 1)]
+let int32_of_move_result, move_result_of_int32 =
+ make_map [
+ `OK, 0l;
+ `Stopped, 1l;
+ ]
type motor = [ `Left | `Right | `Both ]
-let obus_motor = OBus_type.mapping obus_int
- [(`Left, -1);
- (`Both, 0);
- (`Right, 1)]
+let int32_of_motor, motor_of_int32 =
+ make_map [
+ `Left, Int32.of_int PcInterface.motor_left;
+ `Both, Int32.of_int PcInterface.motor_both;
+ `Right, Int32.of_int PcInterface.motor_right
+ ]
type stop_mode = [ `Off | `Abrupt | `Smooth ]
-let obus_stop_mode = OBus_type.mapping obus_int
- [(`Off, 0);
- (`Abrupt, 1);
- (`Smooth, 2)]
+let int32_of_stop_mode, stop_mode_of_int32 =
+ make_map [
+ `Off, Int32.of_int PcInterface.traj_stop_motor_off;
+ `Abrupt, Int32.of_int PcInterface.traj_stop_abrupt;
+ `Smooth, Int32.of_int PcInterface.traj_stop_smooth;
+ ]
type card_state = [ `Present | `Absent ]
-let obus_card_state = OBus_type.mapping obus_int
- [(`Present, 0);
- (`Absent, 1)]
+let int32_of_card_state, card_state_of_int32 =
+ make_map [
+ `Present, 0l;
+ `Absent, 1l;
+ ]
type goto_mode = [ `Straight | `Curve_right | `Curve_left ]
-let obus_goto_mode = OBus_type.mapping obus_int
- [(`Straight, 0);
- (`Curve_right, 1);
- (`Curve_left, 2)]
+let int32_of_goto_mode, goto_mode_of_int32 =
+ make_map [
+ `Straight, 0l;
+ `Curve_right, 1l;
+ `Curve_left, 2l;
+ ]
type ax12_stats = {
ax12_position : int;
@@ -49,27 +76,33 @@ type ax12_stats = {
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)]
+let int32_of_exec_mode, exec_mode_of_int32 =
+ make_map [
+ `Now, Int32.of_int PcInterface.ax12_exec_now;
+ `Action, Int32.of_int PcInterface.ax12_exec_action;
+ ]
type direction = [ `Forward | `Backward ]
-let obus_direction = OBus_type.mapping obus_int
- [(`Forward, 0); (`Backward, 1)]
+let int32_of_direction, direction_of_int32 =
+ make_map [
+ `Forward, 1l;
+ `Backward, -1l;
+ ]
type ax12_action = {
aa_id : int;
aa_position : int;
aa_velocity : int;
-} with obus
+}
type motor_config = {
motor_kp : int;
motor_ki : int;
motor_kd : int;
motor_li : int;
-} with obus
+}
diff --git a/info/control/common/krobot_types.mli b/info/control/common/krobot_types.mli
index 56d042b..3bc674f 100644
--- a/info/control/common/krobot_types.mli
+++ b/info/control/common/krobot_types.mli
@@ -7,35 +7,53 @@
* This file is a part of [kro]bot.
*)
-(** Common types with their obus type combinators *)
+(** Common types *)
(** This types are used by the driver and the client...
[truncated message content] |
