Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 7a4f8545c3cb92904815340be3fca2e044a8f6a8
|
From: Jérémie D. <Ba...@us...> - 2010-02-21 12:59:34
|
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 7a4f8545c3cb92904815340be3fca2e044a8f6a8 (commit)
from 57b3104ae0cceeee30a418c3ffe4da4f7ced6d11 (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 7a4f8545c3cb92904815340be3fca2e044a8f6a8
Author: Jérémie Dimino <je...@di...>
Date: Sun Feb 21 13:55:06 2010 +0100
rewrite Script and Controller
Controller: use more colors
Script: merge completion definitions and commands definitions
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/clients/controller.ml b/PC_Mainboard/clients/controller.ml
index 5d43d37..0b26109 100644
--- a/PC_Mainboard/clients/controller.ml
+++ b/PC_Mainboard/clients/controller.ml
@@ -9,7 +9,7 @@
(* Prints status continuously *)
-module Log = Lwt_log.Make(struct let section = "controller" end)
+module Log = Lwt_log.Make(struct let section = "" end)
open Lwt
open Lwt_term
@@ -17,188 +17,69 @@ open Lwt_read_line
module TextSet = Set.Make(Text)
+(* Maximum number of refresh by seconds: *)
+let refresh_rate = 10
+
(* +-----------------------------------------------------------------+
- | Drawing |
+ | Logging |
+-----------------------------------------------------------------+ *)
-(* Prevent concurrent drawing: *)
-let drawer_mutex = Lwt_mutex.create ()
+(* Maximum number of lines to keep in logs: *)
+let log_count = 16384
-(* Draw the whole screen *)
-let rec draw
- (size,
- (engine_state, box, logs),
- ((compass, logic_sensors, range_finders, team, jack),
- (inhibited_forward_until, inhibited_backward_until),
- (state_interface, state_sensor, state_motor))) =
- Lwt_mutex.with_lock drawer_mutex begin fun () ->
- lwt () = Lwt_main.fast_yield () in
- if Lwt_mutex.is_empty drawer_mutex then begin
- (* Redraw the screen only if there is no other thread waiting to
- do it *)
-
- let screen = Zone.make ~width:size.columns ~height:size.lines in
- let points = Zone.points screen in
-
- (* ===== Borders ===== *)
-
- for i = 1 to size.columns - 2 do
- points.(0).(i) <- { blank with char = "─" };
- points.(size.lines - 1).(i) <- { blank with char = "─" }
- done;
- for i = 1 to size.lines - 2 do
- points.(i).(0) <- { blank with char = "│" };
- points.(i).(size.columns - 1) <- { blank with char = "│" }
- done;
- points.(0).(0) <- { blank with char = "┌" };
- points.(size.lines - 1).(0) <- { blank with char = "└" };
- points.(size.lines - 1).(size.columns - 1) <- { blank with char = "┘" };
- points.(0).(size.columns - 1) <- { blank with char = "┐" };
-
- (* ===== Status ===== *)
-
- Draw.text screen 1 0 "─[ Range finders ]─┬─[ Logic Sensors ]─┬─[ Status ]─";
- points.(9).(0) <- { blank with char = "├" };
- points.(9).(size.columns - 1) <- { blank with char = "┤" };
- for i = 1 to size.columns - 2 do
- points.(9).(i) <- { blank with char = "─" }
- done;
- for i = 1 to 8 do
- points.(i).(20) <- { blank with char = "│" };
- points.(i).(40) <- { blank with char = "│" }
- done;
- Draw.text screen 1 9 "───────────────────┴───────────────────┴";
-
- let zone = Zone.inner screen in
- for i = 0 to Array.length range_finders - 1 do
- Draw.textf zone 0 i "%d : %d" i range_finders.(i)
- done;
- 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;
- let x = 40 in
- Draw.textf zone x 0 "team = %s" (match team with Krobot.Team_red -> "red" | Krobot.Team_green -> "green");
- Draw.textf zone x 1 "jack = %s" (if jack then "present" else "absent");
- Draw.textf zone x 2 "compass = %d" compass;
- let text_of_state name = function
- | `Absent -> [fg lred; textf "%s card is absent" name]
- | `Present -> [textf "%s card is present" name]
- in
- Draw.textc zone x 3 (text_of_state "interface" state_interface);
- Draw.textc zone x 4 (text_of_state "sensor" state_sensor);
- Draw.textc zone x 5 (text_of_state "motor" state_motor);
- let date = Unix.gettimeofday () in
- let string_of_motor_state until =
- if date < until then
- "inhibited"
+(* 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): ";
+ 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
- "OK"
- in
- Draw.textf zone x 6 "move forward: %s" (string_of_motor_state inhibited_forward_until);
- Draw.textf zone x 7 "move backward: %s" (string_of_motor_state inhibited_backward_until);
-
- (* ===== 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.text zone 0 y line;
- loop (y - 1) rest
- end
- in
- loop (Zone.height zone - 1) logs;
-
- (* ===== Read-line ===== *)
-
- points.(size.lines - 3).(0) <- { blank with char = "├" };
- points.(size.lines - 3).(size.columns - 1) <- { blank with char = "┤" };
- points.(size.lines - 5).(0) <- { blank with char = "├" };
- points.(size.lines - 5).(size.columns - 1) <- { blank with char = "┤" };
- for i = 1 to size.columns - 2 do
- points.(size.lines - 5).(i) <- { blank with char = "─" };
- points.(size.lines - 3).(i) <- { blank with char = "─" }
- done;
-
- let zone = Zone.sub ~zone:screen ~x:1 ~y:(size.lines - 4) ~width:(size.columns - 2) ~height:1 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
- | [] ->
- 20 + 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;
- ];
- 20 + 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 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.text zone i 0 "┬";
- Draw.text zone i 1 "│";
- Draw.text zone i 2 "┴";
- i + 1)
- words 0)
- end;
-
- Lwt_term.render (Zone.points screen)
- end else
- return ()
- end
+ 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 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 |
@@ -219,30 +100,6 @@ let () =
set_box (Terminal.Box_message "<backward search>"))
(React.S.map (fun state -> state.Engine.mode) engine_state)
-let logs, set_logs = React.S.create []
-let log_line line =
- let rec truncate n = function
- | [] ->
- []
- | line :: rest ->
- if n = 1024 then
- []
- else
- line :: truncate (n + 1) rest
- in
- set_logs (line :: truncate 1 (React.S.value logs))
-let log_lines lines =
- let rec truncate n = function
- | [] ->
- []
- | line :: rest ->
- if n = 1024 then
- []
- else
- line :: truncate (n + 1) rest
- in
- set_logs (List.rev lines @ truncate (List.length lines) (React.S.value logs))
-
let history_file_name =
Filename.concat (try Unix.getenv "HOME" with _ -> "") ".krobot-controller-history"
@@ -263,7 +120,7 @@ let rec loop krobot history =
let history = Lwt_read_line.add_entry line history in
set_engine_state (Engine.init history);
lwt () = Log.notice line in
- ignore (Script.exec krobot line);
+ ignore (Script.exec ~krobot ~logger:(fun line -> log_add_line line; return ()) ~command:line);
loop krobot history
end
| Command.Complete ->
@@ -277,76 +134,268 @@ let rec loop krobot history =
loop krobot history
(* +-----------------------------------------------------------------+
- | Entry point |
+ | Drawing |
+-----------------------------------------------------------------+ *)
-let rec copy_logs ic =
- lwt line = Lwt_io.read_line ic in
- log_line line;
- copy_logs ic
+(* Thread currently redrawing the screen: *)
+let renderer = ref (return ())
-let redirect_stderr () =
- 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));
- (* Logs to the log window: *)
- Lwt_log.default :=
- Lwt_log.make
- ~output:(fun level lines ->
- let buffer = Buffer.create 128 in
- let lines =
- List.map (fun line ->
- Buffer.clear buffer;
- Lwt_log.render ~buffer ~level ~message:line ~template:"$(date): $(message)";
- Buffer.contents buffer) lines
- in
- log_lines lines;
- return ())
- ~close:return
- ()
+(* 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 "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 = "│" }
+ done;
+ Draw.textc screen 1 9 [fg line_color; text "───────────────────┴───────────────────┴"];
+
+ let zone = Zone.inner screen in
+
+ let range_finders = React.S.value (Krobot.range_finders krobot) in
+ for i = 0 to Array.length range_finders - 1 do
+ Draw.textf zone 0 i "%d : %d" i range_finders.(i)
+ done;
+
+ let logic_sensors = React.S.value (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;
+ let x = 40 in
+
+ Draw.textf zone x 0 "team = %s" (match React.S.value (Krobot.team krobot) with
+ | Krobot.Team_red -> "red"
+ | Krobot.Team_green -> "green");
+ Draw.textf zone x 1 "jack = %s" (if React.S.value (Krobot.jack krobot) then "present" else "absent");
+ Draw.textf zone x 2 "compass = %d" (React.S.value (Krobot.compass krobot));
+ let text_of_state name = function
+ | `Absent -> [fg lred; textf "%s card is absent" name]
+ | `Present -> [textf "%s card is present" name]
+ in
+ Draw.textc zone x 3 (text_of_state "interface" (React.S.value (Krobot.Card.state krobot `Interface)));
+ Draw.textc zone x 4 (text_of_state "sensor" (React.S.value (Krobot.Card.state krobot `Sensor)));
+ Draw.textc zone x 5 (text_of_state "motor" (React.S.value (Krobot.Card.state krobot `Motor)));
+ 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
+ Draw.textc zone x 6 (text_of_motor_state "move forward: " (React.S.value (Krobot.inhibited_forward_until krobot)));
+ Draw.textc zone x 7 (text_of_motor_state "move backward: " (React.S.value (Krobot.inhibited_backward_until krobot)));
+
+ (* ===== 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
+ | [] ->
+ 20 + 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;
+ ];
+ 20 + 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.cancel !renderer;
+ renderer := 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_main.fast_yield () in
+ refresh_needed := false;
+ draw krobot;
+ return ()
+ end
+
+(* +-----------------------------------------------------------------+
+ | Entry point |
+ +-----------------------------------------------------------------+ *)
lwt () =
lwt () = Log.notice "connecting to the krobot bus..." in
lwt krobot = Krobot.create () in
- lwt () = save_state () in
- lwt () = hide_cursor () in
+
+ (* Put the terminal into drawing mode: *)
+ lwt () = Lwt_term.save_state () 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 () ->
- (* Dump logs on abnormal exit: *)
lwt () = restore_state () in
- Lwt_list.iter_s Lwt_io.printl (List.rev (React.S.value logs)))
+ Lwt_list.iter_s printlc (List.rev (React.S.value logs)))
Lwt_main.exit_hooks
in
- redirect_stderr ();
- let signal =
- React.S.map draw
- (React.S.l3 (fun a b c -> (a, b, c))
- Lwt_term.size
- (React.S.l3 (fun a b c -> (a, b, c))
- engine_state
- box
- logs)
- (Lwt_signal.limit (fun () -> Lwt_unix.sleep 0.1)
- (React.S.l3 (fun a b c -> (a, b, c))
- (React.S.l5 (fun a b c d e -> (a, b, c, d, e))
- (Krobot.compass krobot)
- (Krobot.logic_sensors krobot)
- (Krobot.range_finders krobot)
- (Krobot.team krobot)
- (Krobot.jack krobot))
- (React.S.l2 (fun a b -> (a, b))
- (Krobot.inhibited_forward_until krobot)
- (Krobot.inhibited_backward_until krobot))
- (React.S.l3 (fun a b c -> (a, b, c))
- (Krobot.Card.state krobot `Interface)
- (Krobot.Card.state krobot `Sensor)
- (Krobot.Card.state krobot `Motor)))))
+
+ (* Events that causes the display to be redrawn *)
+ let delay = 1.0 /. (float_of_int refresh_rate) in
+ let notify signal =
+ Lwt_signal.always_notify_p
+ (fun _ -> refresh krobot)
+ (Lwt_signal.limit (fun () -> Lwt_unix.sleep delay) signal)
+ and urgent signal =
+ Lwt_signal.always_notify_p
+ (fun _ -> refresh krobot)
+ signal
in
+ urgent Lwt_term.size;
+ urgent engine_state;
+ notify box;
+ notify logs;
+ notify (Krobot.compass krobot);
+ notify (Krobot.logic_sensors krobot);
+ notify (Krobot.range_finders krobot);
+ notify (Krobot.team krobot);
+ notify (Krobot.jack krobot);
+ notify (Krobot.inhibited_forward_until krobot);
+ notify (Krobot.inhibited_backward_until krobot);
+ notify (Krobot.Card.state krobot `Interface);
+ notify (Krobot.Card.state krobot `Sensor);
+ notify (Krobot.Card.state krobot `Motor);
+
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
- React.S.stop signal;
+
+ (* Normal exit, do not dump logs on stdout: *)
Lwt_sequence.remove node;
+
+ (* Leave drawing mode *)
restore_state ()
diff --git a/PC_Mainboard/clients/script.ml b/PC_Mainboard/clients/script.ml
index 73ff644..76c0099 100644
--- a/PC_Mainboard/clients/script.ml
+++ b/PC_Mainboard/clients/script.ml
@@ -7,93 +7,121 @@
* This file is a part of [kro]bot.
*)
-module Log = Lwt_log.Make(struct let section = "script" end)
-
open Lwt
+open Lwt_term
module TextSet = Set.Make(Text)
-type argument =
- | Arg_int
- | Arg_string
- | Arg_keyword of string list
+let set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
+
+(* +-----------------------------------------------------------------+
+ | Commands |
+ +-----------------------------------------------------------------+ *)
+
+type logger = Lwt_term.styled_text -> unit Lwt.t
+
+(* Type of an argument *)
+type arg_type =
+ | Int
+ | Keyword of string list
type command = {
- name : string;
- args : (string * argument) list;
+ c_name : string;
+ (* The command name *)
+
+ c_exec : (string * string) list -> logger -> Krobot.t -> unit Lwt.t;
+ (* The command implementation. It takes as argument the list of
+ parameters. *)
+
+ c_args : (string * arg_type) list;
+ (* Argument description, used for completion. *)
}
-let commands = [
- { name = "exit";
- args = [] };
- { name = "forward";
- args = [("dist", Arg_int); ("speed", Arg_int); ("acc", Arg_int)] };
- { name = "backward";
- args = [("dist", Arg_int); ("speed", Arg_int); ("acc", Arg_int)] };
- { name = "goto";
- args = [("x", Arg_int); ("y", Arg_int); ("speed", Arg_int); ("acc", Arg_int);
- ("mode", Arg_keyword ["straight"; "curve-left"; "curve-right"]);
- ("bypass-dist", Arg_int)] };
- { name = "left";
- args = [("angle", Arg_int); ("speed", Arg_int); ("acc", Arg_int)] };
- { name = "right";
- args = [("angle", Arg_int); ("speed", Arg_int); ("acc", Arg_int)] };
- { name = "stop-motors";
- args = [("motor", Arg_keyword ["left"; "right"; "both"]);
- ("mode", Arg_keyword ["off"; "abrupt"; "smooth"])] };
- { name = "set-speed";
- args = [("motor", Arg_keyword ["left"; "right"; "both"]);
- ("speed", Arg_int);
- ("acc", Arg_int)] };
- { name = "bootloader";
- args = [("card", Arg_keyword ["interface"; "sensor"; "motor"])] };
- { name = "reset";
- args = [("card", Arg_keyword ["interface"; "sensor"; "motor"])] };
- { name = "test";
- args = [("card", Arg_keyword ["interface"; "sensor"; "motor"])] };
- { name = "get-calibration";
- args = [] };
- { name = "calibration-start";
- args = [("range-finder", Arg_int); ("skip-meas", Arg_keyword ["true"; "false"])] };
- { name = "calibration-stop";
- args = [] };
- { name = "calibration-continue";
- args = [] };
- { name = "ax12-goto";
- args = [("id", Arg_int); ("pos", Arg_int); ("speed", Arg_int)] };
- { name = "ax12-ping";
- args = [("id", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-read8";
- args = [("id", Arg_int); ("reg", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-read16";
- args = [("id", Arg_int); ("reg", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-write8";
- args = [("id", Arg_int); ("reg", Arg_int); ("value", Arg_int)] };
- { name = "ax12-write16";
- args = [("id", Arg_int); ("reg", Arg_int); ("value", Arg_int)] };
- { name = "ax12-get-pos";
- args = [("id", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-get-speed";
- args = [("id", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-get-load";
- args = [("id", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-stats";
- args = [("id", Arg_int); ("timeout", Arg_int)] };
- { name = "ax12-write-reg8";
- args = [("id", Arg_int); ("reg", Arg_int); ("value", Arg_int)] };
- { name = "ax12-write-reg16";
- args = [("id", Arg_int); ("reg", Arg_int); ("value", Arg_int)] };
- { name = "ax12-action";
- args = [("id", Arg_int)] };
-]
+(* An argument description *)
+type 'a arg = {
+ a_type : arg_type;
+ a_name : string;
+ a_cast : string -> 'a;
+ a_default : 'a option;
+}
-let set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
+(* A function description *)
+type 'a func = {
+ f_args : (string * arg_type) list;
+ (* Arguments of the function, for completion *)
+
+ f_func : (string * string) list -> 'a -> unit Lwt.t;
+ (* [f_func args f] parses arguments [args] and apply them to [f] *)
+}
+
+(* All registred commands *)
+let commands = ref []
-let command_names =
- List.fold_left (fun acc command -> TextSet.add command.name acc) TextSet.empty commands
+(* Register a command *)
+let register name func f =
+ let command = {
+ c_name = name;
+ c_exec = (fun args logger krobot -> func.f_func args (f logger krobot));
+ c_args = func.f_args;
+ } in
+ commands := command :: !commands
+
+exception Argument_error of string
+ (* Exception raised when there is a problem with an argument *)
+
+let arg_error msg = raise (Argument_error msg)
+
+(* Returns the value associated to [key] if any, and the list without
+ the first occurence of [key] *)
+let rec assoc_remove key = function
+ | [] ->
+ (None, [])
+ | (key', value) :: rest when key = key' ->
+ (Some value, rest)
+ | pair :: rest ->
+ let result, l = assoc_remove key rest in
+ (result, pair :: l)
+
+let ( --> ) arg func = {
+ f_args = (arg.a_name, arg.a_type) :: func.f_args;
+ f_func =
+ fun args f ->
+ let result, args = assoc_remove arg.a_name args in
+ match result with
+ | Some str ->
+ func.f_func args (f (arg.a_cast str))
+ | None ->
+ match arg.a_default with
+ | Some value ->
+ func.f_func args (f value)
+ | None ->
+ Printf.ksprintf arg_error "argument '%s' is mandatory" arg.a_name
+}
+
+let f0 = {
+ f_args = [];
+ f_func =
+ fun args f ->
+ match args with
+ | [] ->
+ f
+ | (key, _) :: _ ->
+ Printf.ksprintf arg_error "unused argument '%s'" key
+}
+
+let f1 arg0 = arg0 --> f0
+let f2 arg0 arg1 = arg0 --> (f1 arg1)
+let f3 arg0 arg1 arg2 = arg0 --> (f2 arg1 arg2)
+let f4 arg0 arg1 arg2 arg3 = arg0 --> (f3 arg1 arg2 arg3)
+let f5 arg0 arg1 arg2 arg3 arg4 = arg0 --> (f4 arg1 arg2 arg3 arg4)
+let f6 arg0 arg1 arg2 arg3 arg4 arg5 = arg0 --> (f5 arg1 arg2 arg3 arg4 arg5)
+
+(* +-----------------------------------------------------------------+
+ | Completion |
+ +-----------------------------------------------------------------+ *)
let rec args_of_command command = function
- | { name = name; args = args } :: _ when name = command ->
+ | { c_name = name; c_args = args } :: _ when name = command ->
Some args
| _ :: rest ->
args_of_command command rest
@@ -102,11 +130,12 @@ let rec args_of_command command = function
let complete ~before ~after =
try
- match Script_lexer.command (Lexing.from_string before) with
+ match Script_lexer.partial_command (Lexing.from_string before) with
| `Command(before, name) ->
- Lwt_read_line.complete ~suffix:" " before name after command_names
+ Lwt_read_line.complete ~suffix:" " before name after
+ (set_of_list (List.map (fun command -> command.c_name) !commands))
| `Arg(before, name, args, `Key key) -> begin
- match args_of_command name commands with
+ match args_of_command name !commands with
| None ->
raise Exit
| Some args' ->
@@ -116,13 +145,13 @@ let complete ~before ~after =
Lwt_read_line.complete ~suffix:"=" before key after args
end
| `Arg(before, name, args, `Value(key, value)) -> begin
- match args_of_command name commands with
+ match args_of_command name !commands with
| None ->
raise Exit
| Some args' ->
try
match List.assoc key args' with
- | Arg_keyword words ->
+ | Keyword words ->
Lwt_read_line.complete ~suffix:" " before value after (set_of_list words)
| _ ->
raise Exit
@@ -135,153 +164,225 @@ let complete ~before ~after =
{ Lwt_read_line.comp_state = (before, after);
Lwt_read_line.comp_words = TextSet.empty }
-let motor_of_string = function
- | "both" -> `Both
- | "left" -> `Left
- | "right" -> `Right
- | _ -> failwith "Script.motor_of_strig: invalid motor"
+(* +-----------------------------------------------------------------+
+ | Execution |
+ +-----------------------------------------------------------------+ *)
+
+let exec ~krobot ~logger ~command =
+ match try `OK(Script_lexer.command (Lexing.from_string command)) with exn -> `Fail exn with
+ | `Fail(Script_lexer.Parse_failure msg) ->
+ logger [fg lred; textf "parse failure: %s" msg]
+ | `Fail exn ->
+ logger [fg lred; textf "parse failure: %s" (Printexc.to_string exn)]
+ | `OK(name, args) ->
+ try
+ let rec search = function
+ | [] ->
+ logger [fg lred; textf "unknown command '%s'" name]
+ | cmd :: rest when cmd.c_name <> name ->
+ search rest
+ | cmd :: _ ->
+ cmd.c_exec args logger krobot
+ in
+ search !commands
+ with
+ | Argument_error msg ->
+ logger [fg lred; textf "%s: %s" name msg]
+ | Failure msg ->
+ logger [fg lred; textf "command '%s' failed: %s" name msg]
+ | exn ->
+ logger [fg lred; textf "command '%s' failed with: %s" name (Printexc.to_string exn)]
-let move thread =
- thread >>= function
+(* +-----------------------------------------------------------------+
+ | Arguments |
+ +-----------------------------------------------------------------+ *)
+
+let int ?default name = {
+ a_name = name;
+ a_type = Int;
+ a_cast = (fun str ->
+ try
+ int_of_string str
+ with Failure _ ->
+ Printf.ksprintf arg_error "invalid value for argument '%s': an integer was expected" name);
+ a_default = default;
+}
+
+let keyword ?default name keywords = {
+ a_name = name;
+ a_type = Keyword(List.map fst keywords);
+ a_cast = (fun key ->
+ try
+ List.assoc key keywords
+ with Not_found ->
+ Printf.ksprintf arg_error "invalid value for '%s'" name);
+ a_default = default;
+}
+
+(* +-----------------------------------------------------------------+
+ | All commands |
+ +-----------------------------------------------------------------+ *)
+
+let () =
+ register "exit" f0
+ (fun logger -> exit 0);
+
+ (* +---------------------------------------------------------------+
+ | Movement |
+ +---------------------------------------------------------------+ *)
+
+ let dist = int ~default:100 "dist"
+ and angle = int ~default:90 "angle"
+ and speed = int ~default:400 "speed"
+ and acc = int ~default:800 "acc" in
+
+ let move_result logger = function
| `OK ->
- Log.notice "done"
+ logger [text "move completed"]
| `Stopped ->
- Log.notice "stopped"
-
-let exec krobot line =
- try_lwt
- let action, args = Script_lexer.whole_command (Lexing.from_string line) in
- let arg_int key default = try int_of_string (List.assoc key args) with Not_found -> default in
- let arg_string key default = try List.assoc key args with Not_found -> default in
- match action with
- | "forward" ->
- move (Krobot.move krobot ~dist:(arg_int "dist" 100) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800))
- | "backward" ->
- move (Krobot.move krobot ~dist:(-(arg_int "dist" 100)) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800))
- | "left" ->
- move (Krobot.turn krobot ~angle:(arg_int "angle" 100) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800))
- | "right" ->
- move (Krobot.turn krobot ~angle:(-(arg_int "angle" 100)) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800))
- | "goto" ->
- move (Krobot.goto krobot
- ~x:(arg_int "x" 0) ~y:(arg_int "y" 0) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800)
- ~mode:(match arg_string "mode" "straight" with
- | "straight" -> `Straight
- | "curve-left" -> `Curve_left
- | "curve-right" -> `Curve_right
- | _ -> failwith "Script.exec: invalid goto mode")
- ~bypass_dist:(arg_int "bypass-dist" 0))
- | "stop-motors" ->
- Krobot.stop_motors krobot
- ~motor:(motor_of_string (arg_string "motor" "both"))
- ~mode:(match arg_string "mode" "smooth" with
- | "off" -> `Off
- | "abrupt" -> `Abrupt
- | "smooth" -> `Smooth
- | _ -> failwith "Script.exec: invalid stop mode")
- | "set-speed" ->
- Krobot.set_speed krobot
- ~motor:(motor_of_string (arg_string "motor" "both"))
- ~speed:(arg_int "speed" 100)
- ~acc:(arg_int "acc" 800)
- | "bootloader" ->
- Krobot.Card.bootloader krobot
- (match arg_string "card" "" with
- | "interface" -> `Interface
- | "motor" -> `Motor
- | "sensor" -> `Sensor
- | _ -> failwith "Script.exec: invalid card")
- | "reset" ->
- Krobot.Card.reset krobot
- (match arg_string "card" "" with
- | "interface" -> `Interface
- | "motor" -> `Motor
- | "sensor" -> `Sensor
- | _ -> failwith "Script.exec: invalid card")
- | "test" ->
- Krobot.Card.test krobot
- (match arg_string "card" "" with
- | "interface" -> `Interface
- | "motor" -> `Motor
- | "sensor" -> `Sensor
- | _ -> failwith "Script.exec: invalid card")
- | "get-calibration" ->
- lwt l = Lwt_list.map_p (Krobot.get_calibration krobot) [0; 1; 2; 3; 4; 5; 6; 7] in
- let buffer = Buffer.create 1024 in
- let _ =
- List.fold_left
- (fun i cal ->
- Printf.bprintf buffer "calibration[%d]:" i;
- for i = 0 to Array.length cal - 1 do
- Printf.bprintf buffer " %d" cal.(i)
- done;
- Buffer.add_char buffer '\n';
- (i + 1))
- 0 l
- in
- Log.notice (Buffer.contents buffer)
- | "calibration-start" ->
- Krobot.calibration_start krobot (arg_int "range-finder" 0)
- (match arg_string "skip-meas" "false" with
- | "true" -> true
- | "false" -> false
- | _ -> raise (Failure "invalid boolean value"))
- | "calibration-continue" ->
- Krobot.calibration_continue krobot
- | "calibration-stop" ->
- Krobot.calibration_stop krobot
- | "ax12-goto" ->
- Krobot.AX12.goto krobot ~id:(arg_int "id" 0) ~pos:(arg_int "pos" 0) ~speed:(arg_int "speed" 0)
- | "ax12-ping" ->
- lwt n = Krobot.AX12.ping krobot ~id:(arg_int "id" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 ping result: %d" n
- | "ax12-read8" ->
- lwt n = Krobot.AX12.read8 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 read8 result: %d" n
- | "ax12-read16" ->
- lwt n = Krobot.AX12.read16 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 read16 result: %d" n
- | "ax12-write8" ->
- Krobot.AX12.write8 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~value:(arg_int "value" 0)
- | "ax12-write16" ->
- Krobot.AX12.write16 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~value:(arg_int "value" 0)
- | "ax12-get-pos" ->
- lwt n = Krobot.AX12.get_pos krobot ~id:(arg_int "id" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 position: %d" n
- | "ax12-get-speed" ->
- lwt n = Krobot.AX12.get_speed krobot ~id:(arg_int "id" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 speed: %d" n
- | "ax12-get-load" ->
- lwt n = Krobot.AX12.get_load krobot ~id:(arg_int "id" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 load: %d" n
- | "ax12-stats" ->
- lwt stats = Krobot.AX12.stats krobot ~id:(arg_int "id" 0) ~timeout:(arg_int "timeout" 100) in
- Log.notice_f "ax12 position = %d\n\
- ax12 speed = %d\n\
- ax12 torque = %d\n\
- ax12 voltage = %d\n\
- ax12 temperature = %d\n\
- ax12 cw-angle-limit = %d\n\
- ax12 ccw-angle-limit = %d\n"
- stats.Types.ax12_position
- stats.Types.ax12_speed
- stats.Types.ax12_torque
- stats.Types.ax12_voltage
- stats.Types.ax12_temperature
- stats.Types.ax12_cw_angle_limit
- stats.Types.ax12_ccw_angle_limit
- | "ax12-write-reg8" ->
- Krobot.AX12.write_reg8 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~value:(arg_int "value" 0)
- | "ax12-write-reg16" ->
- Krobot.AX12.write_reg16 krobot ~id:(arg_int "id" 0) ~reg:(arg_int "reg" 0) ~value:(arg_int "value" 0)
- | "ax12-action" ->
- Krobot.AX12.action krobot ~id:(arg_int "id" 0)
- | _ ->
- Log.error_f "unknown command %S" action
- with
- | Script_lexer.Parse_failure msg ->
- Log.error_f "parse failure: %s" msg
- | Failure msg ->
- Log.error_f "command failed: %s" msg
- | exn ->
- Log.exn exn "command failed with"
+ logger [fg lyellow; text "move stopped"]
+ in
+
+ register "forward" (f3 dist speed acc)
+ (fun logger krobot dist speed acc ->
+ Krobot.move krobot dist speed acc >>= move_result logger);
+ register "backward" (f3 dist speed acc)
+ (fun logger krobot dist speed acc ->
+ Krobot.move krobot (-dist) speed acc >>= move_result logger);
+ register "left" (f3 angle speed acc)
+ (fun logger krobot angle speed acc ->
+ Krobot.turn krobot angle speed acc >>= move_result logger);
+ register "right" (f3 angle speed acc)
+ (fun logger krobot angle speed acc ->
+ Krobot.turn krobot (-angle) speed acc >>= move_result logger);
+ register "goto" (f6
+ (int ~default:0 "x") (int ~default:0 "y") speed acc
+ (keyword ~default:`Straight "mode" [("straight", `Straight);
+ ("curve-left", `Curve_left);
+ ("curve-right", `Curve_right)])
+ (int ~default:0 "bypass-dist"))
+ (fun logger krobot x y speed acc mode bypass ->
+ Krobot.goto krobot x y speed acc mode bypass >>= move_result logger);
+
+ (* +---------------------------------------------------------------+
+ | Motors low-level conrol |
+ +---------------------------------------------------------------+ *)
+
+ let motor = keyword ~default:`Both "motor"
+ [("left", `Left); ("right", `Right); ("both", `Both)]
+ and stop_mode = keyword ~default:`Smooth "stop-mode"
+ [("off", `Off); ("abrupt", `Abrupt); ("smooth", `Smooth)] in
+
+ register "stop-motors" (f2 motor stop_mode)
+ (fun logger krobot motor mode -> Krobot.stop_motors krobot ~motor ~mode);
+ register "set-speed" (f3 motor speed acc)
+ (fun logger krobot motor speed acc -> Krobot.set_speed krobot ~motor ~speed ~acc);
+
+ (* +---------------------------------------------------------------+
+ | Cards control |
+ +---------------------------------------------------------------+ *)
+
+ let card = keyword "card" [("interface", `Interface);
+ ("motor", `Motor);
+ ("sensor", `Sensor)] in
+
+ register "bootloader" (f1 card)
+ (fun logger -> Krobot.Card.bootloader);
+ register "reset" (f1 card)
+ (fun logger -> Krobot.Card.reset);
+ register "test" (f1 card)
+ (fun logger -> Krobot.Card.test);
+
+ (* +---------------------------------------------------------------+
+ | Range finders |
+ +---------------------------------------------------------------+ *)
+
+ register "get-calibration" f0
+ (fun logger krobot ->
+ lwt cals = Lwt_list.map_p (Krobot.get_calibration krobot) [0; 1; 2; 3; 4; 5; 6; 7] in
+ let rec loop i = function
+ | [] ->
+ return ()
+ | cal :: rest ->
+ let buffer = Buffer.create 42 in
+ Printf.bprintf buffer "calibration[%d]:" i;
+ for i = 0 to Array.length cal - 1 do
+ Printf.bprintf buffer " %d" cal.(i)
+ done;
+ lwt () = logger [text (Buffer.contents buffer)] in
+ loop (i + 1) rest
+ in
+ loop 0 cals);
+
+ register "calibration-start" (f2 (int "range-finder") (keyword "skip-meas" [("true", true); ("false", false)]))
+ (fun logger -> Krobot.calibration_start);
+ register "calibartion-stop" f0
+ (fun logger -> Krobot.calibration_stop);
+ register "calibartion-continue" f0
+ (fun logger -> Krobot.calibration_continue);
+
+ (* +---------------------------------------------------------------+
+ | AX12 |
+ +---------------------------------------------------------------+ *)
+
+ let id = int "id"
+ and pos = int "pos"
+ and speed = int ~default:50 "speed"
+ and timeout = int ~default:100 "timeout"
+ and reg = int "reg"
+ and value = int "value" in
+
+ register "ax12-goto" (f3 id pos speed)
+ (fun logger krobot id pos speed ->
+ Krobot.AX12.goto krobot id pos speed);
+ register "ax12-ping" (f2 id timeout)
+ (fun logger krobot id timeout ->
+ Krobot.AX12.ping krobot id timeout >>= function
+ | 0 -> logger [textf "ax12-ping[%d] reply: " id; fg lred; text "timeout"]
+ | _ -> logger [textf "ax12-ping[%d] reply: " id; fg lgreen; text "success"]);
+ register "ax12-read8" (f3 id reg timeout)
+ (fun logger krobot id reg timeout ->
+ lwt x = Krobot.AX12.read8 krobot id reg timeout in
+ logger [textf "ax12-read8[%d] reply: %d" id x]);
+ register "ax12-read16" (f3 id reg timeout)
+ (fun logger krobot id reg timeout ->
+ lwt x = Krobot.AX12.read16 krobot id reg timeout in
+ logger [textf "ax12-read16[%d] reply: %d" id x]);
+ register "ax12-write8" (f3 id reg value)
+ (fun logger krobot id reg value ->
+ Krobot.AX12.write8 krobot id reg value);
+ register "ax12-write16" (f3 id reg value)
+ (fun logger krobot id reg value ->
+ Krobot.AX12.write16 krobot id reg value);
+ register "ax12-get-pos" (f2 id timeout)
+ (fun logger krobot id timeout ->
+ lwt x = Krobot.AX12.get_pos krobot id timeout in
+ logger [textf "ax12-position[%d]: %d" id x]);
+ register "ax12-get-speed" (f2 id timeout)
+ (fun logger krobot id timeout ->
+ lwt x = Krobot.AX12.get_speed krobot id timeout in
+ logger [textf "ax12-speed[%d]: %d" id x]);
+ register "ax12-get-load" (f2 id timeout)
+ (fun logger krobot id timeout ->
+ lwt x = Krobot.AX12.get_load krobot id timeout in
+ logger [textf "ax12-load[%d]: %d" id x]);
+ register "ax12-stats" (f2 id timeout)
+ (fun logger krobot id timeout ->
+ lwt stats = Krobot.AX12.stats krobot id timeout in
+ lwt () = logger [textf "ax12[%d] position = %d" id stats.Types.ax12_position] in
+ lwt () = logger [textf "ax12[%d] speed = %d" id stats.Types.ax12_speed] in
+ lwt () = logger [textf "ax12[%d] torque = %d" id stats.Types.ax12_torque] in
+ lwt () = logger [textf "ax12[%d] voltage = %d" id stats.Types.ax12_voltage] in
+ lwt () = logger [textf "ax12[%d] temperature = %d" id stats.Types.ax12_temperature] in
+ lwt () = logger [textf "ax12[%d] cw-angle-limit = %d" id stats.Types.ax12_cw_angle_limit] in
+ lwt () = logger [textf "ax12[%d] ccw-angle-limit = %d" id stats.Types.ax12_ccw_angle_limit] in
+ return ());
+ register "ax12-write-reg8" (f3 id reg value)
+ (fun logger krobot id reg value ->
+ Krobot.AX12.write_reg8 krobot id reg value);
+ register "ax12-write-reg16" (f3 id reg value)
+ (fun logger krobot id reg value ->
+ Krobot.AX12.write_reg16 krobot id reg value);
+ register "ax12-action" (f1 (int ~default:254 "id"))
+ (fun logger krobot id ->
+ Krobot.AX12.action krobot id)
diff --git a/PC_Mainboard/clients/script.mli b/PC_Mainboard/clients/script.mli
index 69d7d98..48dbbda 100644
--- a/PC_Mainboard/clients/script.mli
+++ b/PC_Mainboard/clients/script.mli
@@ -9,23 +9,12 @@
(** Minit script language for the monitor *)
-(** Type of arguments *)
-type argument =
- | Arg_int
- | Arg_string
- | Arg_keyword of string list
-
-(** Type of a command description *)
-type command = {
- name : string;
- args : (string * argument) list;
-}
-
-val commands : command list
- (** The list of all commands *)
-
val complete : before : string -> after : string -> Lwt_read_line.completion_result
(** [complete ~before ~after] try to complete the given string *)
-val exec : Krobot.t -> string -> unit Lwt.t
- (** [exec krobot str] parses [str] and execute it *)
+val exec :
+ krobot : Krobot.t ->
+ logger : (Lwt_term.styled_text -> unit Lwt.t) ->
+ command : string -> unit Lwt.t
+ (** [exec ~krobot ~logger ~command] parses [command] and execute
+ it. The result is logged with [logger]. *)
diff --git a/PC_Mainboard/clients/script_lexer.mll b/PC_Mainboard/clients/script_lexer.mll
index 00676ce..46d64fc 100644
--- a/PC_Mainboard/clients/script_lexer.mll
+++ b/PC_Mainboard/clients/script_lexer.mll
@@ -32,18 +32,18 @@ let maybe_ident = "" | ident
let value = (alpha | digit | "-")+
-rule command = parse
+rule partial_command = parse
| blank* as before (maybe_ident as id) eof
{ `Command(before, id) }
| blank* (ident as command) as s
{ let buf = Buffer.create 42 in
Buffer.add_string buf s;
- let args, last = arguments buf lexbuf in
+ let args, last = partial_arguments buf lexbuf in
`Arg(Buffer.contents buf, command, args, last) }
| ""
{ raise (Parse_failure "command expceted") }
-and arguments buf = parse
+and partial_arguments buf = parse
| (blank+ as before) (maybe_ident as key) eof
{ Buffer.add_string buf before;
(TextSet.empty, `Key key) }
@@ -52,19 +52,20 @@ and arguments buf = parse
(TextSet.empty, `Value(key, value)) }
| blank+ (ident as key) blank* "=" blank* value as s
{ Buffer.add_string buf s;
- let set, x = arguments buf lexbuf in
+ let set, x = partial_arguments buf lexbuf in
(TextSet.add key set, x) }
| ""
{ (TextSet.empty, `Nothing) }
-and whole_command = parse
+and command = parse
| blank* (ident as command)
- { (command, whole_arguments lexbuf) }
+ { (command, arguments lexbuf) }
| ""
{ raise (Parse_failure "command expceted") }
-and whole_arguments = parse
+and arguments = parse
| blank+ (ident as key) blank* "=" blank* (value as value)
- { (key, value) :: whole_arguments lexbuf }
+ { (key, value) :: arguments lexbuf }
| blank* eof
{ [] }
+ | "" { raise (Parse_failure "syntax error") }
hooks/post-receive
--
krobot
|
