Mirrors_Framework/paparazzi
1
0
Fork 0
mirror of https://github.com/paparazzi/paparazzi.git synced 2026-06-06 16:58:48 +08:00
Code Issues Actions 25 Packages Projects Releases Wiki Activity

modularity for papgets

Browse Source
This commit is contained in:
Pascal Brisset
2008-11-25 14:34:03 +00:00
parent a84f121999
commit ebb7ee5ade
8 changed files with 228 additions and 210 deletions
Download Patch File Download Diff File Expand all files Collapse all files
sw/ground_segment/cockpit/live.ml
+1 -1
View File
@@ -448,7 +448,7 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id
ignore (GMisc.image ~pixbuf ~packing:b#add ());
(* Drag for Drop *)
let papget = Papget.xml "goto_block" "button"
let papget = Papget_common.xml "goto_block" "button"
["block_name", block_name;
"icon", icon]
in
sw/ground_segment/cockpit/pages.ml
+1 -1
View File
@@ -326,7 +326,7 @@ let one_setting = fun i do_change packing dl_setting (tooltips:GData.tooltips) s
ignore (GMisc.image ~pixbuf ~packing:b#add ());
(* Drag for Drop *)
let papget = Papget.xml "variable_setting" "button"
let papget = Papget_common.xml "variable_setting" "button"
["variable", varname;
"value", ExtXml.attrib x "value";
"icon", icon] in
sw/ground_segment/cockpit/papgets.ml
+13 -13
View File
@@ -42,7 +42,7 @@ let papget_listener =
let sep = Str.regexp ":" in
fun papget ->
try
let field = Papget.get_property "field" papget in
let field = Papget_common.get_property "field" papget in
match Str.split sep field with
[msg_name; field_name] ->
(new Papget.message msg_name, field_name)
@@ -62,12 +62,12 @@ let create = fun canvas_group papget ->
and renderer =
match display with
"text" ->
(new Papget.canvas_text ~config canvas_group x y :> Papget.renderer)
(new Papget_renderer.canvas_text ~config canvas_group x y :> Papget_renderer.t)
| "ruler" ->
(new Papget.canvas_ruler canvas_group ~config x y :> Papget.renderer)
(new Papget_renderer.canvas_ruler canvas_group ~config x y :> Papget_renderer.t)
| _ -> failwith (sprintf "Unexpected papget display: %s" display) in
let p = new Papget.canvas_display_float_item msg_listener field_name renderer in
let p = new Papget.canvas_display_float_item ~config msg_listener field_name renderer in
let p = (p :> Papget.item) in
register_papget p p
| "goto_block" ->
@@ -81,9 +81,9 @@ let create = fun canvas_group papget ->
let renderer =
match display with
"button" ->
(new Papget.canvas_button canvas_group ~config x y :> Papget.renderer)
(new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t)
| _ -> failwith (sprintf "Unexpected papget display: %s" display) in
let block_name = Papget.get_property "block_name" papget in
let block_name = Papget_common.get_property "block_name" papget in
let clicked = fun () ->
prerr_endline "Warning: goto_block papget sends to all A/C";
Hashtbl.iter
@@ -95,7 +95,7 @@ let create = fun canvas_group papget ->
)
Live.aircrafts
in
let properties = [ Papget.property "block_name" block_name ] in
let properties = [ Papget_common.property "block_name" block_name ] in
let p = new Papget.canvas_goto_block_item properties clicked renderer in
let p = (p :> Papget.item) in
@@ -104,11 +104,11 @@ let create = fun canvas_group papget ->
let renderer =
match display with
"button" ->
(new Papget.canvas_button canvas_group ~config x y :> Papget.renderer)
(new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t)
| _ -> failwith (sprintf "Unexpected papget display: %s" display) in
let varname = Papget.get_property "variable" papget
and value = float_of_string (Papget.get_property "value" papget) in
let varname = Papget_common.get_property "variable" papget
and value = float_of_string (Papget_common.get_property "value" papget) in
let clicked = fun () ->
prerr_endline "Warning: variable_setting papget sending to all active A/C";
@@ -121,8 +121,8 @@ let create = fun canvas_group papget ->
Live.dl_setting ac_id var_id value)
Live.aircrafts
in
let properties = [ Papget.property "variable" varname;
Papget.float_property "value" value ] in
let properties = [ Papget_common.property "variable" varname;
Papget_common.float_property "value" value ] in
let p = new Papget.canvas_variable_setting_item properties clicked renderer in
let p = (p :> Papget.item) in
register_papget p p
@@ -146,7 +146,7 @@ let dnd_data_received = fun canvas_group context ~x ~y data ~info ~time ->
"display", "text";
"x", sprintf "%d" x; "y", sprintf "%d" y ]
and props =
[ Papget.property "field" (sprintf "%s:%s" msg_name field_name) ] in
[ Papget_common.property "field" (sprintf "%s:%s" msg_name field_name) ] in
let papget_xml = Xml.Element ("papget", attrs, props) in
create canvas_group papget_xml
with
sw/lib/ocaml/Makefile
+1 -1
View File
@@ -32,7 +32,7 @@ SRC = debug.ml base64.ml serial.ml ocaml_tools.ml extXml.ml env.ml xml2h.ml latl
CMO = $(SRC:.ml=.cmo)
CMX = $(SRC:.ml=.cmx)
XSRC = platform.ml wind_sock.ml gtk_papget_editor.ml gtk_papget_text_editor.ml papget.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
XSRC = platform.ml wind_sock.ml gtk_papget_editor.ml gtk_papget_text_editor.ml papget_common.ml papget_renderer.ml papget.ml mapCanvas.ml mapWaypoints.ml mapTrack.ml mapGoogle.ml mapIGN.ml ml_gtk_drag.o xmlEdit.ml mapFP.ml
XCMO = $(XSRC:.ml=.cmo)
XCMX = $(XSRC:.ml=.cmx)
sw/lib/ocaml/papget.ml
+31 -194
View File
@@ -25,16 +25,10 @@
*)
open Printf
let affine_pos_and_angle xw yw angle =
let cos_a = cos angle in
let sin_a = sin angle in
[| cos_a ; sin_a ; ~-. sin_a; cos_a; xw ; yw |]
let affine_pos xw yw = affine_pos_and_angle xw yw 0.
module PC = Papget_common
module PR = Papget_renderer
let (//) = Filename.concat
class type item = object
method config : unit -> Xml.xml
method deleted : bool
@@ -65,200 +59,36 @@ class field = fun msg_obj field_name ->
end
class type movable_item =
object
inherit GnoCanvas.base_item
method set : GnomeCanvas.group_p list -> unit
end
class type renderer =
object
method tag : string
method edit : (GObj.widget -> unit) -> unit
method item : movable_item
method update : string -> unit
method config : unit -> Xml.xml list
end
let get_property = fun attr_name xml ->
let attr = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = attr_name) xml "property" in
ExtXml.attrib attr "value"
let get_prop = fun name children default ->
let xml = Xml.Element ("", [], children) in
try get_property name xml with _ -> default
let property = fun name value ->
Xml.Element("property", [ "name", name; "value", value ], [])
let xml = fun type_ display_ properties ->
Xml.Element ("papget", ["type", type_; "display", display_],
List.map (fun (x, y) -> property x y) properties)
let float_property = fun name value ->
property name (string_of_float value)
class canvas_text = fun ?(config=[]) canvas_group x y ->
let group = GnoCanvas.group ~x ~y canvas_group in
let text = GnoCanvas.text group in
object (self)
val mutable format = get_prop "format" config "%.2f"
val mutable size = float_of_string (get_prop "size" config "15.")
val mutable color = get_prop "color" config "green"
method tag = "Text"
method item = (group :> movable_item)
method config = fun () ->
[ property "format" format;
float_property "size" size;
property "color" color ]
method set_format = fun f -> format <- f
method set_size = fun f -> size <- f
method set_color = fun f -> color <- f
method update = fun value ->
let renderer = fun x -> sprintf (Obj.magic format) (float_of_string x) in
text#set [`SIZE_POINTS size; `TEXT (renderer value); `FILL_COLOR color; `ANCHOR `NW]
method edit = fun (pack:GObj.widget -> unit) ->
let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in
let text_editor = new Gtk_papget_text_editor.table_text_editor ~file () in
pack text_editor#table_text_editor#coerce;
(* Initialize the entries *)
text_editor#entry_format#set_text format;
text_editor#spinbutton_size#set_value size;
(* Connect the entries *)
let callback = fun () ->
format <- text_editor#entry_format#text in
ignore (text_editor#entry_format#connect#activate ~callback);
let callback = fun () ->
size <- text_editor#spinbutton_size#value in
ignore (text_editor#spinbutton_size#connect#value_changed ~callback);
end
(***************************Vertical Ruler ***********************************)
class canvas_ruler = fun ?(config=[]) canvas_group x y ->
let h = float_of_string (get_prop "height" config "100.")
and index_on_right = bool_of_string (get_prop "index_on_right" config "false")
and scale = float_of_string (get_prop "scale" config "2.")
and w = float_of_string (get_prop "width" config "32.")
and step = int_of_string (get_prop "step" config "10") in
let text_props=[`ANCHOR `CENTER; `FILL_COLOR "white"]
and index_width = 10. in
let root = GnoCanvas.group ~x ~y canvas_group in
let r = GnoCanvas.group root in
let props = (text_props@[`ANCHOR `EAST]) in
(* One step drawer *)
let draw = fun i value ->
let i = i * step in
let y = -. scale *. (float i -. value) in
if y >= -. h && y <= h then begin
let text = Printf.sprintf "%d" i in
ignore (GnoCanvas.text ~text ~props ~y ~x:(w*.0.75) r);
ignore(GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r)
end;
let y = y -. float step /. 2. *. scale in
if y >= -. h && y <= h then
ignore(GnoCanvas.line ~points:[|w*.0.8;y;w-.1.;y|] ~fill_color:"white" r)
in
let drawer = fun value ->
(* Remove previous items *)
List.iter (fun i -> i#destroy ()) r#get_items;
let v = truncate value / step in
let k = truncate (h /. scale) / step in
for i = Pervasives.max 0 (v - k) to (v + k) do
draw i value
done in
(** Yellow index *)
let _ = GnoCanvas.line ~points:[|0.;0.;w-.1.;0.|] ~fill_color:"yellow" root in
let s = index_width in
let idx = GnoCanvas.polygon ~points:[|0.;0.;-.s;s/.2.;-.s;-.s/.2.|] ~fill_color:"yellow" root in
let () =
if index_on_right then
idx#affine_absolute (affine_pos_and_angle w 0. Latlong.pi) in
object
method tag = "Ruler"
method edit = fun (pack:GObj.widget -> unit) -> ()
method update = fun value ->
let value = float_of_string value in
drawer value
method item = (root :> movable_item)
method config = fun () -> config (* Not editable *)
end
(****************************************************************************)
class canvas_button = fun ?(config=[]) canvas_group x y ->
let icon = get_prop "icon" config "icon_file" in
let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in
let group = GnoCanvas.group ~x ~y canvas_group in
let _item = GnoCanvas.pixbuf ~pixbuf group in
object
method tag = "Button"
method item = (group :> movable_item)
method edit = fun (pack:GObj.widget -> unit) -> ()
method update = fun (value:string) -> ()
method config = fun () ->
[ property "icon" icon]
end
(****************************************************************************)
class widget_renderer = fun (tag:string) widget ?(config=[]) canvas_group x y ->
let group = GnoCanvas.group ~x ~y canvas_group in
let item = GnoCanvas.widget ~width:50. ~height:50. ~widget group in
object
method tag = tag
method edit = fun (_:GObj.widget->unit) -> ()
method item = (item :> movable_item)
method update = fun (_:string) -> ()
method config = fun () -> (config : Xml.xml list)
end
let renderers =
[ (new canvas_text :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> renderer);
(new canvas_ruler :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> renderer) ]
let lazy_tagged_renderers = lazy
(let x = 0. and y = 0.
and group = (GnoCanvas.canvas ())#root in
List.map
(fun constructor ->
let o = constructor ?config:None group x y in
(o#tag, constructor))
renderers)
let regexp_plus = Str.regexp "\\+"
let affine_transform = fun format value ->
let value = float_of_string value in
let a, b =
match Str.split regexp_plus format with
[a;b] -> float_of_string a, float_of_string b
| [a] -> float_of_string a, 0.
| _ -> 1., 0. in
string_of_float (value *. a +. b)
class type canvas_item_type =
object
method connect : unit -> unit
method deleted : bool
method edit : unit -> unit
method event : GnoCanvas.item_event -> bool
method renderer : Papget_renderer.t
method update : string -> unit
method xy : float * float
end
class canvas_item = fun canvas_renderer ->
let canvas_renderer = (canvas_renderer :> renderer) in
let canvas_renderer = (canvas_renderer :> PR.t) in
object (self)
val mutable motion = false
val mutable renderer = canvas_renderer
val mutable x_press = 0.
val mutable y_press = 0.
val mutable deleted = false
val mutable affine = "1"
val mutable dialog_widget = None
method renderer = renderer
@@ -273,7 +103,7 @@ class canvas_item = fun canvas_renderer ->
(renderer#update:string->unit) value
method event = fun (ev : GnoCanvas.item_event) ->
let item = (renderer#item :> movable_item) in
let item = (renderer#item :> PR.movable_item) in
match ev with
`BUTTON_PRESS ev ->
begin
@@ -317,7 +147,7 @@ class canvas_item = fun canvas_renderer ->
let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in
let dialog = new Gtk_papget_editor.papget_editor ~file () in
let tagged_renderers = Lazy.force lazy_tagged_renderers in
let tagged_renderers = Lazy.force PR.lazy_tagged_renderers in
let strings = List.map fst tagged_renderers in
let (combo, (tree, column)) = GEdit.combo_box_text ~packing:dialog#box_item_chooser#add ~strings () in
@@ -371,7 +201,7 @@ class canvas_item = fun canvas_renderer ->
val mutable connection =
canvas_renderer#item#connect#event (fun _ -> false)
method connect = fun () ->
let item = (renderer#item :> movable_item) in
let item = (renderer#item :> PR.movable_item) in
connection <- item#connect#event self#event
initializer
@@ -381,6 +211,8 @@ class canvas_item = fun canvas_renderer ->
class canvas_float_item = fun canvas_renderer ->
object
inherit canvas_item canvas_renderer as super
val mutable affine = "1"
method update = fun value ->
super#update (affine_transform affine value)
@@ -390,7 +222,9 @@ class canvas_float_item = fun canvas_renderer ->
match dialog_widget with
None -> ()
| Some dialog ->
(* Connect the scale entry *)
(* Set the current value *)
dialog#entry_scale#set_text affine;
(* Connect the scale entry *)
let callback = fun () ->
affine <- dialog#entry_scale#text in
ignore (dialog#entry_scale#connect#activate ~callback);
@@ -398,11 +232,14 @@ class canvas_float_item = fun canvas_renderer ->
end
class canvas_display_float_item = fun msg_obj field_name canvas_renderer ->
class canvas_display_float_item = fun ~config (msg_obj:message) field_name (canvas_renderer:PR.t) ->
object
inherit field msg_obj field_name as super
inherit canvas_float_item canvas_renderer as item
initializer
affine <- PC.get_prop "scale" config "1"
method update_field = fun value ->
if not deleted then begin
super#update_field value;
@@ -412,8 +249,8 @@ class canvas_display_float_item = fun msg_obj field_name canvas_renderer ->
method config = fun () ->
let props = renderer#config () in
let field = sprintf "%s:%s" msg_obj#msg_name field_name in
let field_prop = property "field" field
and scale_prop = property "scale" affine in
let field_prop = PC.property "field" field
and scale_prop = PC.property "scale" affine in
let (x, y) = item#xy in
let attrs =
[ "type", "message_field";
@@ -455,12 +292,12 @@ class canvas_clickable_item = fun type_ properties callback canvas_renderer ->
end
class canvas_goto_block_item = fun properties callback canvas_renderer ->
class canvas_goto_block_item = fun properties callback (canvas_renderer:PR.t) ->
object
inherit canvas_clickable_item "goto_block" properties callback canvas_renderer as item
end
class canvas_variable_setting_item = fun properties callback canvas_renderer ->
class canvas_variable_setting_item = fun properties callback (canvas_renderer:PR.t) ->
object
inherit canvas_clickable_item "variable_setting" properties callback canvas_renderer
end
sw/lib/ocaml/papget.mli
+98
View File
@@ -0,0 +1,98 @@
(*
* $Id$
*
* Paparazzi widgets
*
* Copyright (C) 2008 ENAC
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
class type item =
object
method config : unit -> Xml.xml
method deleted : bool
end
class message :
?sender:string ->
?class_name:string ->
string ->
object
method connect : string -> (string -> unit) -> unit
method msg_name : string
end
class type canvas_item_type =
object
method connect : unit -> unit
method deleted : bool
method edit : unit -> unit
method event : GnoCanvas.item_event -> bool
method renderer : Papget_renderer.t
method update : string -> unit
method xy : float * float
end
class canvas_display_float_item :
config:Xml.xml list ->
message ->
string ->
Papget_renderer.t ->
object
inherit canvas_item_type
method config : unit -> Xml.xml
method connect : unit -> unit
method update_field : string -> unit
end
class canvas_goto_block_item :
Xml.xml list ->
(unit -> unit) ->
Papget_renderer.t ->
object
method config : unit -> Xml.xml
method connect : unit -> unit
method deleted : bool
method edit : unit -> unit
method event : GnoCanvas.item_event -> bool
method renderer : Papget_renderer.t
method update : string -> unit
method xy : float * float
end
class canvas_variable_setting_item :
Xml.xml list ->
(unit -> unit) ->
Papget_renderer.t ->
object
method config : unit -> Xml.xml
method connect : unit -> unit
method deleted : bool
method edit : unit -> unit
method event : GnoCanvas.item_event -> bool
method renderer : Papget_renderer.t
method update : string -> unit
method xy : float * float
end
val dnd_source : GObj.widget -> Xml.xml -> unit
sw/lib/ocaml/papget_common.mli
+31
View File
@@ -0,0 +1,31 @@
(*
* $Id$
*
* Commons for papgets
*
* Copyright (C) 2008 ENAC
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
val get_property : string -> Xml.xml -> string
val get_prop : string -> Xml.xml list -> string -> string
val property : string -> string -> Xml.xml
val xml : string -> string -> (string * string) list -> Xml.xml
val float_property : string -> float -> Xml.xml
sw/lib/ocaml/papget_renderer.mli
+52
View File
@@ -0,0 +1,52 @@
(*
* $Id$
*
* Paparazzi widget renderers
*
* Copyright (C) 2008 ENAC
*
* This file is part of paparazzi.
*
* paparazzi is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* paparazzi is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with paparazzi; see the file COPYING. If not, write to
* the Free Software Foundation, 59 Temple Place - Suite 330,
* Boston, MA 02111-1307, USA.
*
*)
class type movable_item =
object
inherit GnoCanvas.base_item
method set : GnomeCanvas.group_p list -> unit
end
class type t =
object
method config : unit -> Xml.xml list
method edit : (GObj.widget -> unit) -> unit
method item : movable_item
method tag : string
method update : string -> unit
end
class canvas_text : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
class canvas_ruler : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
class canvas_button : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
class widget_renderer : string -> GObj.widget -> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
val lazy_tagged_renderers :
(string * (?config:Xml.xml list -> GnoCanvas.group -> float -> float -> t))
list lazy_t