Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. 75f833848ac5b267cfa2a81304f038a28c26b37a
|
From: Pierre C. <Ba...@us...> - 2012-03-21 01:10:17
|
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 75f833848ac5b267cfa2a81304f038a28c26b37a (commit)
from ed621a1fd71df2caabf923996c609f366b36c211 (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 75f833848ac5b267cfa2a81304f038a28c26b37a
Author: chicco <cha...@cr...>
Date: Wed Mar 21 02:08:10 2012 +0100
[info] parser for can frame description
-----------------------------------------------------------------------
Changes:
diff --git a/info/control2011/_oasis b/info/control2011/_oasis
index 1f4cca0..9472d20 100644
--- a/info/control2011/_oasis
+++ b/info/control2011/_oasis
@@ -49,12 +49,16 @@ Library krobot
Library "krobot-can"
FindlibName: can
FindlibParent: krobot
- BuildDepends: krobot, lwt.syntax
+ BuildDepends: krobot, lwt.syntax, sexplib, sexplib.syntax, bitstring
XMETADescription: CAN interface using SocketCAN
- XMETARequires: krobot
+ XMETARequires: krobot, sexplib, bitstring
Path: src/can
Install: true
- Modules: Krobot_can_bus
+ Modules:
+ Krobot_can_bus,
+ Krobot_can_decoder,
+ Krobot_can_desc_lexer,
+ Krobot_can_desc_parser
CSources: can_stubs.c
# +-------------------------------------------------------------------+
@@ -208,6 +212,14 @@ Executable "krobot-ia"
MainIs: krobot_ia.ml
BuildDepends: krobot, lwt.syntax
+Executable "krobot-can-display"
+ Path: src/tools
+ Build$: flag(gtk)
+ Install$: flag(gtk)
+ CompiledObject: best
+ MainIs: krobot_can_display.ml
+ BuildDepends: krobot.can, lwt.syntax, sexplib, sexplib.syntax, cairo.lablgtk2, lwt.glib
+
# +-------------------------------------------------------------------+
# | Examples |
# +-------------------------------------------------------------------+
diff --git a/info/control2011/src/can/krobot_can_decoder.ml b/info/control2011/src/can/krobot_can_decoder.ml
new file mode 100644
index 0000000..4c82c9e
--- /dev/null
+++ b/info/control2011/src/can/krobot_can_decoder.ml
@@ -0,0 +1,138 @@
+open Sexplib.Conv
+open Krobot_can
+
+type signedness =
+ | Signed
+ | Unsigned with sexp
+
+type display =
+ | Bit
+ | Hex
+ | Int of signedness
+ | Float of float option
+ | Char
+ | No with sexp
+
+type size = int with sexp
+
+type endian = Bitstring.endian = BigEndian | LittleEndian | NativeEndian with sexp
+
+type field =
+ { name : string;
+ display : display;
+ size : size;
+ endian : endian;
+ field_description : string option } with sexp
+
+type desc = field list with sexp
+type description = field list with sexp
+
+type frame_desc =
+ { frame_name : string;
+ frame_id : int;
+ frame_data : field list;
+ frame_description : string option }
+
+type result_field =
+ | R_bit of bool
+ | R_hex of int
+ | R_int of int
+ | R_float of float
+ | R_char of char with sexp
+
+type result = ( string * result_field ) list with sexp
+
+type decode_table =
+ (int * kind,desc * string option) Hashtbl.t
+
+let is_description_correct desc =
+ ( List.for_all (fun { display; size } ->
+ size > 0 &&
+ ( match display with
+ | Bit -> size = 1
+ | Char -> size <= 8
+ | _ -> true )) desc ) &&
+ let size = List.fold_left (fun acc t -> acc + t.size) 0 desc in
+ if size > 64
+ then false
+ else true
+
+let check_description desc =
+ if is_description_correct desc
+ then Some desc
+ else None
+
+let split_bitstring (acc,bitstring) field =
+ let (s,start,len) = bitstring in
+ if len < field.size
+ then (acc,(s,start + len,0))
+ else let value = Bitstring.takebits field.size bitstring in
+ let rest = Bitstring.dropbits field.size bitstring in
+ ((value,field)::acc,rest)
+
+let read_field ((str,start,end_),field) =
+ let i = Bitstring.extract_int_ee_unsigned field.endian str start end_ field.size in
+ match field.display with
+ | Bit ->
+ begin
+ let b = match i with
+ | 0 -> false
+ | 1 -> true
+ | _ -> failwith "incorrect description" in
+ Some (field.name,R_bit b)
+ end
+ | Int sign ->
+ failwith "handle sign here...";
+ Some (field.name,R_int i)
+ | Hex -> Some (field.name,R_hex i)
+ | Char -> Some (field.name,R_char (Char.chr i))
+ | Float coef ->
+ Some (field.name,R_float
+ (match coef with
+ | None -> float i
+ | Some c -> c *. (float i)))
+ | No -> None
+
+let filter_map f l =
+ let rec aux = function
+ | [] -> []
+ | t::q -> match f t with
+ | None -> aux q
+ | Some v -> v :: (aux q) in
+ aux l
+
+let read_fields bitstring description =
+ let fields,rest = List.fold_left split_bitstring ([],bitstring) description in
+ filter_map read_field (List.rev fields)
+
+let decode_frame' frame descriptions =
+ read_fields (Bitstring.bitstring_of_string frame.Krobot_can.data) descriptions
+
+let default_desc =
+ let field =
+ { name = "";
+ display = Hex;
+ size = 8;
+ endian = BigEndian;
+ field_description = None } in
+ [ field; field; field; field;
+ field; field; field; field ]
+
+let decode_frame frame table =
+ let desc,name = try Hashtbl.find table (frame.identifier, frame.kind) with
+ | Not_found -> default_desc,None in
+ decode_frame' frame desc,name
+
+let init_decode_table () =
+ Hashtbl.create 0
+
+let set_description t (i,kind) ?name desc =
+ Hashtbl.replace t (i,kind) (desc,name)
+
+let result_to_string = function
+ | R_bit b -> string_of_bool b
+ | R_hex i -> Printf.sprintf "%X" i
+ | R_int i -> string_of_int i
+ | R_float f -> string_of_float f
+ | R_char c -> Printf.sprintf "%c" c
+
diff --git a/info/control2011/src/can/krobot_can_decoder.mli b/info/control2011/src/can/krobot_can_decoder.mli
new file mode 100644
index 0000000..426f8f6
--- /dev/null
+++ b/info/control2011/src/can/krobot_can_decoder.mli
@@ -0,0 +1,55 @@
+open Sexplib.Conv
+
+type signedness =
+ | Signed
+ | Unsigned with sexp
+
+type display =
+ | Bit
+ | Hex
+ | Int of signedness
+ | Float of float option
+ | Char
+ | No
+ with sexp
+
+type size = int with sexp
+
+type endian = Bitstring.endian = BigEndian | LittleEndian | NativeEndian with sexp
+
+type field =
+ { name : string;
+ display : display;
+ size : size;
+ endian : endian;
+ field_description : string option } with sexp
+
+type frame_desc =
+ { frame_name : string;
+ frame_id : int;
+ frame_data : field list;
+ frame_description : string option }
+
+type desc = field list with sexp
+type description with sexp
+
+type result_field =
+ | R_bit of bool
+ | R_hex of int
+ | R_int of int
+ | R_float of float
+ | R_char of char with sexp
+
+type result = ( string * result_field ) list with sexp
+
+type decode_table
+
+val check_description : desc -> description option
+
+val decode_frame : Krobot_can.frame -> decode_table -> result * string option
+
+val init_decode_table : unit -> decode_table
+
+val set_description : decode_table -> (int * Krobot_can.kind) -> ?name:string -> description -> unit
+
+val result_to_string : result_field -> string
diff --git a/info/control2011/src/can/krobot_can_desc_lexer.mll b/info/control2011/src/can/krobot_can_desc_lexer.mll
new file mode 100644
index 0000000..b313ff0
--- /dev/null
+++ b/info/control2011/src/can/krobot_can_desc_lexer.mll
@@ -0,0 +1,55 @@
+{
+ open Lexing
+ open Krobot_can_decoder
+ open Krobot_can_desc_parser
+ type pos = Lexing.position * Lexing.position
+ exception Unexpected_character of char * pos
+
+ let string_buffer = Buffer.create 0
+}
+
+let number =
+ ['0'-'9']+
+ | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+
+ | "0b" ['0' '1']+
+
+let alpha = ['a'-'z' 'A'-'Z' '_']
+let alphanum = ['a'-'z' 'A'-'Z' '0'-'9' '_' ]
+let ident = alpha alphanum*
+
+rule token = parse
+ | [' ' '\t' ] { token lexbuf } (* skip blanks *)
+ | ['\n'] { Lexing.new_line lexbuf; token lexbuf }
+ | number as num { NUM (int_of_string num) }
+ | "bit" { BIT }
+ | "int" { INT }
+ | "float" { FLOAT }
+ | "double" { DOUBLE }
+ | "signed" { SIGNED }
+ | "unsigned" { UNSIGNED }
+ | "bigendian" { BIGENDIAN }
+ | "littleendian" { LITTLEENDIAN }
+ | '{' { LCBRACKET }
+ | '}' { RCBRACKET }
+ | ';' { SEMICOLON }
+ | '"' { let s = text lexbuf in DESCRIPTION s }
+ | ident { IDENT (lexeme lexbuf) }
+ | eof { EOF }
+ | "(*" { comments 0 lexbuf }
+ | _ as c { raise (Unexpected_character
+ (c,(Lexing.lexeme_start_p lexbuf,
+ Lexing.lexeme_end_p lexbuf))) }
+
+and comments level = parse
+ | "*)" { if level = 0 then token lexbuf
+ else comments (level-1) lexbuf }
+ | "(*" { comments (level+1) lexbuf }
+ | eof { raise End_of_file }
+ | _ { comments level lexbuf }
+
+and text = parse
+ | '"' { let r = Buffer.contents string_buffer in
+ Buffer.clear string_buffer;
+ r }
+ | eof { raise End_of_file }
+ | _ as c { Buffer.add_char string_buffer c; text lexbuf }
diff --git a/info/control2011/src/can/krobot_can_desc_parser.mly b/info/control2011/src/can/krobot_can_desc_parser.mly
new file mode 100644
index 0000000..322e88f
--- /dev/null
+++ b/info/control2011/src/can/krobot_can_desc_parser.mly
@@ -0,0 +1,58 @@
+%{
+ open Krobot_can_decoder
+%}
+
+%token <int> NUM
+%token <string> IDENT
+%token <string> DESCRIPTION
+%token INT, BIT, FLOAT, DOUBLE, SIGNED, UNSIGNED, LITTLEENDIAN, BIGENDIAN
+%token LCOLON, LCBRACKET, RCBRACKET, SEMICOLON, DBLQUOTE
+%token EOF
+
+%start file
+%type <Krobot_can_decoder.frame_desc list> file
+%%
+
+file :
+ | frame EOF { [$1] }
+ | frame file { $1 :: $2 }
+;
+
+frame :
+ | IDENT NUM LCBRACKET fields RCBRACKET
+ { { frame_name = $1; frame_id = $2; frame_data = $4; frame_description = None } }
+ | IDENT NUM DESCRIPTION LCBRACKET fields RCBRACKET
+ { { frame_name = $1; frame_id = $2; frame_data = $5; frame_description = Some $3 } }
+
+fields :
+ | field { [$1] }
+ | field SEMICOLON { [$1] }
+ | field SEMICOLON fields { $1 :: $3 }
+
+field :
+ | IDENT field_type
+ { let type_, size = $2 in
+ { name = $1; display = type_; size = size; endian = LittleEndian;
+ field_description = None } }
+ | IDENT field_type DESCRIPTION
+ { let type_, size = $2 in
+ { name = $1; display = type_; size = size; endian = LittleEndian;
+ field_description = Some $3 } }
+
+field_type :
+ | BIT { Bit, 1 }
+ | INT signedness NUM { Int $2, $3 }
+ | FLOAT { Float None, 32 }
+ | DOUBLE { Float None, 64 }
+
+signedness :
+ | SIGNED { Signed }
+ | UNSIGNED { Unsigned }
+
+/*
+endianness :
+ | BIGENDIAN { BigEndian }
+ | LITTLEENDIAN { LittleEndian }
+*/
+
+%%
diff --git a/info/control2011/src/tools/krobot_can_display.ml b/info/control2011/src/tools/krobot_can_display.ml
new file mode 100644
index 0000000..5984832
--- /dev/null
+++ b/info/control2011/src/tools/krobot_can_display.ml
@@ -0,0 +1,167 @@
+open Lwt
+open Krobot_can_decoder
+
+type frame_identifie =
+ | Text of string
+ | Num of int
+
+let waiter, wakener = wait ()
+let quit () = Lwt.wakeup wakener ()
+
+class packet_display ~packing =
+ let box = GPack.vbox ~packing () in
+ let current_child = ref (GPack.vbox ~packing:box#add ()) in
+object (self)
+
+ method new_box () =
+ let old_child = !current_child in
+ let tmp_box = GPack.vbox ~packing:box#add () in
+ current_child := tmp_box;
+ old_child#destroy ();
+ tmp_box
+
+ method set_packet result =
+ let tmp_box = self#new_box () in
+ let _ = List.map (fun (name, result) ->
+ GMisc.label ~text:(Printf.sprintf "%s : %s" name (result_to_string result))
+ ~packing:tmp_box#add ()) result in
+ ()
+
+ method clear () = ignore (self#new_box ())
+
+end
+
+class packet_list ~packing =
+ let box = GPack.vbox ~packing () in
+ let hbox = GPack.hbox ~packing:box#add () in
+ let packet_display = new packet_display ~packing:(box#pack ~expand:false) in
+ let scroll = GBin.scrolled_window ~vpolicy:`ALWAYS ~hpolicy:`NEVER ~packing:hbox#add () in
+
+ let model = new GTree.column_list in
+ let packet_time = model#add Gobject.Data.double in
+ let packet_type = model#add Gobject.Data.string in
+ let packet_id = model#add Gobject.Data.int in
+ let packet_content = model#add Gobject.Data.caml in
+
+ let packet_store = GTree.list_store model in
+
+ let column_packet_time = GTree.view_column ~title:"time" ~renderer:(GTree.cell_renderer_text [], ["text", packet_time]) () in
+ let column_packet_type = GTree.view_column ~title:"type" ~renderer:(GTree.cell_renderer_text [], ["text", packet_type]) () in
+ let column_packet_id = GTree.view_column ~title:"id" ~renderer:(GTree.cell_renderer_text [], ["text", packet_id]) () in
+
+ let view = GTree.view ~packing:scroll#add_with_viewport ~model:packet_store () in
+
+ let _ = view#append_column column_packet_time in
+ let _ = view#append_column column_packet_type in
+ let _ = view#append_column column_packet_id in
+
+ let selection_changed selection () =
+ let update path =
+ let row = packet_store#get_iter path in
+ let result = packet_store#get ~row ~column:packet_content in
+ packet_display#set_packet result
+ in
+ List.iter update selection#get_selected_rows in
+
+object
+
+ method add type_ id timestamp (content:result) =
+ let type_name = match type_ with
+ | Text t -> t
+ | Num i -> string_of_int i in
+ let iter = packet_store#append () in
+ packet_store#set ~row:iter ~column:packet_time timestamp;
+ packet_store#set ~row:iter ~column:packet_id id;
+ packet_store#set ~row:iter ~column:packet_type type_name;
+ packet_store#set ~row:iter ~column:packet_content content
+
+ method clear () =
+ packet_store#clear ();
+ packet_display#clear ()
+
+ initializer
+ ignore (view#selection#connect#changed ~callback:(selection_changed view#selection));
+
+end
+
+class ui () =
+ (* The toplevel window. *)
+ let window = GWindow.window ~title:"can debug" ~width:800 ~height:600 () in
+ let main_vbox = GPack.vbox ~packing:window#add () in
+ let packet_list = new packet_list ~packing:main_vbox#add in
+ let packet_store = ref [] in
+ let decode_table = init_decode_table () in
+ let packet_count = ref 0 in
+
+object (self)
+ method window = window
+ method main_vbox = main_vbox
+ method packet_list = packet_list
+
+ method display_frame id timestamp frame =
+ let result,name = decode_frame frame decode_table in
+ let ident = match name with
+ | None -> Num frame.Krobot_can.identifier
+ | Some n -> Text n
+ in
+ self#packet_list#add ident id timestamp result
+
+ method add_packet (timestamp:float) frame =
+ let id = !packet_count in
+ incr packet_count;
+ packet_store := (id,timestamp,frame) :: !packet_store;
+ try
+ self#display_frame id timestamp frame;
+ return ()
+ with
+ | exn ->
+ Lwt_log.warning_f ~exn "display_packet failed"
+
+ method refresh () =
+ packet_list#clear ();
+ List.iter (fun (id,timestamp,frame) -> self#display_frame id timestamp frame)
+ (List.rev !packet_store)
+
+ initializer
+ ignore (window#connect#destroy quit);
+
+end
+
+let decode_table = ref None
+let iface = ref None
+
+let parse_arg () =
+ let desc =
+ [ "-c", Arg.String (fun s -> decode_table := Some s), "file containing the configuration";
+ "-i", Arg.String (fun s -> iface := Some s), "can interface";] in
+ Arg.parse desc (function "" -> () | _ -> Arg.usage desc ""; exit 2) ""
+
+let loop ui bus =
+ let rec aux () =
+ lwt (timestamp, frame) = Krobot_can_bus.recv bus in
+ lwt () = ui#add_packet timestamp frame in
+ aux ()
+ in
+ aux ()
+
+let init iface =
+ lwt bus = Krobot_can_bus.open_can iface in
+ ignore (GMain.init ~setlocale:false ());
+ Lwt_glib.install ();
+ let ui = new ui () in
+ ui#window#show ();
+ pick
+ [waiter;
+ loop ui bus]
+
+lwt () =
+ parse_arg ();
+ let iface =
+ match !iface with
+ | None -> "slcan0"
+ | Some s -> s in
+ try_lwt
+ init iface
+ with Unix.Unix_error(error, func, arg) ->
+ Lwt_log.error_f "'%s' failed with: %s" func (Unix.error_message error)
+
hooks/post-receive
--
krobot
|
