Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 2c21e9cca0061774f03999f450733b338941d5ca
|
From: Jérémie D. <Ba...@us...> - 2010-05-03 12:00:22
|
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 2c21e9cca0061774f03999f450733b338941d5ca (commit)
from 9a8255e1fe73b38cb1a2bbe49fdb7c692f211d85 (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 2c21e9cca0061774f03999f450733b338941d5ca
Author: Jérémie Dimino <je...@di...>
Date: Mon May 3 13:57:38 2010 +0200
updates
-----------------------------------------------------------------------
Changes:
diff --git a/info/control/driver/driver.ml b/info/control/driver/driver.ml
index 9dca6b4..67cb2d7 100644
--- a/info/control/driver/driver.ml
+++ b/info/control/driver/driver.ml
@@ -189,9 +189,21 @@ struct
OBus_object.add_interface obus
(make ~notify_mode
{
- m_SetLCD = (fun ctx () lines -> set_lcd lines);
- m_BacklightOn = (fun ctx () () -> backlight_on ());
- m_BacklightOff = (fun ctx () () -> backlight_off ());
+ m_SetLCD = (
+ fun ctx () lines ->
+ lwt () = set_lcd lines in
+ OBus_method.return ctx ()
+ );
+ m_BacklightOn = (
+ fun ctx () () ->
+ lwt () = backlight_on () in
+ OBus_method.return ctx ()
+ );
+ m_BacklightOff = (
+ fun ctx () () ->
+ lwt () = backlight_off () in
+ OBus_method.return ctx ()
+ );
})
end
@@ -222,14 +234,33 @@ struct
let () =
OBus_object.add_interface obus
- (make ~notify_mode
- {
- m_ClawsEnable = (fun ctx () () -> claws_enable ());
- m_ClawsDisable = (fun ctx () () -> claws_disable ());
- m_ClawsOpen = (fun ctx () () -> claws_open ());
- m_ClawsClose = (fun ctx () () -> claws_close ());
- m_ClawsTake = (fun ctx () () -> claws_take ());
- })
+ (make ~notify_mode {
+ m_ClawsEnable = (
+ fun ctx obj () ->
+ lwt result = claws_enable obj in
+ OBus_method.return ctx result
+ );
+ m_ClawsDisable = (
+ fun ctx obj () ->
+ lwt result = claws_disable obj in
+ OBus_method.return ctx result
+ );
+ m_ClawsOpen = (
+ fun ctx obj () ->
+ lwt result = claws_open obj in
+ OBus_method.return ctx result
+ );
+ m_ClawsClose = (
+ fun ctx obj () ->
+ lwt result = claws_close obj in
+ OBus_method.return ctx result
+ );
+ m_ClawsTake = (
+ fun ctx obj () ->
+ lwt result = claws_take obj in
+ OBus_method.return ctx result
+ );
+ })
end
(* +-----------------------------------------------------------------+
@@ -308,21 +339,44 @@ struct
OBus_object.add_interface obus
(make ~notify_mode
{
- m_SetAX12 = (fun ctx () positions ->
- let positions =
- List.map
- (fun (x1, x2, x3) ->
- { aa_id = Int32.to_int x1;
- aa_position = Int32.to_int x2;
- aa_velocity = Int32.to_int x3 })
- positions
- in
- set_ax12 positions);
- m_GripUp = (fun ctx () () -> grip_up ());
- m_GripDown = (fun ctx () () -> grip_down ());
- m_GripOpen = (fun ctx () () -> grip_open ());
- m_GripClose = (fun ctx () () -> grip_close ());
- m_GripRelease = (fun ctx () () -> grip_release ());
+ m_SetAX12 = (
+ fun ctx () positions ->
+ let positions =
+ List.map
+ (fun (x1, x2, x3) ->
+ { aa_id = Int32.to_int x1;
+ aa_position = Int32.to_int x2;
+ aa_velocity = Int32.to_int x3 })
+ positions
+ in
+ lwt () = set_ax12 positions in
+ OBus_method.return ctx ()
+ );
+ m_GripUp = (
+ fun ctx obj () ->
+ lwt result = grip_up obj in
+ OBus_method.return ctx result
+ );
+ m_GripDown = (
+ fun ctx obj () ->
+ lwt result = grip_down obj in
+ OBus_method.return ctx result
+ );
+ m_GripOpen = (
+ fun ctx obj () ->
+ lwt result = grip_open obj in
+ OBus_method.return ctx result
+ );
+ m_GripClose = (
+ fun ctx obj () ->
+ lwt result = grip_close obj in
+ OBus_method.return ctx result
+ );
+ m_GripRelease = (
+ fun ctx obj () ->
+ lwt result = grip_release obj in
+ OBus_method.return ctx result
+ );
})
end
@@ -375,14 +429,32 @@ struct
(make ~notify_mode
{
p_Value = (fun () -> React.S.map (fun x -> List.map Int32.of_int (Array.to_list x)) value);
- m_GetCalibration = (fun ctx () id ->
- lwt result = get_calibration (Int32.to_int id) in
- return (List.map Int32.of_int (Array.to_list result)));
- m_CalibrationStart = (fun ctx () (id, skip_measure) ->
- let id = Int32.to_int id in
- calibration_start id skip_measure);
- m_CalibrationStop = (fun ctx () () -> calibration_stop ());
- m_CalibrationContinue = (fun ctx () () -> calibration_continue ());
+ m_GetCalibration = (
+ fun ctx () id ->
+ let ctx =
+ OBus_context.map
+ (fun x -> List.map Int32.of_int (Array.to_list x))
+ ctx
+ in
+ lwt result = get_calibration (Int32.to_int id) in
+ OBus_method.return ctx result
+ );
+ m_CalibrationStart = (
+ fun ctx () (id, skip_measure) ->
+ let id = Int32.to_int id in
+ lwt () = calibration_start id skip_measure in
+ OBus_method.return ctx ()
+ );
+ m_CalibrationStop = (
+ fun ctx () () ->
+ lwt () = calibration_stop () in
+ OBus_method.return ctx ()
+ );
+ m_CalibrationContinue = (
+ fun ctx () () ->
+ lwt () = calibration_continue () in
+ OBus_method.return ctx ()
+ );
})
end
@@ -711,37 +783,62 @@ struct
OBus_object.add_interface obus
(make ~notify_mode
{
- m_Turn = (fun ctx () (angle, velocity, acceleration) ->
- let angle = Int32.to_int angle in
- let velocity = Int32.to_int velocity in
- let acceleration = Int32.to_int acceleration in
- turn angle velocity acceleration >|= int32_of_move_result);
- m_Move = (fun ctx () (distance, velocity, acceleration) ->
- let distance = Int32.to_int distance in
- let velocity = Int32.to_int velocity in
- let acceleration = Int32.to_int acceleration in
- move distance velocity acceleration >|= int32_of_move_result);
- m_Goto = (fun ctx () (x, y, velocity, acceleration, mode, bypass_distance) ->
- let x = Int32.to_int x in
- let y = Int32.to_int y in
- let velocity = Int32.to_int velocity in
- let acceleration = Int32.to_int acceleration in
- let mode = goto_mode_of_int32 mode in
- let bypass_distance = Int32.to_int bypass_distance in
- goto x y velocity acceleration mode bypass_distance >|= int32_of_move_result);
- m_StopMotors = (fun ctx () mode ->
- let mode = stop_mode_of_int32 mode in
- stop_motors mode);
- m_SetVelocities = (fun ctx () (velocity_l, acceleration_l, velocity_r, acceleration_r, duration) ->
- let velocity_l = Int32.to_int velocity_l in
- let acceleration_l = Int32.to_int acceleration_l in
- let velocity_r = Int32.to_int velocity_r in
- let acceleration_r = Int32.to_int acceleration_r in
- set_velocities (velocity_l, velocity_r) (acceleration_l, acceleration_r) duration);
- p_InhibitForwardUntil = ((fun () -> Var.signal inhibit_forward_until),
- (fun ctx () delay -> set_inhibit_forward_until delay));
- p_InhibitBackwardUntil = ((fun () -> Var.signal inhibit_backward_until),
- (fun ctx () delay -> set_inhibit_backward_until delay));
+ m_Turn = (
+ fun ctx () (angle, velocity, acceleration) ->
+ let ctx = OBus_context.map int32_of_move_result ctx in
+ let angle = Int32.to_int angle in
+ let velocity = Int32.to_int velocity in
+ let acceleration = Int32.to_int acceleration in
+ lwt result = turn angle velocity acceleration in
+ OBus_method.return ctx result
+ );
+ m_Move = (
+ fun ctx () (distance, velocity, acceleration) ->
+ let ctx = OBus_context.map int32_of_move_result ctx in
+ let distance = Int32.to_int distance in
+ let velocity = Int32.to_int velocity in
+ let acceleration = Int32.to_int acceleration in
+ lwt result = move distance velocity acceleration in
+ OBus_method.return ctx result
+ );
+ m_Goto = (
+ fun ctx () (x, y, velocity, acceleration, mode, bypass_distance) ->
+ let ctx = OBus_context.map int32_of_move_result ctx in
+ let x = Int32.to_int x in
+ let y = Int32.to_int y in
+ let velocity = Int32.to_int velocity in
+ let acceleration = Int32.to_int acceleration in
+ let mode = goto_mode_of_int32 mode in
+ let bypass_distance = Int32.to_int bypass_distance in
+ lwt result = goto x y velocity acceleration mode bypass_distance in
+ OBus_method.return ctx result
+ );
+ m_StopMotors = (
+ fun ctx () mode ->
+ let mode = stop_mode_of_int32 mode in
+ lwt () = stop_motors mode in
+ OBus_method.return ctx ()
+ );
+ m_SetVelocities = (
+ fun ctx () (velocity_l, acceleration_l, velocity_r, acceleration_r, duration) ->
+ let velocity_l = Int32.to_int velocity_l in
+ let acceleration_l = Int32.to_int acceleration_l in
+ let velocity_r = Int32.to_int velocity_r in
+ let acceleration_r = Int32.to_int acceleration_r in
+ lwt () = set_velocities (velocity_l, velocity_r) (acceleration_l, acceleration_r) duration in
+ OBus_method.return ctx ()
+ );
+ p_InhibitForwardUntil = (
+ (fun () ->
+ Var.signal inhibit_forward_until),
+ (fun ctx () delay ->
+ set_inhibit_forward_until delay)
+ );
+ p_InhibitBackwardUntil = (
+ (fun () ->
+ Var.signal inhibit_backward_until),
+ (fun ctx () delay ->
+ set_inhibit_backward_until delay));
p_State = (fun () -> state_info);
})
end
@@ -790,7 +887,11 @@ struct
(make ~notify_mode
{
p_DevicesStatus = (fun () -> devices_status);
- m_Shutdown = (fun ctx () () -> shutdown ctx ());
+ m_Shutdown = (
+ fun ctx () () ->
+ lwt () = shutdown ctx () in
+ OBus_method.return ctx ()
+ );
})
end
@@ -837,11 +938,31 @@ struct
{
p_Name = (fun obj -> React.S.const card.card_name);
p_State = (fun obj -> React.S.map int32_of_card_state obj.state);
- m_GetFirmwareBuild = (fun ctx obj () -> get_firmware_build obj);
- m_GetBoardInfo = (fun ctx obj () -> get_board_info obj);
- m_Bootloader = (fun ctx obj () -> bootloader obj);
- m_Reset = (fun ctx obj () -> reset obj);
- m_Test = (fun ctx obj () -> test obj);
+ m_GetFirmwareBuild = (
+ fun ctx obj () ->
+ lwt result = get_firmware_build obj in
+ OBus_method.return ctx result
+ );
+ m_GetBoardInfo = (
+ fun ctx obj () ->
+ lwt result = get_board_info obj in
+ OBus_method.return ctx result
+ );
+ m_Bootloader = (
+ fun ctx obj () ->
+ lwt () = bootloader obj in
+ OBus_method.return ctx ()
+ );
+ m_Reset = (
+ fun ctx obj () ->
+ lwt () = reset obj in
+ OBus_method.return ctx ()
+ );
+ m_Test = (
+ fun ctx obj () ->
+ lwt () = test obj in
+ OBus_method.return ctx ()
+ );
}]
path;
card = card;
diff --git a/info/control/driver/export_unsafe.ml b/info/control/driver/export_unsafe.ml
index 743c6b2..e05467e 100644
--- a/info/control/driver/export_unsafe.ml
+++ b/info/control/driver/export_unsafe.ml
@@ -32,14 +32,17 @@ let make_method card cmd =
(fun ctx obj args ->
match React.S.value card.card_card with
| Some card ->
- USBCard.call cmd card
- (List.map2 Value.V.of_dbus
- (Value.C.type_sequence (Value.arg_types cmd.send))
- args)
- >|= List.map2 Value.V.to_dbus (Value.C.type_sequence (Value.arg_types cmd.recv))
+ lwt result =
+ USBCard.call cmd card
+ (List.map2 Value.V.of_dbus
+ (Value.C.type_sequence (Value.arg_types cmd.send))
+ args)
+ in
+ OBus_method.return ctx
+ (List.map2 Value.V.to_dbus (Value.C.type_sequence (Value.arg_types cmd.recv)) result)
| None ->
Printf.ksprintf
- (OBus_error.fail Error.Card_unavailable)
+ (OBus_method.fail ctx Error.Card_unavailable)
"the %s card is currently unavailable"
card.card_name)
hooks/post-receive
--
krobot
|
