Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. eef31e41b3f2d1ac1bbd5b320e65ca187efb1293
|
From: Jérémie D. <Ba...@us...> - 2010-05-28 00:35:27
|
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 eef31e41b3f2d1ac1bbd5b320e65ca187efb1293 (commit)
from 6ed445d2f79860a1a6251c6013b25c2d98f3fad2 (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 eef31e41b3f2d1ac1bbd5b320e65ca187efb1293
Author: Jérémie Dimino <je...@di...>
Date: Fri May 28 02:30:28 2010 +0200
refactoring
-----------------------------------------------------------------------
Changes:
diff --git a/info/control/Makefile b/info/control/Makefile
index 5a20a41..9f95f4a 100644
--- a/info/control/Makefile
+++ b/info/control/Makefile
@@ -7,13 +7,9 @@
PREFIX := $(HOME)
-OC := ocamlbuild
+OC := ocamlbuild -classic-display
OF := ocamlfind
-ifeq ($(TERM),dumb)
-OC += -classic-display
-endif
-
.PHONY: all
all:
$(OC) all
@@ -25,34 +21,20 @@ clean:
.PHONY: install
install:
$(OF) install krobot META \
- lib-krobot/krobot.mli \
+ $(wildcard lib-krobot/*.mli) \
+ $(wildcard common/*.mli) \
+ $(wildcard protocol/*.mli) \
$(wildcard _build/lib-krobot/*.cmi) \
+ $(wildcard _build/common/*.cmi) \
+ $(wildcard _build/protocol/*.cmi) \
$(wildcard _build/lib-krobot/*.cmx) \
+ $(wildcard _build/common/*.cmx) \
+ $(wildcard _build/protocol/*.cmx) \
$(wildcard _build/*.cma) \
$(wildcard _build/*.cmxa) \
$(wildcard _build/*.cmxs) \
$(wildcard _build/*.a)
- 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/services/range_finders_stop.best $(PREFIX)/bin/krobot-range-finders-stop
- install -m 0755 _build/services/infrared_stop.best $(PREFIX)/bin/krobot-infrared-stop
- install -m 0755 _build/driver/driver.best $(PREFIX)/bin/krobot-driver
- install -m 0755 _build/clients/ax12_control.best $(PREFIX)/bin/krobot-ax12
- install -m 0755 _build/clients/check.best $(PREFIX)/bin/krobot-check
- install -m 0755 _build/clients/check.best $(PREFIX)/bin/krobot-check
- install -m 0755 _build/clients/record_infrared.best $(PREFIX)/bin/krobot-record-infrared
- install -m 0755 _build/clients/scan.best $(PREFIX)/bin/krobot-scan
- install -m 0755 _build/clients/replay.best $(PREFIX)/bin/krobot-replay
- install -m 0755 _build/clients/play.best $(PREFIX)/bin/krobot-play
- install -m 0755 _build/clients/recorder.best $(PREFIX)/bin/krobot-recorder
- install -m 0755 _build/clients/jack.best $(PREFIX)/bin/krobot-jack
- install -m 0755 _build/clients/write_lcd.best $(PREFIX)/bin/krobot-write-lcd
- install -m 0755 _build/clients/ia.best $(PREFIX)/bin/krobot-ia
+ @/bin/bash install-programs.sh $(PREFIX)
.PHONY: uninstall
uninstall:
diff --git a/info/control/_tags b/info/control/_tags
index 00d5dce..b468930 100644
--- a/info/control/_tags
+++ b/info/control/_tags
@@ -1,70 +1,14 @@
# -*- conf -*-
-# +------------------------------------------------------------------+
-# | Krobot library |
-# +------------------------------------------------------------------+
+# Uses the lwt syntax extension for all files:
+<**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<lib-krobot/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<lib-krobot/**>: pkg_lwt.unix, pkg_obus
+# Libraries used by all part of the robot:
+<**/*>: pkg_obus, pkg_lwt.text
-# +------------------------------------------------------------------+
-# | Protocol |
-# +------------------------------------------------------------------+
+# Only the driver and card tools have access to the hardware. The rest
+# should be compilable even without ocaml-usb and ocaml-serial.
+<{driver,usb-tools}/**/*>: thread, pkg_usb, pkg_serial
-<protocol/*>: pkg_obus
-
-# +------------------------------------------------------------------+
-# | Card tools |
-# +------------------------------------------------------------------+
-
-<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
-<clients/**>: pkg_lwt.unix, pkg_obus
-<clients/joy_control.*>: pkg_sdl
-<clients/controller.*>: pkg_lwt.text
-<clients/script{.*,_lexer.*}>: pkg_text
-<clients/ax12_control.*>: pkg_lwt.text
-<clients/check.*>: pkg_lwt.text
-<clients/scan.*>: pkg_lwt.text
-<clients/replay.*>: pkg_lwt.text
-<clients/play.*>: pkg_lwt.text
-
-# +------------------------------------------------------------------+
-# | Services |
-# +------------------------------------------------------------------+
-
-<services/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<services/**>: pkg_lwt.unix, pkg_obus
-
-# +------------------------------------------------------------------+
-# | Common |
-# +------------------------------------------------------------------+
-
-<common/*>: pkg_react, pkg_obus, syntax_camlp4o, pkg_lwt.syntax
-
-# +------------------------------------------------------------------+
-# | Driver |
-# +------------------------------------------------------------------+
-
-<driver/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<driver/**>: thread, pkg_lwt.unix, pkg_obus, pkg_usb, pkg_serial
-
-# +------------------------------------------------------------------+
-# | Tools |
-# +------------------------------------------------------------------+
-
-<tools/forward_dbus.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<tools/forward_dbus.*>: pkg_obus
-
-# +------------------------------------------------------------------+
-# | Tests |
-# +------------------------------------------------------------------+
-
-<tests/**/*.ml>: syntax_camlp4o, pkg_lwt.syntax, pkg_lwt.syntax.log
-<tests/**>: pkg_lwt.unix, pkg_obus, pkg_lwt.text
+# SDL is used to access the sixaxis controller
+<clients/krobot_joystick.*>: pkg_sdl
diff --git a/info/control/bus.conf b/info/control/bus.conf
new file mode 100644
index 0000000..080136b
--- /dev/null
+++ b/info/control/bus.conf
@@ -0,0 +1,31 @@
+<!-- Configuration of the D-Bus daemon used by programs of the robot -->
+
+<!DOCTYPE busconfig PUBLIC "-//freedesktop//DTD D-Bus Bus Krobot_configuration 1.0//EN"
+ "http://www.freedesktop.org/standards/dbus/1.0/busconfig.dtd">
+<busconfig>
+ <keep_umask/>
+
+ <!-- Krobot D-Bus daemon default address -->
+ <listen>unix:abstract=krobot</listen>
+
+ <!-- Allow everything -->
+ <policy context="default">
+ <allow send_destination="*" eavesdrop="true"/>
+ <allow eavesdrop="true"/>
+ <allow own="*"/>
+ </policy>
+
+ <!-- Raise limits -->
+ <limit name="max_incoming_bytes">1000000000</limit>
+ <limit name="max_outgoing_bytes">1000000000</limit>
+ <limit name="max_message_size">1000000000</limit>
+ <limit name="service_start_timeout">120000</limit>
+ <limit name="auth_timeout">240000</limit>
+ <limit name="max_completed_connections">100000</limit>
+ <limit name="max_incomplete_connections">10000</limit>
+ <limit name="max_connections_per_user">100000</limit>
+ <limit name="max_pending_service_starts">10000</limit>
+ <limit name="max_names_per_connection">50000</limit>
+ <limit name="max_match_rules_per_connection">50000</limit>
+ <limit name="max_replies_per_connection">50000</limit>
+</busconfig>
diff --git a/info/control/card-tools/boardname.mli b/info/control/card-tools/boardname.mli
deleted file mode 100644
index 51dc1b5..0000000
--- a/info/control/card-tools/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/boardname.mll b/info/control/card-tools/boardname.mll
deleted file mode 100644
index 3c41e97..0000000
--- a/info/control/card-tools/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 " | "Sensor Interface") [^'\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
deleted file mode 100644
index 7151d00..0000000
--- a/info/control/card-tools/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/dump_memory.ml b/info/control/card-tools/dump_memory.ml
deleted file mode 100644
index a19af09..0000000
--- a/info/control/card-tools/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 = 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
deleted file mode 100644
index 2d2c361..0000000
--- a/info/control/card-tools/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/hexfile.mli b/info/control/card-tools/hexfile.mli
deleted file mode 100644
index 932e32e..0000000
--- a/info/control/card-tools/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/send_firmware.ml b/info/control/card-tools/send_firmware.ml
deleted file mode 100644
index 45e7645..0000000
--- a/info/control/card-tools/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 = 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
deleted file mode 100644
index 8d7f465..0000000
--- a/info/control/clients/ax12_control.ml
+++ /dev/null
@@ -1,83 +0,0 @@
-(*
- * 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/check.ml b/info/control/clients/check.ml
deleted file mode 100644
index 4a59a31..0000000
--- a/info/control/clients/check.ml
+++ /dev/null
@@ -1,78 +0,0 @@
-(*
- * check.ml
- * --------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Lwt
-open Lwt_io
-open Lwt_term
-
-let test name f =
- lwt () = printlf "=[ testing %s ]%s" name (String.make (React.S.value columns - 13 - String.length name) '=') in
- try_lwt
- lwt () = f () in
- printlf "test succeed"
- with exn ->
- printlc [fg lred; textf "test failed with: %s" (Printexc.to_string exn)]
-
-lwt () =
- lwt krobot = Krobot.create () in
-
- lwt () =
- test "gate"
- (fun () ->
- lwt () = Krobot.Gate.enable krobot in
- lwt () = printl "opening the gate" in
- lwt () = Krobot.Gate.open_ krobot in
- lwt () = Lwt_unix.sleep 0.5 in
- lwt () = printl "closing the gate" in
- lwt () = Krobot.Gate.close krobot in
- lwt () = Lwt_unix.sleep 0.5 in
- return ())
- in
-
- lwt () =
- test "claws"
- (fun () ->
- lwt () = Krobot.Claws.enable krobot in
- lwt () = printl "opening the claws" in
- lwt () = Krobot.Claws.open_ krobot in
- lwt () = Lwt_unix.sleep 0.5 in
- lwt () = printl "closing the claws" in
- lwt () = Krobot.Claws.close krobot in
- lwt () = Lwt_unix.sleep 0.5 in
- return ())
- in
-
- lwt () =
- test "grip"
- (fun () ->
- lwt () = printl "opening the grip" in
- lwt () = Krobot.Grip.open_ krobot in
- lwt () = Lwt_unix.sleep 1.0 in
- lwt () = printl "closing the grip" in
- lwt () = Krobot.Grip.close krobot in
- lwt () = Lwt_unix.sleep 1.0 in
- return ())
- in
-
- lwt () =
- test "infrared"
- (fun () ->
- lwt () = printl "going to the left" in
- lwt () = Krobot.Infrared.go_left krobot in
- lwt () = Lwt_unix.sleep 1.5 in
- lwt () = printl "going to the right" in
- lwt () = Krobot.Infrared.go_right krobot in
- lwt () = Lwt_unix.sleep 1.5 in
- lwt () = printl "going to the center" in
- lwt () = Krobot.Infrared.go_center krobot in
- lwt () = Lwt_unix.sleep 1.0 in
- return ())
- in
-
- return ()
diff --git a/info/control/clients/controller.ml b/info/control/clients/controller.ml
deleted file mode 100644
index 69af1d4..0000000
--- a/info/control/clients/controller.ml
+++ /dev/null
@@ -1,565 +0,0 @@
-(*
- * controller.ml
- * -------------
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-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 []
-let set_services l = set_services (List.sort Pervasives.compare l)
-
-let check_services bus =
- lwt l = OBus_bus.list_names bus in
- set_services (List.fold_left (fun acc name ->
- if Text.starts_with name "fr.krobot." then
- String.sub name 10 (String.length name - 10) :: acc
- else
- acc) [] l);
- return ()
-
-(* +-----------------------------------------------------------------+
- | Drawing |
- +-----------------------------------------------------------------+ *)
-
-(* Draw the whole screen *)
-let 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
-
- let driver = List.mem "Driver" (React.S.value services) in
- lwt services_status =
- if driver then
- OBus_property.get (Krobot.services_status krobot)
- else
- return {
- Krobot.srv_compass = false;
- Krobot.srv_range_finders = false;
- Krobot.srv_logic_sensors = false;
- Krobot.srv_motor = false;
- Krobot.srv_grip = false;
- Krobot.srv_lcd = false;
- Krobot.srv_infrared = false;
- Krobot.srv_power = false;
- }
- 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 () =
- if driver && services_status.Krobot.srv_range_finders then begin
- lwt range_finders = OBus_property.get (Krobot.Range_finders.measures krobot) in
- let y = ref 0 in
- List.iter
- (fun i ->
- Draw.textc zone 0 !y [textf "%d : %d" i range_finders.(i)];
- incr y)
- [3; 8];
- return ()
- end else begin
- for i = 0 to 7 do
- Draw.textc zone 0 i [fg red; text "unavailable"]
- done;
- return ()
- end
- in
-
- lwt () =
- if driver && services_status.Krobot.srv_logic_sensors then begin
- lwt logic_sensors = OBus_property.get (Krobot.Logic_sensors.states krobot) in
- for i = 0 to 7 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 ()
- end else begin
- for i = 0 to 7 do
- Draw.textc zone 20 i [fg red; text "unavailable"]
- done;
- return ()
- end
- 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 (React.S.value services);
-
- let x = 55 in
- let text_of_state name = function
- | `Absent -> [fg lred; text name]
- | `Present -> [text name]
- in
- lwt () =
- if driver then begin
- lwt card_interface = OBus_property.get (Krobot.Card.state krobot `Interface)
- and card_sensor = OBus_property.get (Krobot.Card.state krobot `Sensor)
- and card_motor = OBus_property.get (Krobot.Card.state krobot `Motor)
- and card_monitoring = OBus_property.get (Krobot.Card.state krobot `Monitoring) in
- Draw.textc zone x 0 (text_of_state "interface" card_interface);
- Draw.textc zone x 1 (text_of_state "sensor" card_sensor);
- Draw.textc zone x 2 (text_of_state "motor" card_motor);
- Draw.textc zone x 3 (text_of_state "monitoring" card_monitoring);
- return ()
- end else begin
- Draw.textc zone x 0 (text_of_state "interface" `Absent);
- Draw.textc zone x 1 (text_of_state "sensor" `Absent);
- Draw.textc zone x 2 (text_of_state "motor" `Absent);
- Draw.textc zone x 3 (text_of_state "monitoring" `Absent);
- return ()
- end
- in
- let x = x + 12 in
- lwt () =
- if driver && services_status.Krobot.srv_compass then begin
- lwt compass = OBus_property.get (Krobot.Compass.measure krobot) in
- Draw.textf zone x 0 "compass = %d" compass;
- return ()
- end else begin
- Draw.textc zone x 0 [fg red; text "unavailable"];
- return ()
- end
- 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 () =
- if driver && services_status.Krobot.srv_motor then begin
- lwt forward = OBus_property.get (Krobot.Motors.inhibit_forward_until krobot)
- and backward = OBus_property.get (Krobot.Motors.inhibit_backward_until krobot) in
- Draw.textc zone x 1 (text_of_motor_state "move forward: " forward);
- Draw.textc zone x 2 (text_of_motor_state "move backward: " backward);
- return ()
- end else begin
- for i = 1 to 2 do
- Draw.textc zone x i [fg red; text "unavailable"]
- done;
- return ()
- end
- in
- lwt () =
- if driver && services_status.Krobot.srv_infrared then begin
- lwt ar = OBus_property.get (Krobot.Infrared.states krobot) in
- for i = 0 to 3 do
- Draw.textc zone x (i + 3) [textf "infrared %d: %d" i ar.(i)]
- done;
- return ()
- end else begin
- for i = 3 to 6 do
- Draw.textc zone x i [fg red; text "unavailable"]
- done;
- return ()
- end
- in
- lwt () =
- if driver && services_status.Krobot.srv_power then begin
- lwt current = OBus_property.get (Krobot.Power.current krobot) in
- Draw.textc zone x 7 [textf "current: %d mA" current];
- return ()
- end else begin
- Draw.textc zone x 7 [fg red; text "unavailable"];
- return ()
- end
- 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
-
-let draw_mutex = Lwt_mutex.create ()
-
-(* 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;
- Lwt_mutex.with_lock draw_mutex (fun () -> 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;
- let notifiers = ref [] in
- let notify_property property =
- try_lwt
- lwt signal = OBus_property.monitor property in
- notifiers := Lwt_signal.notify (fun _ -> push ()) signal :: !notifiers;
- return ()
- with exn ->
- Lwt_log.error_f ~exn "cannot monitor property"
- in
- ignore (
- lwt () = Lwt_unix.yield () in
- Lwt_signal.always_notify_s
- (function
- | true ->
- join [
- notify_property (Krobot.Compass.measure krobot);
- notify_property (Krobot.Logic_sensors.states krobot);
- notify_property (Krobot.Range_finders.measures krobot);
- notify_property (Krobot.Motors.inhibit_forward_until krobot);
- notify_property (Krobot.Motors.inhibit_backward_until krobot);
- notify_property (Krobot.Card.state krobot `Interface);
- notify_property (Krobot.Card.state krobot `Sensor);
- notify_property (Krobot.Card.state krobot `Motor);
- notify_property (Krobot.Card.state krobot `Monitoring);
- notify_property (Krobot.services_status krobot);
- notify_property (Krobot.Infrared.states krobot);
- notify_property (Krobot.Power.current krobot);
- ]
- | false ->
- List.iter Lwt_signal.disable !notifiers;
- notifiers := [];
- return ())
- (React.S.map (fun services -> List.mem "Driver" services) services);
- return ()
- );
-
- 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/ia.ml b/info/control/clients/ia.ml
deleted file mode 100644
index 3c45afa..0000000
--- a/info/control/clients/ia.ml
+++ /dev/null
@@ -1,295 +0,0 @@
-(*
- * ia.ml
- * -----
- * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
- * Licence : BSD3
- *
- * This file is a part of [kro]bot.
- *)
-
-open Lwt
-open Krobot_move
-
-let section = Lwt_log.Section.make "ia"
-
-let velocity = 400
-let acceleration = 800
-
-(* +-----------------------------------------------------------------+
- | Graph of the game board |
- +-----------------------------------------------------------------+ *)
-
-let a = { vx = 240; vy = 1960 }
-let b = { vx = 500; vy = 1378 }
-let c = { vx = 600; vy = 878 }
-let d = { vx = 600; vy = 378 }
-let e = { vx = 1050; vy = 628 }
-let f = { vx = 1050; vy = 1128 }
-let g = { vx = 1050; vy = 1378 }
-let h = { vx = 1500; vy = 378 }
-let i = { vx = 1500; vy = 878 }
-let j = { vx = 1500; vy = 1128 }
-let k = { vx = 1500; vy = 1378 }
-let l = { vx = 1950; vy = 628 }
-let m = { vx = 1950; vy = 1128 }
-let n = { vx = 1950; vy = 1378 }
-let o = { vx = 2400; vy = 378 }
-let p = { vx = 2400; vy = 878 }
-let q = { vx = 2500; vy = 1378 }
-let r = { vx = 2760; vy = 1960 }
-
-let vertices = [a; b; c; d; e; f; g; h; i; j; k; l; m; n; o; p; q; r]
-
-let graph = List.fold_left (fun graph edge -> Krobot_move.add_edge edge graph) Krobot_move.empty [
- (a, b);
- (b, g);
- (b, f);
- (c, f);
- (c, e);
- (d, e);
- (g, f);
- (g, k);
- (g, j);
- (g, i);
- (e, i);
- (e, h);
- (k, j);
- (k, n);
- (k, m);
- (j, n);
- (j, i);
- (j, m);
- (i, n);
- (i, m);
- (i, l);
- (h, l);
- (n, q);
- (n, m);
- (m, q);
- (m, p);
- (l, p);
- (l, o);
- (q, r);
-]
-
-(* +-----------------------------------------------------------------+
- | Ears |
- +-----------------------------------------------------------------+ *)
-
-(* List of potentially valid ears *)
-let ears = ref [
- { vx = 150; vy = 378 };
- { vx = 150; vy = 878 };
- { vx = 150; vy = 1378 };
-
- { vx = 600; vy = 128 };
- { vx = 600; vy = 628 };
- { vx = 600; vy = 1128 };
-
- { vx = 1050; vy = 378 };
- { vx = 1050; vy = 878 };
-
- { vx = 1500; vy = 128 };
- { vx = 1500; vy = 628 };
-
- { vx = 1950; vy = 378 };
- { vx = 1950; vy = 878 };
-
- { vx = 2400; vy = 128 };
- { vx = 2400; vy = 628 };
- { vx = 2400; vy = 1128 };
-
- { vx = 2850; vy = 378 };
- { vx = 2850; vy = 878 };
- { vx = 2850; vy = 1378 };
-]
-
-(* Mark an ear as a fake *)
-let mark_fake v =
- ears := List.filter (fun v' -> v.vy <> v'.vy || (v.vx <> v'.vx && v.vx <> 3000 - v'.vx)) !ears
-
-(* Look for the closest reachable ear, and returns the ear and the
- vertex from which the ear can be reached *)
-let closest_ear pos =
- let rec aux acc = function
- | [] ->
- acc
- | ear :: ears ->
- let rec search acc = function
- | [] ->
- acc
- | v :: rest ->
- if (match acc with
- | None -> true
- | Some v' -> Krobot_move.distance pos v < Krobot_move.distance pos v')
- && v.vy = ear.vy && abs (v.vx - ear.vx) = 450
- && (try let _ = Krobot_move.next graph pos v in true with Not_found -> false)
- then
- search (Some v) rest
- else
- search acc rest
- in
- match search None vertices with
- | None ->
- aux acc ears
- | Some v ->
- match acc with
- | None ->
- aux (Some(ear, v)) ears
- | Some(ear', v') ->
- if Krobot_move.distance pos v < Krobot_move.distance pos v' then
- aux (Some(ear, v)) ears
- else
- aux acc ears
- in
- aux None !ears
-
-(* +-----------------------------------------------------------------+
- | Movements |
- +-----------------------------------------------------------------+ *)
-
-let reverse_orientation krobot =
- lwt _ = Krobot.Motors.move krobot ~distance:(-250) ~velocity ~acceleration in
- lwt _ = Krobot.Motors.turn krobot ~angle:(-90) ~velocity ~acceleration in
- lwt _ = Krobot.Motors.move krobot ~distance:200 ~velocity ~acceleration in
- lwt _ = Krobot.Motors.turn krobot ~angle:(-51) ~velocity ~acceleration in
- lwt _ = Krobot.Motors.move krobot ~distance:(-320) ~velocity ~acceleration in
- lwt _ = Krobot.Motors.turn krobot ~angle:(-39) ~velocity ~acceleration in
- return ()
-
-let rec goto krobot state dest =
- if state.position = dest then
- return state
- else
- let next = Krobot_move.next graph state.position dest in
- lwt () = Lwt_log.info_f "next position: (%d, %d)" next.vx next.vy in
- let angle, distance, state' = Krobot_move.move state next in
- lwt () = Lwt_log.info_f "angle: %d, distance: %d, new state: position: (%d, %d), oritentation: %d" angle distance state'.position.vx state'.position.vy state'.orientation in
- lwt () =
- if angle <> 0 then
- lwt _ = Krobot.Motors.turn krobot ~angle ~velocity ~acceleration in
- return ()
- else
- return ()
- in
- lwt _ = Krobot.Motors.move krobot ~distance ~velocity ~acceleration in
- goto krobot state' dest
-
-let take_ear_simple krobot state ear =
- lwt a, d = Krobot.Infrared.find krobot in
- let alpha = a in
- lwt _ = Krobot.Motors.turn krobot ~angle:a ~velocity ~acceleration in
- lwt a, d = Krobot.Infrared.find krobot in
- let alpha = alpha + a in
- lwt _ = Krobot.Motors.turn krobot ~angle:a ~velocity ~acceleration in
- lwt _ = Krobot.Motors.move krobot ~distance:(d - 100) ~velocity ~acceleration in
- lwt () = Krobot.Grip.down krobot in
- lwt () = Krobot.Grip.open_ krobot in
- lwt _ = Krobot.Motors.move krobot ~distance:100 ~velocity ~acceleration in
- lwt () = Krobot.Grip.close krobot in
- lwt () = Lwt_log.info ~section "grip up" in
- lwt () =
- try_lwt
- lwt _ = Krobot.Grip.up krobot in
- lwt () = Lwt_log.info ~section "grip release" in
- Krobot.Grip.release krobot
- with _ ->
- return ()
- in
- lwt () = Lwt_log.info ~section "ear collected" in
- ears := List.filter ((<>) ear) !ears;
- return (state, alpha, d)
-
-let take_ear krobot state ear =
- lwt () = Lwt_log.info_f ~section "taking ear at position (%d, %d)" ear.vx ear.vy in
- lwt state =
- match abs state.orientation <= 90, ear.vx > state.position.vx with
- | true, true ->
- lwt _ = Krobot.Motors.turn krobot ~angle:(-state.orientation) ~velocity ~acceleration in
- return { state with orientation = 0 }
- | true, false ->
- lwt _ = Krobot.Motors.turn krobot ~angle:(-state.orientation) ~velocity ~acceleration in
- lwt () = reverse_orientation krobot in
- return { state with orientation = 180 }
- | false, true ->
- lwt _ =
- if state.orientation < 0 then
- Krobot.Motors.turn krobot ~angle:(-180 - state.orientation) ~velocity ~acceleration
- else
- Krobot.Motors.turn krobot ~angle:(180 - state.orientation) ~velocity ~acceleration
- in
- lwt () = reverse_orientation krobot in
- return { state with orientation = 0 }
- | false, false ->
- lwt _ =
- if state.orientation < 0 then
- Krobot.Motors.turn krobot ~angle:(-180 - state.orientation) ~velocity ~acceleration
- else
- Krobot.Motors.turn krobot ~angle:(180 - state.orientation) ~velocity ~acceleration
- in
- return { state with orientation = 180 }
- in
- lwt _ = Krobot.Motors.move krobot ~distance:100 ~velocity ~acceleration in
- lwt state, alpha, d = take_ear_simple krobot state ear in
- lwt _ = Krobot.Motors.move krobot ~distance:(-(d + 100)) ~velocity ~acceleration in
- lwt _ = Krobot.Motors.turn krobot ~angle:(-alpha) ~velocity ~acceleration in
- return state
-
-let take_straight krobot state ear =
- let d = distance state.position ear in
- let d' = d - 270 - 110 in
- let m = { vx = state.position.vx + (ear.vx - state.position.vx) * d' / d;
- vy = state.position.vy + (ear.vy - state.position.vy) * d' / d } in
- let angle, distance, state' = Krobot_move.move state m in
- lwt () =
- if angle <> 0 then
- lwt _ = Krobot.Motors.turn krobot ~angle ~velocity ~acceleration in
- return ()
- else
- return ()
- in
- lwt _ = Krobot.Motors.move krobot ~distance ~velocity ~acceleration in
- lwt state, alpha, d = take_ear_simple krobot state' ear in
- lwt _ = Krobot.Motors.move krobot ~distance:(-d) ~velocity ~acceleration ...
[truncated message content] |
