|
From: Jérémie D. <Ba...@us...> - 2010-02-01 21:11:18
|
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 8370857c4bdbf0534e57609729a5b5ebcbceff17 (commit)
from e007ef2fec366cfa70104c5d23dd9f53fa4b3947 (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 8370857c4bdbf0534e57609729a5b5ebcbceff17
Author: Jérémie Dimino <je...@di...>
Date: Mon Feb 1 22:10:30 2010 +0100
better monitor
-----------------------------------------------------------------------
Changes:
diff --git a/PC_Mainboard/clients/_tags b/PC_Mainboard/clients/_tags
index ada7748..f829506 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
+<**/*.ml>: syntax_camlp4o, pkg_camlp4, pkg_lwt.syntax, pkg_lwt.syntax.log, pkg_text.pcre
<lib-krobot/*.ml>: pkg_obus.syntax
# Needed by the rest of the source
@@ -9,4 +9,4 @@
# lib-krobot uses obus
<**/*>: pkg_obus
-<tools/*>: pkg_lwt.text
+<tools/*>: pkg_lwt.text, pkg_text.pcre
diff --git a/PC_Mainboard/clients/myocamlbuild.ml b/PC_Mainboard/clients/myocamlbuild.ml
index 863a811..9e3cd7c 100644
--- a/PC_Mainboard/clients/myocamlbuild.ml
+++ b/PC_Mainboard/clients/myocamlbuild.ml
@@ -29,6 +29,8 @@ let packages = [
"lwt.syntax";
"lwt.syntax.log";
"lwt.text";
+ "text";
+ "text.pcre";
"str";
"xmlm";
"react";
diff --git a/PC_Mainboard/clients/tools/monitor.ml b/PC_Mainboard/clients/tools/monitor.ml
index c62812d..01796f0 100644
--- a/PC_Mainboard/clients/tools/monitor.ml
+++ b/PC_Mainboard/clients/tools/monitor.ml
@@ -11,76 +11,285 @@
open Lwt
open Lwt_term
+open Lwt_read_line
-let draw_text screen line column txt =
- if line >= 0 && line < Array.length screen then
- let rec loop column ptr = match Text.next ptr with
+module TextSet = Set.Make(Text)
+
+(* +-----------------------------------------------------------------+
+ | Drawing |
+ +-----------------------------------------------------------------+ *)
+
+type section = {
+ screen : point array array;
+ x : int;
+ y : int;
+ w : int;
+ h : int;
+}
+
+let get_point clip x y =
+ if x >= 0 && x < clip.w && y >= 0 && y < clip.h then
+ clip.screen.(clip.y + y).(clip.x + x)
+ else
+ blank
+
+let set_point clip x y point =
+ if x >= 0 && x < clip.w && y >= 0 && y < clip.h then
+ clip.screen.(clip.y + y).(clip.x + x) <- point
+
+let draw_text clip ?style x y txt =
+ if y >= 0 && y < clip.h && x < clip.w then
+ let rec loop x ptr = match Text.next ptr with
| None ->
()
| Some(ch, ptr) ->
- if column >= 0 && column < Array.length screen.(line) then
- screen.(line).(column) <- { blank with char = ch };
- loop (column + 1) ptr
+ if x >= 0 && x < clip.w then begin
+ match style with
+ | Some style ->
+ clip.screen.(clip.y + y).(clip.x + x) <- { char = ch; style = style }
+ | None ->
+ clip.screen.(clip.y + y).(clip.x + x) <- { blank with char = ch };
+ end;
+ loop (x + 1) ptr
in
- loop column (Text.pointer_l txt)
+ loop x (Text.pointer_l txt)
(* Prevent concurrent drawing: *)
let drawer_mutex = Lwt_mutex.create ()
(* Draw the whole screen *)
-let rec draw size compass logic_sensors range_finders team jack =
+let rec draw size (compass, logic_sensors, range_finders, team, jack) (engine_state, box) (state_interface, state_sensor, state_motor) =
Lwt_mutex.with_lock drawer_mutex begin fun () ->
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 = Array.make_matrix size.lines size.columns blank in
- draw_text screen 1 1 ("team = " ^ match team with Krobot.Team_red -> "red" | Krobot.Team_green -> "green");
- draw_text screen 2 1 ("jack = " ^ if jack then "present" else "absent");
- draw_text screen 3 1 ("compass = " ^ string_of_int compass);
- draw_text screen 4 1 ("logic_sensors = " ^ String.concat "" (List.map (function true -> "O" | false -> ".") (Array.to_list logic_sensors)));
- for i = 0 to Array.length range_finders - 1 do
- draw_text screen (5 + i) 1 (Printf.sprintf "range_finders[%d] = %d" i range_finders.(i))
- done;
+
+ 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
- screen.(0).(i) <- { blank with char = "─" };
- screen.(size.lines - 1).(i) <- { blank with char = "─" }
+ points.(0).(i) <- { blank with char = "─" };
+ points.(size.lines - 1).(i) <- { blank with char = "─" }
done;
for i = 1 to size.lines - 2 do
- screen.(i).(0) <- { blank with char = "│" };
- screen.(i).(size.columns - 1) <- { blank with char = "│" }
+ 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 string_of_state = function
+ | `Running -> "running"
+ | `Opening -> "opening"
+ | `Closed -> "closed"
+ in
+ Draw.textf zone x 3 "interface card is %s" (string_of_state state_interface);
+ Draw.textf zone x 4 "sensor card is %s" (string_of_state state_sensor);
+ Draw.textf zone x 5 "motor card is %s" (string_of_state state_motor);
+
+ (* ===== 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;
- screen.(0).(0) <- { blank with char = "┌" };
- screen.(size.lines - 1).(0) <- { blank with char = "└" };
- screen.(size.lines - 1).(size.columns - 1) <- { blank with char = "┘" };
- screen.(0).(size.columns - 1) <- { blank with char = "┐" };
- Lwt_term.render screen
+
+ 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
-(* Loop until an exit key is pressed *)
-let rec loop_key () =
- Lwt_term.read_key () >>= function
- | Lwt_term.Key "q" | Lwt_term.Key_control ('c' | '[') ->
- 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 functions = List.fold_left (fun set x -> TextSet.add x set) TextSet.empty [
+ "exit";
+ "forward";
+ "backward";
+ "left";
+ "right";
+]
+
+let complete before after =
+ match before with
+ | <:re< (space* as before) (["a" - "z"]* as word) eos >> ->
+ Lwt_read_line.complete before word after functions
| _ ->
- loop_key ()
+ { comp_state = (before, after);
+ comp_words = TextSet.empty }
+
+let () =
+ Lwt_signal.always_notify
+ (function
+ | Engine.Edition(before, after) ->
+ let comp = complete before after in
+ set_box (Terminal.Box_words(comp.comp_words, 0))
+ | Engine.Selection _ ->
+ set_box (Terminal.Box_message "<selection>")
+ | Engine.Search _ ->
+ set_box (Terminal.Box_message "<backward search>"))
+ (React.S.map (fun state -> state.Engine.mode) engine_state)
+
+let rec loop history =
+ lwt key = read_key () in
+ if key = key_escape then
+ return ()
+ else
+ match Command.of_key key with
+ | Command.Accept_line ->
+ let line = Text.strip (Engine.all_input (React.S.value engine_state)) in
+ if line = "exit" then
+ return ()
+ else begin
+ let history = Lwt_read_line.add_entry line history in
+ set_engine_state (Engine.init history);
+ loop 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
+ set_engine_state { engine_state with Engine.mode = Engine.Edition comp.comp_state };
+ loop history
+ | command ->
+ set_engine_state (Engine.update (React.S.value engine_state) command ());
+ loop history
+
+(* +-----------------------------------------------------------------+
+ | Entry point |
+ +-----------------------------------------------------------------+ *)
lwt () =
lwt () = hide_cursor () in
try_lwt
lwt krobot = Krobot.create () in
let signal =
- React.S.l6 draw
+ React.S.l4 draw
Lwt_term.size
- (Krobot.compass krobot)
- (Krobot.logic_sensors krobot)
- (Krobot.range_finders krobot)
- (Krobot.team krobot)
- (Krobot.jack krobot)
+ (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))
+ engine_state
+ box)
+ (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))
in
(* Make the compiler happy: *)
ignore signal;
- Lwt_term.with_raw_mode loop_key
+ Lwt_term.with_raw_mode (fun () -> loop [])
finally
show_cursor ()
hooks/post-receive
--
krobot
|