From: Jérémie D. <Ba...@us...> - 2010-02-23 14:54:54
|
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 c6ca4d9dab2c4646c8d8e0b5bb9670fb30a3b8af (commit) from c07439dbd3a468aa4347ee5c03fa9905637426d1 (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 c6ca4d9dab2c4646c8d8e0b5bb9670fb30a3b8af Author: Jérémie Dimino <je...@di...> Date: Tue Feb 23 15:53:59 2010 +0100 [driver] rewrite of the motor section Better support of switching between manual and trajextory mode. ----------------------------------------------------------------------- Changes: diff --git a/PC_Mainboard/clients/joy_control.ml b/PC_Mainboard/clients/joy_control.ml index 45bd28f..ac6b39a 100644 --- a/PC_Mainboard/clients/joy_control.ml +++ b/PC_Mainboard/clients/joy_control.ml @@ -129,6 +129,7 @@ let child_loop pipe joy = let axis_coef = 6 let axis_coef_turn = 4 let accelerations = (800, 800) +let duration = 0.2 let try_call action f = try_lwt @@ -141,12 +142,12 @@ let rec set_velocities krobot velocities = lwt () = try_call "set-velocities" (fun () -> - Krobot.set_velocities krobot ~velocities ~accelerations) + Krobot.set_velocities krobot ~velocities ~accelerations ~duration) in if velocities = (0, 0) then return () else begin - lwt () = Lwt_unix.sleep (Config.stop_motors_delay /. 2.) in + lwt () = Lwt_unix.sleep (duration /. 2.) in set_velocities krobot velocities end @@ -187,7 +188,7 @@ let parent_loop krobot pipe = | JoyButtonPressed ButtonSquare -> stop := true; cancel !thread; - lwt () = try_call "stop-motors" (fun () -> Krobot.stop_motors krobot ~motor:`Both ~mode:`Abrupt) in + lwt () = try_call "stop-motors" (fun () -> Krobot.stop_motors krobot ~mode:`Abrupt) in loop () | JoyButtonReleased ButtonSquare -> stop := false; diff --git a/PC_Mainboard/clients/script.ml b/PC_Mainboard/clients/script.ml index 3c08ab6..2ee3211 100644 --- a/PC_Mainboard/clients/script.ml +++ b/PC_Mainboard/clients/script.ml @@ -196,20 +196,21 @@ let () = | Motors low-level conrol | +---------------------------------------------------------------+ *) - let motor = keyword ~default:`Both "motor" - [("left", `Left); ("right", `Right); ("both", `Both)] - and stop_mode = keyword ~default:`Smooth "stop-mode" + let stop_mode = keyword ~default:`Smooth "stop-mode" [("off", `Off); ("abrupt", `Abrupt); ("smooth", `Smooth)] + and duration = float ~default:1.0 "duration" and velocity motor = int ~default:400 ("velocity" ^ motor) and acceleration motor = int ~default:800 ("acceleration" ^ motor) in - register "stop-motors" (f2 motor stop_mode) - (fun logger krobot motor mode -> Krobot.stop_motors krobot ~motor ~mode); - register "set-velocity" (f3 motor (velocity "") (acceleration "")) - (fun logger krobot motor velocity acceleration -> Krobot.set_velocity krobot ~motor ~velocity ~acceleration); - register "set-velocities" (f4 (velocity "-left") (velocity "-right") (acceleration "-left") (acceleration "-right")) - (fun logger krobot velocity_left velocity_right acceleration_left acceleration_right -> - Krobot.set_velocities krobot ~velocities:(velocity_left, velocity_right) ~accelerations:(acceleration_left, acceleration_right)); + register "stop-motors" (f1 stop_mode) + (fun logger krobot mode -> + Krobot.stop_motors krobot ~mode); + register "set-velocities" (f5 (velocity "-left") (velocity "-right") (acceleration "-left") (acceleration "-right") duration) + (fun logger krobot velocity_left velocity_right acceleration_left acceleration_right duration -> + Krobot.set_velocities krobot + ~velocities:(velocity_left, velocity_right) + ~accelerations:(acceleration_left, acceleration_right) + ~duration); (* +---------------------------------------------------------------+ | Cards control | diff --git a/PC_Mainboard/clients/script_commands.ml b/PC_Mainboard/clients/script_commands.ml index 9cddb97..b7369a4 100644 --- a/PC_Mainboard/clients/script_commands.ml +++ b/PC_Mainboard/clients/script_commands.ml @@ -17,6 +17,7 @@ type logger = Lwt_term.styled_text -> unit Lwt.t (* Type of an argument *) type arg_type = | Int + | Float | Keyword of string list type command = { @@ -129,6 +130,17 @@ let int ?default name = { a_default = default; } +let float ?default name = { + a_name = name; + a_type = Float; + a_cast = (fun str -> + try + float_of_string str + with Failure _ -> + Printf.ksprintf arg_error "invalid value for argument '%s': a float was expected" name); + a_default = default; +} + let keyword ?default name keywords = { a_name = name; a_type = Keyword(List.map fst keywords); diff --git a/PC_Mainboard/common/config.ml b/PC_Mainboard/common/config.ml index 6c73d1d..c248d6e 100644 --- a/PC_Mainboard/common/config.ml +++ b/PC_Mainboard/common/config.ml @@ -13,4 +13,3 @@ let initial_position = 200 let bus_address = "unix:abstract=krobot" let update_delay = 0.05 let reopen_delay = 1.0 -let stop_motors_delay = 0.2 diff --git a/PC_Mainboard/common/config.mli b/PC_Mainboard/common/config.mli index f43c1eb..645ac10 100644 --- a/PC_Mainboard/common/config.mli +++ b/PC_Mainboard/common/config.mli @@ -26,7 +26,3 @@ val update_delay : float val reopen_delay : float (** Time to wait before retrying to open a card *) - -val stop_motors_delay : float - (** Amount of time to wait after a set-speed command to stop the - motors *) diff --git a/PC_Mainboard/driver/driver.ml b/PC_Mainboard/driver/driver.ml index 96d491f..f213256 100644 --- a/PC_Mainboard/driver/driver.ml +++ b/PC_Mainboard/driver/driver.ml @@ -192,45 +192,45 @@ end module Motors = struct - type move_state = - | Ms_static - (* No movement *) - | Ms_stopping - (* The trajectory has been stopped *) - | Ms_moving of [ `Forward | `Backward | `Turn | `Goto ] - (* Currently moving. The argument is a wakener to stop the - mover. *) + type trajectory = { + trajectory : [ `Forward | `Backward | `Left | `Right | `Goto ]; + mutable stopped : bool; + (* Wether the trajectory have been stopped or not *) + abort : unit Lwt.u; + (* Thread which abort waiting for trajectory completion when + wakened *) + } + + type settings = { + direction : [ `Forward | `Backward ]; + velocity : int; + acceleration : int; + } + + (* The current *) + type state = + | Static + (* The robot is not moving *) + | Trajectory of trajectory + (* The robot is following a trajectory. *) + | Manual of unit Lwt.t * settings * settings + (* Manual settings. The first argument is a threads which + suspend itself, then resume and stop the motors *) type t = { obus : OBus_object.t; card : Card.t; - mutable acceleration : int; - (* The current acceleration *) - mutable inhibit_forward_until : float; mutable inhibit_backward_until : float; - (* Date after which motor's inhition should be stopped *) - - mutable move_state : move_state; - (* Move state *) - - commands : int React.event; - (* CMD_TRAJ commands sent by the card *) + (* Date after which motor's inhibition should be stopped *) traj_completed : int React.event; (* Event which occurs each time a TRAJ_COMPLETED command is received *) - mutable velocity_left : int; - mutable velocity_right : int; - (* Velocity when manually controlled (by the joystick for example) *) - - mutable stop_rthread : unit Lwt.t; - mutable stop_lthread : unit Lwt.t; - (* When manually setting velocity with [set_velocity], these threads stop - motors after a small delay, unless a new command is - received. *) + mutable state : state; + (* The current state of the two motors *) } module OBus = OBus_object.Make(struct @@ -246,146 +246,168 @@ struct | High-level movement | +---------------------------------------------------------------+ *) - let stop_move dev = - match dev.move_state with - | Ms_moving _ -> - dev.move_state <- Ms_stopping - | _ -> - () - - let reset_velocity dev = - dev.velocity_left <- 0; - dev.velocity_right <- 0 - let move dev dist velocity acc = - lwt () = Log.info_f "motor: move(dist=%d, velocity=%d, acc=%d)" dist velocity acc in - match dev.move_state with - | Ms_moving _ | Ms_stopping -> - fail (Failure "already moving") - | Ms_static -> + match dev.state with + | Trajectory _ -> + fail (Failure "already in a trajectory") + | Manual _ -> + fail (Failure "currently in manual mode") + | Static -> let date = Unix.gettimeofday () in if (dist > 0 && date < dev.inhibit_forward_until) || (dist < 0 && date < dev.inhibit_backward_until) then fail (Failure "inhibited move") else begin - reset_velocity dev; - dev.move_state <- Ms_moving(if dist > 0 then `Forward else `Backward); + let waiter, wakener = Lwt.wait () in + let trajectory = { + abort = wakener; + trajectory = if dist > 0 then `Forward else `Backward; + stopped = false + } in + dev.state <- Trajectory trajectory; + let thread = Lwt_event.next dev.traj_completed >> return () in lwt () = - if dist > 0 then - USB_commands.Motor.forward dev.card dist velocity acc - else - USB_commands.Motor.backward dev.card (-dist) velocity acc - and _ = Lwt_event.next dev.traj_completed in - let result = match dev.move_state with - | Ms_stopping -> - `Stopped - | _ -> - `OK + select [waiter; + (lwt () = + if dist > 0 then + USB_commands.Motor.forward dev.card dist velocity acc + else + USB_commands.Motor.backward dev.card (-dist) velocity acc + in + thread)] in - dev.move_state <- Ms_static; - return result + dev.state <- Static; + return (if trajectory.stopped then `Stopped else `OK) end let turn dev angle velocity acc = - lwt () = Log.info_f "motor: turn(angle=%d, velocity=%d, acc=%d)" angle velocity acc in - match dev.move_state with - | Ms_moving _ | Ms_stopping -> - fail (Failure "already moving") - | Ms_static -> - reset_velocity dev; - dev.move_state <- Ms_moving `Turn; + match dev.state with + | Trajectory _ -> + fail (Failure "already in a trajectory") + | Manual _ -> + fail (Failure "currently in manual mode") + | Static -> + let waiter, wakener = Lwt.wait () in + let trajectory = { + abort = wakener; + trajectory = if angle > 0 then `Left else `Right; + stopped = false + } in + dev.state <- Trajectory trajectory; + let thread = Lwt_event.next dev.traj_completed >> return () in lwt () = - if angle > 0 then - USB_commands.Motor.right dev.card angle velocity acc - else - USB_commands.Motor.left dev.card (-angle) velocity acc - and _ = Lwt_event.next dev.traj_completed in - let result = match dev.move_state with - | Ms_stopping -> - `Stopped - | _ -> - `OK + select [waiter; + (lwt () = + if angle > 0 then + USB_commands.Motor.left dev.card angle velocity acc + else + USB_commands.Motor.right dev.card (-angle) velocity acc + in + thread)] in - dev.move_state <- Ms_static; - return result + dev.state <- Static; + return (if trajectory.stopped then `Stopped else `OK) let goto dev x y velocity acc mode bypass_distance = - match dev.move_state with - | Ms_moving _ | Ms_stopping -> - fail (Failure "already moving") - | Ms_static -> - reset_velocity dev; - dev.move_state <- Ms_moving `Goto; - lwt () = USB_commands.Motor.goto dev.card ~x ~y ~velocity:velocity ~acceleration:acc ~mode ~bypass_distance and _ = Lwt_event.next dev.traj_completed in - let result = match dev.move_state with - | Ms_stopping -> - `Stopped - | _ -> - `OK - in - dev.move_state <- Ms_static; - return result + match dev.state with + | Trajectory _ -> + fail (Failure "already in a trajectory") + | Manual _ -> + fail (Failure "currently in manual mode") + | Static -> + let date = Unix.gettimeofday () in + if date < dev.inhibit_forward_until then + fail (Failure "inhibited move") + else begin + let waiter, wakener = Lwt.wait () in + let trajectory = { + abort = wakener; + trajectory = `Goto; + stopped = false + } in + dev.state <- Trajectory trajectory; + let thread = Lwt_event.next dev.traj_completed >> return () in + lwt () = + select [waiter; + (lwt () = + USB_commands.Motor.goto dev.card + ~x ~y + ~velocity:velocity + ~acceleration:acc + ~mode + ~bypass_distance + in + thread)] + in + dev.state <- Static; + return (if trajectory.stopped then `Stopped else `OK) + end OL_method Turn : int -> int -> int -> Types.move_result OL_method Move : int -> int -> int -> Types.move_result OL_method Goto : int -> int -> int -> int -> Types.goto_mode -> int -> Types.move_result (* +---------------------------------------------------------------+ - | Low-level control of velocity and acceleration of each motor | + | Manually sets the velocity and acceleration of each motor | +---------------------------------------------------------------+ *) - let string_of_motor = function - | `Left -> "left" - | `Both -> "both" - | `Right -> "right" - - let string_of_stop_mode = function - | `Off -> "off" - | `Abrupt -> "abrupt" - | `Smooth -> "smooth" - - let stop_motors dev motor mode = - lwt () = Log.info_f "motor: stopping(motor=%s, mode=%s)" (string_of_motor motor) (string_of_stop_mode mode) in - stop_move dev; - USB_commands.Motor.traj_stop dev.card motor mode - - let set_velocity dev motor velocity acc = - lwt () = Log.info_f "motor: set_velocity(motor=%s, velocity=%d, acc=%d)" (string_of_motor motor) velocity acc in - stop_move dev; - let dir, abs_velocity = if velocity < 0 then (`Backward, -velocity) else (`Forward, velocity) in + let stop_motors dev mode = + match dev.state with + | Trajectory trajectory -> + trajectory.stopped <- true; + lwt () = USB_commands.Motor.traj_stop dev.card `Both mode in + wakeup trajectory.abort (); + return () + | Manual(stopper, left, right) -> + lwt () = USB_commands.Motor.traj_stop dev.card `Both mode in + dev.state <- Static; + cancel stopper; + return () + | Static -> + USB_commands.Motor.traj_stop dev.card `Both mode + + let _set_velocities dev (settings_l, settings_r) (velocity_l, velocity_r) (acceleration_l, acceleration_r) duration = + let direction_l, velocity_l = if velocity_l < 0 then (`Backward, -velocity_l) else (`Forward, velocity_l) in + let direction_r, velocity_r = if velocity_r < 0 then (`Backward, -velocity_r) else (`Forward, velocity_r) in let date = Unix.gettimeofday () in - if (dir = `Forward && date < dev.inhibit_forward_until) || (dir = `Backward && date < dev.inhibit_backward_until) then - fail (Failure "inhibited move") + if ((direction_l = `Forward || direction_r = `Backward) && date < dev.inhibit_forward_until) + || ((direction_l = `Backward || direction_r = `Backward) && date < dev.inhibit_backward_until) then + fail (Failure "inhibited move") else begin - if motor = `Both || motor = `Left then - dev.velocity_left <- velocity; - if motor = `Both || motor = `Right then - dev.velocity_right <- velocity; - lwt () = - if acc <> dev.acceleration then begin - dev.acceleration <- acc; - USB_commands.Motor.traj_new_velocity dev.card motor abs_velocity acc dir - end else - USB_commands.Motor.traj_change_velocity dev.card motor abs_velocity dir - in - lwt () = USB_commands.Motor.traj_start dev.card motor in - (* Stop motors after a small delay *) - if motor = `Both || motor = `Left then begin - cancel dev.stop_lthread; - if velocity <> 0 then - dev.stop_lthread <- (lwt () = Lwt_unix.sleep Config.stop_motors_delay in - stop_motors dev `Left `Smooth) - end; - if motor = `Both || motor = `Right then begin - cancel dev.stop_rthread; - if velocity <> 0 then - dev.stop_rthread <- (lwt () = Lwt_unix.sleep Config.stop_motors_delay in - stop_motors dev `Right `Smooth) - end; - return () + if velocity_l = 0 && velocity_r = 0 then + stop_motors dev `Smooth + else begin + dev.state <- Manual(Lwt_unix.sleep duration >> stop_motors dev `Smooth, + { velocity = velocity_l; acceleration = acceleration_l; direction = direction_l }, + { velocity = velocity_r; acceleration = acceleration_r; direction = direction_r }); + lwt () = + if acceleration_l <> settings_l.acceleration then + USB_commands.Motor.traj_new_velocity dev.card `Left velocity_l acceleration_l direction_l + else + USB_commands.Motor.traj_change_velocity dev.card `Left velocity_l direction_l + and () = + if acceleration_r <> settings_r.acceleration then + USB_commands.Motor.traj_new_velocity dev.card `Right velocity_r acceleration_r direction_r + else + USB_commands.Motor.traj_change_velocity dev.card `Right velocity_r direction_r + in + USB_commands.Motor.traj_start dev.card `Both + end end - OL_method StopMotors : Types.motor -> Types.stop_mode -> unit - OL_method SetVelocity : Types.motor -> int -> int -> unit + let set_velocities dev velocities accelerations duration = + match dev.state with + | Trajectory _ -> + fail (Failure "currently in trajectory mode") + | Manual(stopper, left, right) -> + cancel stopper; + dev.state <- Static; + _set_velocities dev (left, right) velocities accelerations duration + | Static -> + let static = { velocity = 0; acceleration = 0; direction = `Forward } in + _set_velocities dev (static, static) velocities accelerations duration + + OL_method StopMotors : Types.stop_mode -> unit + OL_method SetVelocities : int * int -> int * int -> float -> unit (* +---------------------------------------------------------------+ | Motors inhbition | @@ -405,11 +427,13 @@ struct let until = Unix.gettimeofday () +. delay in dev.inhibit_forward_until <- until; ignore (inhibited_forward_changed dev until); - match dev.move_state with - | Ms_moving (`Forward | `Goto) -> - stop_motors dev `Both `Abrupt - | Ms_static when dev.velocity_left > 0 || dev.velocity_right > 0 -> - stop_motors dev `Both `Abrupt + match dev.state with + | Trajectory{ trajectory = (`Forward | `Goto) } -> + stop_motors dev `Abrupt + | Manual(_, settings_l, settings_r) + when (settings_l.direction = `Forward && settings_l.velocity > 0) + || (settings_r.direction = `Forward && settings_r.velocity > 0) -> + stop_motors dev `Abrupt | _ -> return () @@ -418,11 +442,13 @@ struct let until = Unix.gettimeofday () +. delay in dev.inhibit_backward_until <- until; ignore (inhibited_backward_changed dev until); - match dev.move_state with - | Ms_moving (`Backward | `Goto) -> - stop_motors dev `Both `Abrupt - | Ms_static when dev.velocity_left < 0 || dev.velocity_right < 0 -> - stop_motors dev `Both `Abrupt + match dev.state with + | Trajectory{ trajectory = `Backward } -> + stop_motors dev `Abrupt + | Manual(_, settings_l, settings_r) + when (settings_l.direction = `Backward && settings_l.velocity > 0) + || (settings_r.direction = `Backward && settings_r.velocity > 0) -> + stop_motors dev `Abrupt | _ -> return () @@ -431,16 +457,10 @@ struct let dev = { obus = OBus_object.make path; card = card; - acceleration = 0; inhibit_forward_until = 0.0; inhibit_backward_until = 0.0; - move_state = Ms_static; - commands = commands; + state = Static; traj_completed = React.E.filter ((=) PcInterface.traj_completed) commands; - velocity_left = 0; - velocity_right = 0; - stop_rthread = return (); - stop_lthread = return (); } in return dev end diff --git a/PC_Mainboard/lib_krobot/krobot.ml b/PC_Mainboard/lib_krobot/krobot.ml index 9785216..df76ee4 100644 --- a/PC_Mainboard/lib_krobot/krobot.ml +++ b/PC_Mainboard/lib_krobot/krobot.ml @@ -180,9 +180,8 @@ include MakeDevice(struct let name = "Motors" end) OP_method Turn : angle : int -> velocity : int -> acceleration : int -> Types.move_result OP_method Move : distance : int -> velocity : int -> acceleration : int -> Types.move_result OP_method Goto : x : int -> y : int -> velocity : int -> acceleration : int -> mode : Types.goto_mode -> bypass_distance : int -> Types.move_result -OP_method StopMotors : motor : Types.motor -> mode : Types.stop_mode -> unit -OP_method SetVelocity : motor : Types.motor -> velocity : int -> acceleration : int -> unit -OP_method SetVelocities : velocities : int * int -> accelerations : int * int -> unit +OP_method StopMotors : mode : Types.stop_mode -> unit +OP_method SetVelocities : velocities : int * int -> accelerations : int * int -> duration : float -> unit OP_method InhibitForward : float -> unit OP_method InhibitBackward : float -> unit diff --git a/PC_Mainboard/lib_krobot/krobot.mli b/PC_Mainboard/lib_krobot/krobot.mli index 14a06ba..b926f60 100644 --- a/PC_Mainboard/lib_krobot/krobot.mli +++ b/PC_Mainboard/lib_krobot/krobot.mli @@ -73,16 +73,17 @@ val goto : t -> mode : Types.goto_mode -> bypass_distance : int -> Types.move_result Lwt.t -val stop_motors : t -> motor : Types.motor -> mode : Types.stop_mode -> unit Lwt.t - (** [stop_motorw t motor mode] stop the given motor(s). *) - -val set_velocity : t -> motor : Types.motor -> velocity : int -> acceleration : int -> unit Lwt.t - (** [set_velocity krobot ~motor ~velocity ~acc] set the velocity and - acceleration for the specified motors. *) - -val set_velocities : t -> velocities : int * int -> accelerations : int * int -> unit Lwt.t - (** [set_velocities krobot ~velocities ~accelerations] sets both - velocities at the same time. *) +val stop_motors : t -> mode : Types.stop_mode -> unit Lwt.t + (** [stop_motorw t mode] stop the two motors. *) + +val set_velocities : t -> + velocities : int * int -> + accelerations : int * int -> + duration : float -> unit Lwt.t + (** [set_velocities krobot ~velocities ~accelerations ~duration] set + the velocities of each motors, then wait for [duration] seconds + and stop the motors, unless [set_velocities] is called again + before. *) val inhibit_forward : t -> float -> unit Lwt.t (** [inhibit_forward krobot delay] forbid forward moves during diff --git a/PC_Mainboard/tests/stop_and_restart.ml b/PC_Mainboard/tests/stop_and_restart.ml index ab193a0..f04a368 100644 --- a/PC_Mainboard/tests/stop_and_restart.ml +++ b/PC_Mainboard/tests/stop_and_restart.ml @@ -15,7 +15,7 @@ lwt () = let t = Krobot.move krobot ~distance:1000 ~velocity:100 ~acceleration:200 in lwt () = Lwt_unix.sleep 2.0 in print_endline "stopping motors"; - lwt () = Krobot.stop_motors krobot `Both `Smooth in + lwt () = Krobot.stop_motors krobot `Smooth in print_endline "waiting for trajectory to terminates"; lwt _ = t in print_endline "mobing backward"; hooks/post-receive -- krobot |