Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. ad5e0b49e34128237c74cb551a2f3243387d9a3f
|
From: Jérémie D. <Ba...@us...> - 2010-04-22 14:32:03
|
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 ad5e0b49e34128237c74cb551a2f3243387d9a3f (commit)
from 15f2f81f08e1a3684c09b9be858889a925977fb4 (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 ad5e0b49e34128237c74cb551a2f3243387d9a3f
Author: Jérémie Dimino <dim@gaia.(none)>
Date: Thu Apr 22 16:30:05 2010 +0200
terminate code upgrade
-----------------------------------------------------------------------
Changes:
diff --git a/info/control/Makefile b/info/control/Makefile
index ab1e117..8850da0 100644
--- a/info/control/Makefile
+++ b/info/control/Makefile
@@ -32,15 +32,15 @@ install:
$(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/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
- install -m 0755 _build/clients/krobot_controller.best $(PREFIX)/bin/krobot-controller
- install -m 0755 _build/services/krobot_hard_stop.best $(PREFIX)/bin/krobot-hard-stop
- install -m 0755 _build/driver/krobot_driver.best $(PREFIX)/bin/krobot-driver
- install -m 0755 _build/clients/krobot_ax12.best $(PREFIX)/bin/krobot-ax12
+ install -m 0755 _build/card-tools/send_firmware.best $(PREFIX)/bin/krobot-send-firmware
+ install -m 0755 _build/card-tools/dump_memory.best $(PREFIX)/bin/krobot-dump-memory
+ install -m 0755 _build/tools/forward_dbus.best $(PREFIX)/bin/krobot-forward-dbus
+ install -m 0755 _build/clients/info.best $(PREFIX)/bin/krobot-info
+ install -m 0755 _build/clients/joy_control.best $(PREFIX)/bin/krobot-joystick
+ install -m 0755 _build/clients/controller.best $(PREFIX)/bin/krobot-controller
+ install -m 0755 _build/services/hard_stop.best $(PREFIX)/bin/krobot-hard-stop
+ install -m 0755 _build/driver/driver.best $(PREFIX)/bin/krobot-driver
+ install -m 0755 _build/clients/ax12_control.best $(PREFIX)/bin/krobot-ax12
.PHONY: uninstall
uninstall:
diff --git a/info/control/_tags b/info/control/_tags
index 1aaed9b..6cd01b3 100644
--- a/info/control/_tags
+++ b/info/control/_tags
@@ -26,10 +26,10 @@
<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
-<clients/krobot_script*>: pkg_text
-<clients/krobot_ax12.*>: pkg_lwt.text
+<clients/joy_control.*>: pkg_sdl
+<clients/controller.*>: pkg_lwt.text
+<clients/script{.*,_lexer.*}>: pkg_text
+<clients/ax12_control.*>: pkg_lwt.text
# +------------------------------------------------------------------+
# | Services |
@@ -55,8 +55,8 @@
# | Tools |
# +------------------------------------------------------------------+
-<tools/krobot_forward_dbus.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<tools/krobot_forward_dbus.*>: pkg_obus
+<tools/forward_dbus.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
+<tools/forward_dbus.*>: pkg_obus
# +------------------------------------------------------------------+
# | Tests |
diff --git a/info/control/card-tools/boardname.mli b/info/control/card-tools/boardname.mli
new file mode 100644
index 0000000..51dc1b5
--- /dev/null
+++ b/info/control/card-tools/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/boardname.mll b/info/control/card-tools/boardname.mll
new file mode 100644
index 0000000..96b39b6
--- /dev/null
+++ b/info/control/card-tools/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/bootloader.ml b/info/control/card-tools/bootloader.ml
new file mode 100644
index 0000000..7151d00
--- /dev/null
+++ b/info/control/card-tools/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/dump_memory.ml b/info/control/card-tools/dump_memory.ml
new file mode 100644
index 0000000..a19af09
--- /dev/null
+++ b/info/control/card-tools/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 = Bootloader.open_card () in
+ try_lwt
+ lwt data = Bootloader.get_flash k ~address:0x0 ~length:0x8000 in
+ let msg = match 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
+ | Bootloader.Error e ->
+ eprintlf "%s" (Bootloader.string_of_error e)
+ | e ->
+ eprintlf "%s" (Printexc.to_string e)
diff --git a/info/control/card-tools/hexfile.ml b/info/control/card-tools/hexfile.ml
new file mode 100644
index 0000000..2d2c361
--- /dev/null
+++ b/info/control/card-tools/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/hexfile.mli b/info/control/card-tools/hexfile.mli
new file mode 100644
index 0000000..932e32e
--- /dev/null
+++ b/info/control/card-tools/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_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/card-tools/send_firmware.ml b/info/control/card-tools/send_firmware.ml
new file mode 100644
index 0000000..45e7645
--- /dev/null
+++ b/info/control/card-tools/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 = Hexfile.parse_file filename in
+ let memory =
+ let buffer = String.make 0x8000 '\255' in
+ Hexfile.validate_and_copy hex 0x0 buffer 0 0x8000;
+ buffer
+ in
+ let firmware_name = 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 = Bootloader.open_card () in
+ lwt () = printf "Card opened\n" in
+ lwt data = Bootloader.get_flash k ~address:0x0 ~length:0x8000 in
+ let board_name = 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 () = Bootloader.erase_flash k ~address ~length in
+ lwt () = printf "Flash erased\n" in
+ lwt () = Bootloader.write_flash k ~address memory address length in
+ lwt () = printf "Flashing completed\n" in
+ lwt () = 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
+ | Bootloader.Error e ->
+ eprintl (Bootloader.string_of_error e)
+ | e ->
+ eprintl (Printexc.to_string e)
diff --git a/info/control/clients/ax12_control.ml b/info/control/clients/ax12_control.ml
new file mode 100644
index 0000000..8d7f465
--- /dev/null
+++ b/info/control/clients/ax12_control.ml
@@ -0,0 +1,83 @@
+(*
+ * ax12_control.ml
+ * ---------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* AX12 interactive controller *)
+
+open Lwt
+open Lwt_io
+open Lwt_term
+
+let render positions selected =
+ let size = React.S.value Lwt_term.size in
+ let zone = Zone.make ~width:size.columns ~height:size.lines in
+ let x = (size.columns / 2) - 7 in
+ let y = (size.lines / 2) - (Array.length positions / 2) in
+ for i = 0 to Array.length positions - 1 do
+ if i = selected then
+ Draw.textc ~zone ~x ~y:(y + i * 2)
+ ~text:[inverse; textf "ax12[%d] : %4d" (i + 1) positions.(i)]
+ else
+ Draw.textc ~zone ~x ~y:(y + i * 2)
+ ~text:[textf "ax12[%d] : %4d" (i + 1) positions.(i)]
+ done;
+ Lwt_term.render (Zone.points zone)
+
+lwt () =
+ lwt krobot = Krobot.create () in
+
+ lwt () = Lwt_log.notice "reading current ax12 positions" in
+ lwt pos1 = Krobot.unsafe_call Commands.AX12.get_position krobot (1, 100)
+ and pos2 = Krobot.unsafe_call Commands.AX12.get_position krobot (2, 100)
+ and pos3 = Krobot.unsafe_call Commands.AX12.get_position krobot (3, 100) in
+ lwt () = Lwt_log.notice "done" in
+
+ let positions = [|pos1; pos2; pos3|] in
+
+ let rec loop selected =
+ lwt () = render positions selected in
+ Lwt_term.read_key () >>= function
+ | Key_up ->
+ if selected > 0 then
+ loop (selected - 1)
+ else
+ loop selected
+ | Key_down ->
+ if selected < Array.length positions - 1 then
+ loop (selected + 1)
+ else
+ loop selected
+ | Key_left ->
+ positions.(selected) <- max 0 (positions.(selected) - 10);
+ lwt () = Krobot.unsafe_call Commands.AX12.goto krobot (selected + 1, positions.(selected), 50, `Now) in
+ loop selected
+ | Key_right ->
+ positions.(selected) <- min 1023 (positions.(selected) + 10);
+ lwt () = Krobot.unsafe_call Commands.AX12.goto krobot (selected + 1, positions.(selected), 50, `Now) in
+ loop selected
+ | Key ("\027[d" | "\027[1;2D") ->
+ positions.(selected) <- max 0 (positions.(selected) - 1);
+ lwt () = Krobot.unsafe_call Commands.AX12.goto krobot (selected + 1, positions.(selected), 50, `Now) in
+ loop selected
+ | Key ("\027[c" | "\027[1;2C") ->
+ positions.(selected) <- min 1023 (positions.(selected) + 1);
+ lwt () = Krobot.unsafe_call Commands.AX12.goto krobot (selected + 1, positions.(selected), 50, `Now) in
+ loop selected
+ | Key_control '[' ->
+ return ()
+ | _ ->
+ loop selected
+ in
+
+ lwt () = Lwt_term.enter_drawing_mode () in
+ lwt () = Lwt_term.hide_cursor () in
+
+ try_lwt
+ loop 0
+ finally
+ Lwt_term.leave_drawing_mode ()
diff --git a/info/control/clients/controller.ml b/info/control/clients/controller.ml
new file mode 100644
index 0000000..72c8bbd
--- /dev/null
+++ b/info/control/clients/controller.ml
@@ -0,0 +1,490 @@
+(*
+ * controller.ml
+ * -------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* Prints status continuously *)
+
+open Lwt
+open Lwt_term
+open Lwt_read_line
+
+module TextSet = Set.Make(Text)
+
+(* Maximum number of refresh by seconds: *)
+let refresh_rate = 10
+
+(* +-----------------------------------------------------------------+
+ | Logging |
+ +-----------------------------------------------------------------+ *)
+
+(* Maximum number of lines to keep in logs: *)
+let log_count = 16384
+
+(* Signal holding the current logs: *)
+let logs, set_logs = React.S.create []
+
+let add_date line =
+ let buffer = Buffer.create 42 in
+ Lwt_log.render ~buffer ~level:Lwt_log.Info ~message:"" ~template:"$(date): " ~section:Lwt_log.Section.main;
+ text (Buffer.contents buffer) :: line
+
+(* Add a list of lines to logs *)
+let log_add_lines lines =
+ let rec truncate n = function
+ | [] ->
+ []
+ | line :: rest ->
+ if n = log_count then
+ []
+ else
+ line :: truncate (n + 1) rest
+ in
+ set_logs (truncate 0 (List.rev_map add_date lines @ (React.S.value logs)))
+
+let log_add_line line =
+ log_add_lines [line]
+
+(* Redirect stderr to logs *)
+let redirect_stderr () =
+ let rec copy_logs ic =
+ lwt line = Lwt_io.read_line ic in
+ log_add_line [text line];
+ copy_logs ic
+ in
+ let fdr, fdw = Unix.pipe () in
+ Unix.dup2 fdw Unix.stderr;
+ Unix.close fdw;
+ ignore (copy_logs (Lwt_io.of_unix_fd ~mode:Lwt_io.input fdr))
+
+(* Make the default logger to logs into the log buffer *)
+let init_logger () =
+ Lwt_log.default :=
+ Lwt_log.make
+ ~output:(fun section level lines ->
+ log_add_lines
+ (List.map
+ (fun line ->
+ if level >= Lwt_log.Warning then
+ (* Colorize error in red: *)
+ [fg lred; text line]
+ else
+ [text line])
+ lines);
+ return ())
+ ~close:return
+
+(* +-----------------------------------------------------------------+
+ | Read-line |
+ +-----------------------------------------------------------------+ *)
+
+let engine_state, set_engine_state = React.S.create (Engine.init [])
+let box, set_box = React.S.create Terminal.Box_empty
+
+let () =
+ Lwt_signal.always_notify
+ (function
+ | Engine.Edition(before, after) ->
+ let comp = Script.complete before after in
+ set_box (Terminal.Box_words(comp.comp_words, 0))
+ | Engine.Selection _ ->
+ set_box (Terminal.Box_message "<selection>")
+ | Engine.Search _ ->
+ set_box (Terminal.Box_message "<backward search>"))
+ (React.S.map (fun state -> state.Engine.mode) engine_state)
+
+let history_file_name =
+ Filename.concat (try Unix.getenv "HOME" with _ -> "") ".krobot-controller-history"
+
+let save_history history =
+ Lwt_read_line.save_history history_file_name history
+
+let rec loop krobot history =
+ lwt key = read_key () in
+ if key = key_escape then
+ save_history history
+ else
+ match Command.of_key key with
+ | Command.Accept_line ->
+ let line = Text.strip (Engine.all_input (React.S.value engine_state)) in
+ if line = "exit" then
+ save_history history
+ else if line <> "" then begin
+ let history = Lwt_read_line.add_entry line history in
+ set_engine_state (Engine.init history);
+ lwt () = Lwt_log.notice line in
+ ignore (Script.exec ~krobot ~logger:(fun line -> log_add_line line; return ()) ~command:line);
+ loop krobot history
+ end else
+ loop krobot history
+ | Command.Complete ->
+ let engine_state = Engine.reset (React.S.value engine_state) in
+ let before, after = Engine.edition_state engine_state in
+ let comp = Script.complete before after in
+ set_engine_state { engine_state with Engine.mode = Engine.Edition comp.comp_state };
+ loop krobot history
+ | command ->
+ set_engine_state (Engine.update (React.S.value engine_state) command ());
+ loop krobot history
+
+(* +-----------------------------------------------------------------+
+ | Service monitoring |
+ +-----------------------------------------------------------------+ *)
+
+let services, set_services = React.S.create ~eq:TextSet.equal TextSet.empty
+
+let check_services bus =
+ lwt l = OBus_bus.list_names bus in
+ set_services (List.fold_left (fun set name ->
+ if Text.starts_with name "fr.krobot." then
+ TextSet.add (String.sub name 10 (String.length name - 10)) set
+ else
+ set) TextSet.empty l);
+ return ()
+
+(* +-----------------------------------------------------------------+
+ | Drawing |
+ +-----------------------------------------------------------------+ *)
+
+(* Draw the whole screen *)
+let rec draw krobot =
+ let size = React.S.value Lwt_term.size in
+
+ let screen = Zone.make ~width:size.columns ~height:size.lines in
+ let points = Zone.points screen in
+
+ let line_color = lblue in
+ let line = { blank with style = { blank.style with foreground = line_color } } in
+ let name_color = lwhite in
+
+ (* ===== Borders ===== *)
+
+ for i = 1 to size.columns - 2 do
+ points.(0).(i) <- { line with char = "─" };
+ points.(size.lines - 1).(i) <- { line with char = "─" }
+ done;
+ for i = 1 to size.lines - 2 do
+ points.(i).(0) <- { line with char = "│" };
+ points.(i).(size.columns - 1) <- { line with char = "│" }
+ done;
+ points.(0).(0) <- { line with char = "┌" };
+ points.(size.lines - 1).(0) <- { line with char = "└" };
+ points.(size.lines - 1).(size.columns - 1) <- { line with char = "┘" };
+ points.(0).(size.columns - 1) <- { line with char = "┐" };
+
+ (* ===== Status ===== *)
+
+ Draw.textc screen 1 0 [fg line_color; text "─[ ";
+ fg name_color; text "Range finders";
+ fg line_color; text " ]─┬─[ ";
+ fg name_color; text "Logic Sensors";
+ fg line_color; text " ]─┬─[ ";
+ fg name_color; text "Services";
+ fg line_color; text " ]─┬─[ ";
+ fg name_color; text "Cards";
+ fg line_color; text " ]─┬─[ ";
+ fg name_color; text "Status";
+ fg line_color; text " ]─"];
+ points.(9).(0) <- { line with char = "├" };
+ points.(9).(size.columns - 1) <- { line with char = "┤" };
+ for i = 1 to size.columns - 2 do
+ points.(9).(i) <- { line with char = "─" }
+ done;
+ for i = 1 to 8 do
+ points.(i).(20) <- { line with char = "│" };
+ points.(i).(40) <- { line with char = "│" };
+ points.(i).(55) <- { line with char = "│" };
+ points.(i).(67) <- { line with char = "│" }
+ done;
+ Draw.textc screen 1 9 [fg line_color; text "───────────────────┴───────────────────┴──────────────┴───────────┴"];
+
+ let zone = Zone.inner screen in
+
+ lwt () =
+ try_lwt
+ lwt range_finders = OBus_property.get (Krobot.range_finders krobot) in
+ for i = 0 to Array.length range_finders - 1 do
+ Draw.textc zone 0 i [textf "%d : " i; text (Text.repeat (range_finders.(i) * 14 / 3146) "=")]
+ done;
+ return ()
+ with exn ->
+ for i = 0 to 7 do
+ Draw.textc zone 0 i [fg red; text "error"]
+ done;
+ return ()
+ in
+
+ lwt () =
+ try_lwt
+ lwt logic_sensors = OBus_property.get (Krobot.logic_sensors krobot) in
+ for i = 0 to Array.length logic_sensors / 2 - 1 do
+ let j = i * 2 in
+ Draw.textf zone 20 i "%02d : %s %02d : %s"
+ (j + 0) (if logic_sensors.(j + 0) then "O" else ".")
+ (j + 1) (if logic_sensors.(j + 1) then "O" else ".")
+ done;
+ return ()
+ with exn ->
+ for i = 0 to 7 do
+ Draw.textc zone 20 i [fg red; text "error"]
+ done;
+ return ()
+ in
+
+ let zone' = Zone.sub ~zone ~x:40 ~y:0 ~width:14 ~height:8 in
+ let rec loop y = function
+ | [] ->
+ ()
+ | name :: rest ->
+ Draw.text ~zone:zone' ~x:0 ~y ~text:name;
+ loop (y + 1) rest
+ in
+ loop 0 (TextSet.elements (React.S.value services));
+
+ let x = 55 in
+ let text_of_state name = function
+ | `Absent -> [fg lred; text name]
+ | `Present -> [text name]
+ in
+ lwt () =
+ try_lwt
+ lwt interface_state = OBus_property.get (Krobot.Card.state krobot `Interface)
+ and sensor_state = OBus_property.get (Krobot.Card.state krobot `Sensor)
+ and motor_state = OBus_property.get (Krobot.Card.state krobot `Motor)
+ and monitoring_state = OBus_property.get (Krobot.Card.state krobot `Monitoring) in
+ Draw.textc zone x 0 (text_of_state "interface" interface_state);
+ Draw.textc zone x 1 (text_of_state "sensor" sensor_state);
+ Draw.textc zone x 2 (text_of_state "motor" motor_state);
+ Draw.textc zone x 3 (text_of_state "monitoring" monitoring_state);
+ return ()
+ with exn ->
+ for i = 0 to 3 do
+ Draw.textc zone x i [fg red; text "error"]
+ done;
+ return ()
+ in
+ let x = x + 12 in
+ lwt () =
+ try_lwt
+ lwt compass = OBus_property.get (Krobot.compass krobot) in
+ Draw.textf zone x 2 "compass = %d" compass;
+ return ()
+ with exn ->
+ Draw.textc zone x 2 [fg red; text "error"];
+ return ()
+ in
+ let date = Unix.gettimeofday () in
+ let text_of_motor_state mode until =
+ if date < until then
+ [text mode; fg lyellow; text "inhibited"]
+ else
+ [text mode; text "OK"]
+ in
+ lwt () =
+ try_lwt
+ lwt forward = OBus_property.get (Krobot.inhibit_forward_until krobot)
+ and backward = OBus_property.get (Krobot.inhibit_backward_until krobot) in
+ Draw.textc zone x 3 (text_of_motor_state "move forward: " forward);
+ Draw.textc zone x 4 (text_of_motor_state "move backward: " backward);
+ return ()
+ with exn ->
+ for i = 3 to 4 do
+ Draw.textc zone x i [fg red; text "error"]
+ done;
+ return ()
+ in
+
+ (* ===== History ===== *)
+
+ let zone = Zone.sub ~zone:screen ~x:1 ~y:10 ~width:(Zone.width screen - 2) ~height:(Zone.height screen - 15) in
+ let rec loop y = function
+ | [] ->
+ ()
+ | line :: rest ->
+ if y < 0 then
+ ()
+ else begin
+ Draw.textc zone 0 y line;
+ loop (y - 1) rest
+ end
+ in
+ loop (Zone.height zone - 1) (React.S.value logs);
+
+ (* ===== Read-line ===== *)
+
+ points.(size.lines - 3).(0) <- { line with char = "├" };
+ points.(size.lines - 3).(size.columns - 1) <- { line with char = "┤" };
+ points.(size.lines - 5).(0) <- { line with char = "├" };
+ points.(size.lines - 5).(size.columns - 1) <- { line with char = "┤" };
+ for i = 1 to size.columns - 2 do
+ points.(size.lines - 5).(i) <- { line with char = "─" };
+ points.(size.lines - 3).(i) <- { line with char = "─" }
+ done;
+
+ let zone = Zone.sub ~zone:screen ~x:1 ~y:(size.lines - 4) ~width:(size.columns - 2) ~height:1 in
+ let engine_state = React.S.value engine_state in
+ let cursor_position =
+ match engine_state.Engine.mode with
+ | Engine.Edition(before, after) ->
+ let len = Text.length before in
+ Draw.textc zone 0 0 [Text before; Text after];
+ len
+ | Engine.Selection state ->
+ let a = min state.Engine.sel_cursor state.Engine.sel_mark
+ and b = max state.Engine.sel_cursor state.Engine.sel_mark in
+ let part_before = Text.chunk (Text.pointer_l state.Engine.sel_text) a
+ and part_selected = Text.chunk a b
+ and part_after = Text.chunk (Text.pointer_r state.Engine.sel_text) b in
+ Draw.textc zone 0 0 [Text part_before; Underlined; Text part_selected; Reset; Text part_after];
+ if state.Engine.sel_cursor < state.Engine.sel_mark then
+ Text.length part_before
+ else
+ Text.length part_before + Text.length part_selected
+ | Engine.Search state ->
+ let len = Text.length state.Engine.search_word in
+ Draw.text zone 0 0 (Printf.sprintf "(reverse-i-search)'%s'" state.Engine.search_word);
+ begin match state.Engine.search_history with
+ | [] ->
+ 19 + len
+ | phrase :: _ ->
+ let ptr_start = match Text.find phrase state.Engine.search_word with
+ | Some ptr ->
+ ptr
+ | None ->
+ assert false
+ in
+ let ptr_end = Text.move len ptr_start in
+ let before = Text.chunk (Text.pointer_l phrase) ptr_start
+ and selected = Text.chunk ptr_start ptr_end
+ and after = Text.chunk ptr_end (Text.pointer_r phrase) in
+ Draw.textc zone (20 + len) 0 [
+ Text ": ";
+ Text before;
+ Underlined;
+ Text selected;
+ Reset;
+ Text after;
+ ];
+ 19 + len
+ end
+ in
+ Draw.map zone cursor_position 0 (fun point -> { point with style = { point.style with inverse = true } });
+
+ let zone = Zone.sub ~zone:screen ~x:1 ~y:(size.lines - 3) ~width:(size.columns - 2) ~height:3 in
+ begin
+ match React.S.value box with
+ | Terminal.Box_none | Terminal.Box_empty ->
+ ()
+ | Terminal.Box_message msg ->
+ Draw.text zone 0 1 msg
+ | Terminal.Box_words(words, _) ->
+ ignore (TextSet.fold
+ (fun word i ->
+ let len = Text.length word in
+ Draw.text zone i 1 word;
+ let i = i + len in
+ Draw.textc zone i 0 [fg line_color; text "┬"];
+ Draw.textc zone i 1 [fg line_color; text "│"];
+ Draw.textc zone i 2 [fg line_color; text "┴"];
+ i + 1)
+ words 0)
+ end;
+
+ Lwt_term.render (Zone.points screen)
+
+(* Wether the screen need to be refreshed *)
+let refresh_needed = ref false
+
+(* Program a refresh before the next main loop iteration *)
+let refresh krobot =
+ if !refresh_needed then
+ return ()
+ else begin
+ refresh_needed := true;
+ lwt () = Lwt.pause () in
+ refresh_needed := false;
+ draw krobot
+ end
+
+(* +-----------------------------------------------------------------+
+ | Entry point |
+ +-----------------------------------------------------------------+ *)
+
+lwt () =
+ lwt () = Lwt_log.notice "connecting to the krobot bus..." in
+ lwt krobot = Krobot.create () in
+ let bus = OBus_peer.connection (Krobot.to_peer krobot) in
+
+ (* Put the terminal into drawing mode: *)
+ lwt () = Lwt_term.enter_drawing_mode () in
+ lwt () = Lwt_term.hide_cursor () in
+
+ init_logger ();
+ redirect_stderr ();
+
+ (* Dump all logs to stdout on abnormal exit: *)
+ let node =
+ Lwt_sequence.add_l
+ (fun () ->
+ lwt () = Lwt_term.leave_drawing_mode () in
+ Lwt_list.iter_s printlc (List.rev (React.S.value logs)))
+ Lwt_main.exit_hooks
+ in
+
+ (* Service monitoring *)
+ lwt () = check_services bus in
+ Lwt_event.always_notify_p (fun _ -> check_services bus) (OBus_signal.event (OBus_bus.name_owner_changed bus));
+
+ (* Minimum delay to wait between two screen redrawing *)
+ let delay = 1.0 /. (float_of_int refresh_rate) in
+ (* Event which refresh the screen when it occurs: *)
+ let event, push = React.E.create () in
+ Lwt_event.always_notify_p
+ (fun () -> refresh krobot)
+ (* Limit the number of redraw per seconds: *)
+ (Lwt_event.limit (fun () -> Lwt_unix.sleep delay) event);
+ (* Ask for a refresh when [signal] changes: *)
+ let notify signal = Lwt_signal.always_notify (fun _ -> push ()) signal in
+ notify box;
+ notify logs;
+ notify services;
+
+ lwt () = OBus_bus.add_match bus (OBus_match.rule ~typ:`Signal ~member:"ProppertiesChanged" ()) in
+ let _ =
+ Lwt_sequence.add_l
+ (function
+ | { OBus_message.typ = OBus_message.Signal(_, _, "PropertiesChanged") } as msg ->
+ push ();
+ Some msg
+ | msg ->
+ Some msg)
+ (OBus_connection.incoming_filters bus)
+ in
+
+ 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)))
+ [`Interface; `Sensor; `Motor; `Monitoring];
+
+ (* Redraw immedlatly the screen when [signal] changes: *)
+ let urgent signal = Lwt_signal.always_notify_p (fun _ -> refresh krobot) signal in
+ urgent Lwt_term.size;
+ urgent engine_state;
+
+ lwt history = Lwt_read_line.load_history history_file_name in
+ set_engine_state (Engine.init history);
+
+ (* User input loop *)
+ lwt () = Lwt_term.with_raw_mode (fun () -> loop krobot history) in
+
+ (* Normal exit, do not dump logs on stdout: *)
+ Lwt_sequence.remove node;
+
+ (* Leave drawing mode *)
+ Lwt_term.leave_drawing_mode ()
diff --git a/info/control/clients/info.ml b/info/control/clients/info.ml
new file mode 100644
index 0000000..f60bb31
--- /dev/null
+++ b/info/control/clients/info.ml
@@ -0,0 +1,36 @@
+(*
+ * info.ml
+ * -------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* Print cards informations *)
+
+open Lwt
+open Lwt_io
+
+let print_card krobot card =
+ 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
+ let name = Krobot.Card.name card in
+ lwt () = printl "==========" in
+ lwt () = printlf "card.%s.state = present" name in
+ lwt () = printlf "card.%s.firmware_build = %s" name firmware_build in
+ lwt () = printlf "card.%s.board_info = %s" name board_info in
+ return ()
+ | `Absent ->
+ lwt () = printl "==========" in
+ printlf "card.%s.state = absent" (Krobot.Card.name card)
+
+lwt () =
+ lwt krobot = Krobot.create () in
+ lwt () = print_card krobot `Interface in
+ lwt () = print_card krobot `Sensor in
+ lwt () = print_card krobot `Motor in
+ lwt () = print_card krobot `Monitoring in
+ return ()
diff --git a/info/control/clients/init_position.ml b/info/control/clients/init_position.ml
new file mode 100644
index 0000000..16aa2e0
--- /dev/null
+++ b/info/control/clients/init_position.ml
@@ -0,0 +1,41 @@
+(*
+ * init_position.ml
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(* Put the robot into its initial state *)
+
+open Lwt
+
+let move_backward_slowly krobot =
+ lwt () = Lwt_log.notice "moving backward" in
+ Krobot.move krobot ~distance:(-1000) ~velocity:100 ~acceleration:100 >>= function
+ ...
[truncated message content] |
