Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 817f11427cf4305cb7ee66ab1a248473c89e2992
|
From: Jérémie D. <Ba...@us...> - 2010-02-03 07:24:09
|
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 817f11427cf4305cb7ee66ab1a248473c89e2992 (commit)
from 317345f5f4277633b9600b366d2150d59cfcdfca (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 817f11427cf4305cb7ee66ab1a248473c89e2992
Author: Jérémie Dimino <je...@di...>
Date: Wed Feb 3 08:23:27 2010 +0100
rewrite completion stuff for the monitor
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/clients/_tags b/PC_Mainboard/clients/_tags
index f829506..a232f9b 100644
--- a/PC_Mainboard/clients/_tags
+++ b/PC_Mainboard/clients/_tags
@@ -1,7 +1,7 @@
# -*- conf -*-
# Syntax extensions
-<**/*.ml>: syntax_camlp4o, pkg_camlp4, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_text.pcre
+<**/*.ml>: syntax_camlp4o, pkg_camlp4, pkg_lwt.syntax, pkg_lwt.syntax.log
<lib-krobot/*.ml>: pkg_obus.syntax
# Needed by the rest of the source
diff --git a/PC_Mainboard/clients/lib-krobot/krobot.ml b/PC_Mainboard/clients/lib-krobot/krobot.ml
index 020fc0f..05ef14d 100644
--- a/PC_Mainboard/clients/lib-krobot/krobot.ml
+++ b/PC_Mainboard/clients/lib-krobot/krobot.ml
@@ -190,9 +190,20 @@ include MakeDevice(struct let name = "Motors" end)
OP_method Turn : int -> int -> int -> unit
OP_method Move : int -> int -> int -> unit
+OP_method StopMotors : int -> int -> unit
let turn krobot ~angle ~speed ~acc = turn krobot angle speed acc
let move krobot ~dist ~speed ~acc = turn krobot dist speed acc
+let stop_motors krobot ~motor ~mode =
+ stop_motors krobot
+ (match motor with
+ | `Left -> -1
+ | `Both -> 0
+ | `Right -> 1)
+ (match mode with
+ | `Off -> 0
+ | `Abrupt -> 1
+ | `Smooth -> 2)
(* +-----------------------------------------------------------------+
| Cards |
diff --git a/PC_Mainboard/clients/lib-krobot/krobot.mli b/PC_Mainboard/clients/lib-krobot/krobot.mli
index 546751e..cf75746 100644
--- a/PC_Mainboard/clients/lib-krobot/krobot.mli
+++ b/PC_Mainboard/clients/lib-krobot/krobot.mli
@@ -71,6 +71,9 @@ val close_grip : t -> unit Lwt.t
val turn : t -> angle : int -> speed : int -> acc : int -> unit Lwt.t
val move : t -> dist : int -> speed : int -> acc : int -> unit Lwt.t
+val stop_motors : t -> motor : [ `Left | `Right | `Both ] -> mode : [ `Off | `Abrupt | `Smooth ] -> unit Lwt.t
+ (** [stop_motorw t motor mode] stop the given motor(s). *)
+
(** {6 Cards} *)
module Card : sig
diff --git a/PC_Mainboard/clients/tools/monitor.ml b/PC_Mainboard/clients/tools/monitor.ml
index 0cf506b..7c6e0c3 100644
--- a/PC_Mainboard/clients/tools/monitor.ml
+++ b/PC_Mainboard/clients/tools/monitor.ml
@@ -220,73 +220,17 @@ let rec draw size (compass, logic_sensors, range_finders, team, jack) (engine_st
end
(* +-----------------------------------------------------------------+
- | Actions |
- +-----------------------------------------------------------------+ *)
-
-let handle_action krobot line =
- match Text.words line with
- | [] ->
- return ()
- | action :: args ->
- let rec make_args acc = function
- | [] | [_] ->
- acc
- | key :: value :: rest ->
- make_args ((key, value) :: acc) rest
- in
- let args = make_args [] args in
- let arg key default = try int_of_string (List.assoc key args) with Not_found -> default in
- match action with
- | "forward" ->
- Krobot.move krobot ~dist:(arg "dist" 100) ~speed:(arg "speed" 400) ?acc:(arg "acc" 800)
- | "backward" ->
- Krobot.move krobot ~dist:(-(arg "dist" 100)) ~speed:(arg "speed" 400) ?acc:(arg "acc" 800)
- | "left" ->
- Krobot.turn krobot ~angle:(arg "dist" 100) ~speed:(arg "speed" 400) ?acc:(arg "acc" 800)
- | "right" ->
- Krobot.turn krobot ~angle:(-(arg "dist" 100)) ~speed:(arg "speed" 400) ?acc:(arg "acc" 800)
- | _ ->
- 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 set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
-
-let functions = set_of_list [
- "exit";
- "forward";
- "backward";
- "left";
- "right";
-]
-
-let argument = <:re< alpha+ blank* "=" blank* alnum+ >>
-
-let complete before after =
- match before with
- | <:re< (blank* as before) (alpha* as word) eos >> ->
- Lwt_read_line.complete ~suffix:" " before word after functions
- | <:re< (blank* (alpha+ as action) (blank+ argument)* blank+ as before) (alpha* as arg) eos >> ->
- Lwt_read_line.complete ~suffix:"=" before arg after
- (set_of_list
- (match action with
- | "forward" | "backward" -> ["dist"; "speed"; "acc"]
- | "right" | "left" -> ["angle"; "speed"; "acc"]
- | _ -> []))
- | _ ->
- { comp_state = (before, after);
- comp_words = TextSet.empty }
-
let () =
Lwt_signal.always_notify
(function
| Engine.Edition(before, after) ->
- let comp = complete before after in
+ let comp = Script.complete before after in
set_box (Terminal.Box_words(comp.comp_words, 0))
| Engine.Selection _ ->
set_box (Terminal.Box_message "<selection>")
@@ -310,13 +254,13 @@ let rec loop krobot history =
let history = Lwt_read_line.add_entry line history in
set_engine_state (Engine.init history);
set_logs (line :: React.S.value logs);
- ignore (handle_action krobot line);
+ ignore (Script.exec krobot line);
loop krobot history
end
| Command.Complete ->
let engine_state = Engine.reset (React.S.value engine_state) in
let before, after = Engine.edition_state engine_state in
- let comp = complete before after 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 ->
diff --git a/PC_Mainboard/clients/tools/script.ml b/PC_Mainboard/clients/tools/script.ml
new file mode 100644
index 0000000..1bb167a
--- /dev/null
+++ b/PC_Mainboard/clients/tools/script.ml
@@ -0,0 +1,125 @@
+(*
+ * script.ml
+ * ---------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+open Lwt
+
+module TextSet = Set.Make(Text)
+
+type argument =
+ | Arg_int
+ | Arg_string
+ | Arg_keyword of string list
+
+type command = {
+ name : string;
+ args : (string * argument) list;
+}
+
+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 = "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"])] };
+]
+
+let set_of_list l = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty l
+
+let command_names =
+ List.fold_left (fun acc command -> TextSet.add command.name acc) TextSet.empty commands
+
+let rec args_of_command command = function
+ | { name = name; args = args } :: _ when name = command ->
+ Some args
+ | _ :: rest ->
+ args_of_command command rest
+ | [] ->
+ None
+
+let complete ~before ~after =
+ try
+ match Script_lexer.command (Lexing.from_string before) with
+ | `Command(before, name) ->
+ Lwt_read_line.complete ~suffix:" " before name after command_names
+ | `Arg(before, name, args, `Key key) -> begin
+ match args_of_command name commands with
+ | None ->
+ raise Exit
+ | Some args' ->
+ let args' = set_of_list (List.map fst args') in
+ (* Remove already passed arguments *)
+ let args = TextSet.diff args' args in
+ 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
+ | None ->
+ raise Exit
+ | Some args' ->
+ try
+ match List.assoc key args' with
+ | Arg_keyword words ->
+ Lwt_read_line.complete ~suffix:" " before value after (set_of_list words)
+ | _ ->
+ raise Exit
+ with Not_found ->
+ raise Exit
+ end
+ | `Arg(before, name, args, `Nothing) ->
+ raise Exit
+ with Exit ->
+ { Lwt_read_line.comp_state = (before, after);
+ Lwt_read_line.comp_words = TextSet.empty }
+
+let exec krobot line =
+ match Text.words line with
+ | [] ->
+ return ()
+ | action :: args ->
+ let rec make_args acc = function
+ | [] | [_] ->
+ acc
+ | key :: value :: rest ->
+ make_args ((key, value) :: acc) rest
+ in
+ let args = make_args [] args 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" ->
+ Krobot.move krobot ~dist:(arg_int "dist" 100) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800)
+ | "backward" ->
+ Krobot.move krobot ~dist:(-(arg_int "dist" 100)) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800)
+ | "left" ->
+ Krobot.turn krobot ~angle:(arg_int "dist" 100) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800)
+ | "right" ->
+ Krobot.turn krobot ~angle:(-(arg_int "dist" 100)) ~speed:(arg_int "speed" 400) ?acc:(arg_int "acc" 800)
+ | "stop-motors" ->
+ Krobot.stop_motors krobot
+ ~motor:(match arg_string "motor" "both" with
+ | "both" -> `Both
+ | "left" -> `Left
+ | "right" -> `Right
+ | _ -> failwith "Script.exec: invalid motor")
+ ~mode:(match arg_string "mode" "off" with
+ | "off" -> `Off
+ | "abrupt" -> `Abrupt
+ | "smooth" -> `Smooth
+ | _ -> failwith "Script.exec: invalid stop mode")
+ | _ ->
+ return ()
+
diff --git a/PC_Mainboard/clients/tools/script.mli b/PC_Mainboard/clients/tools/script.mli
new file mode 100644
index 0000000..69d7d98
--- /dev/null
+++ b/PC_Mainboard/clients/tools/script.mli
@@ -0,0 +1,31 @@
+(*
+ * script.mli
+ * ----------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+(** 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 *)
diff --git a/PC_Mainboard/clients/tools/script_lexer.mll b/PC_Mainboard/clients/tools/script_lexer.mll
new file mode 100644
index 0000000..fea99ef
--- /dev/null
+++ b/PC_Mainboard/clients/tools/script_lexer.mll
@@ -0,0 +1,58 @@
+(*
+ * script_lexer.mll
+ * ----------------
+ * Copyright : (c) 2010, Jeremie Dimino <je...@di...>
+ * Licence : BSD3
+ *
+ * This file is a part of [kro]bot.
+ *)
+
+{
+ module TextSet = Set.Make(Text)
+}
+
+
+let lower = ['a'-'z']
+let upper = ['A'-'Z']
+let alpha = lower | upper
+let digit = ['0'-'9']
+let alnum = alpha | digit
+let punct = ['!' '"' '#' '$' '%' '&' '\'' '(' ')' '*' '+' ',' '-' '.' '/' ':' ';' '<' '=' '>' '?' '@' '[' '\\' ']' '^' '_' '`' '{' '|' '}' '~']
+let graph = alnum | punct
+let print = graph | ' '
+let blank = ' ' | '\t'
+let cntrl = ['\x00'-'\x1F' '\x7F']
+let xdigit = digit | ['a'-'f' 'A'-'F']
+let space = blank | ['\n' '\x0b' '\x0c' '\r']
+
+let identstart = [ 'A'-'Z' 'a'-'z' '_' ]
+let identbody = [ 'A'-'Z' 'a'-'z' '_' '-' '\'' '0' - '9' ]
+let ident = identstart identbody*
+let maybe_ident = "" | ident
+
+let value = (alpha | digit | "-")+
+
+rule 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
+ `Arg(Buffer.contents buf, command, args, last) }
+ | ""
+ { raise Exit }
+
+and arguments buf = parse
+ | (blank+ as before) (maybe_ident as key) eof
+ { Buffer.add_string buf before;
+ (TextSet.empty, `Key key) }
+ | (blank+ (ident as key) blank* "=" blank* as before) ((value | "") as value) eof
+ { Buffer.add_string buf before;
+ (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
+ (TextSet.add key set, x) }
+ | ""
+ { (TextSet.empty, `Nothing) }
diff --git a/PC_Mainboard/driver/src/driver.ml b/PC_Mainboard/driver/src/driver.ml
index b3287cc..17b5236 100644
--- a/PC_Mainboard/driver/src/driver.ml
+++ b/PC_Mainboard/driver/src/driver.ml
@@ -401,6 +401,21 @@ struct
else
move Protocol.traj_forward dev.card dist speed acc
+ let stop_motors dev motor mode =
+ let data = String.create 4 in
+ RW.set_uint8 data 0 Protocol.traj_stop;
+ RW.set_uint8 data 1 (match motor with
+ | -1 -> Protocol.motor_left
+ | 0 -> Protocol.motor_both
+ | 1 -> Protocol.motor_right
+ | n -> Printf.ksprintf failwith "invalid motor (%d)" n);
+ RW.set_uint16 data 2 (match mode with
+ | 0 -> Protocol.traj_stop_motor_off
+ | 1 -> Protocol.traj_stop_abrupt
+ | 2 -> Protocol.traj_stop_smooth
+ | n -> Printf.ksprintf failwith "invalid stop mode (%d)" n);
+ Card.send_command dev.card Protocol.cmd_traj data
+
OL_method Turn : int -> int -> int -> unit
OL_method Move : int -> int -> int -> unit
@@ -468,12 +483,12 @@ struct
OL_method GetFirmwareBuild : string = fun card ->
let data = Card.make_buffer () in
RW.set_uint8 data 0 Protocol.get_firmware_build;
- Card.send_request card Protocol.cmd_get data >|= string_of_azt
+ Card.send_request card.card Protocol.cmd_get data >|= string_of_azt
OL_method GetBoardInfo : string = fun card ->
let data = Card.make_buffer () in
RW.set_uint8 data 0 Protocol.get_board_info;
- Card.send_request card Protocol.cmd_get data >|= string_of_azt
+ Card.send_request card.card Protocol.cmd_get data >|= string_of_azt
OL_method GetState : Card.state = fun card ->
return (React.S.value (Card.state card.card))
hooks/post-receive
--
krobot
|
