mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-05-28 18:07:25 +08:00
[ocaml] move the GCS-only related code out of xpprz lib
Most of the pprz.xlib is used by the legacy GCS only, using in particular the deprecated canvans. This PR is isolating the relevant part to the GCS folder, so it will be easier in the future to avoid the compilation of this part by default. Conditional compilation of the old GCS: test if glade is installed to build supervision, logplotter and the (legacy) GCS.
This commit is contained in:
Gautier Hattenberger
committed by
Fabien-B
Fabien-B
parent
cd546696ef
commit
cf150db155
@@ -7,7 +7,7 @@ archive(byte) = "lib-pprz.cma"
|
||||
archive(native) = "lib-pprz.cmxa"
|
||||
|
||||
package "xlib" (
|
||||
requires = "pprz,LABLGTK2GNOMECANVAS,lablgtk2.glade"
|
||||
requires = "pprz"
|
||||
version = "1.0"
|
||||
archive(byte) = "xlib-pprz.cma"
|
||||
archive(native) = "xlib-pprz.cmxa"
|
||||
+7
-68
@@ -23,43 +23,23 @@
|
||||
|
||||
Q=@
|
||||
|
||||
|
||||
#OCAMLC=ocamlfind ocamlc
|
||||
#OCAMLOPT=ocamlfind ocamlopt
|
||||
#OCAMLDEP=ocamlfind ocamldep
|
||||
#OCAMLLEX=ocamllex
|
||||
#OCAMLYACC=ocamlyacc
|
||||
#OCAMLMKLIB=ocamlmklib
|
||||
#OCAMLLIBDIR=$(shell $(OCAMLC) -where)
|
||||
include ../../Makefile.ocaml
|
||||
|
||||
# verbose ocamlmklib: Print commands before executing them
|
||||
#VERBOSITY = -verbose
|
||||
VERBOSITY =
|
||||
|
||||
UNAME = $(shell uname -s)
|
||||
ifeq ("$(UNAME)","Darwin")
|
||||
MKTEMP = gmktemp
|
||||
else
|
||||
MKTEMP = mktemp
|
||||
endif
|
||||
|
||||
LABLGTK2GNOMECANVAS = $(shell ocamlfind query -p-format lablgtk2-gnome.gnomecanvas 2>/dev/null)
|
||||
ifeq ($(LABLGTK2GNOMECANVAS),)
|
||||
LABLGTK2GNOMECANVAS = $(shell ocamlfind query -p-format lablgtk2.gnomecanvas 2>/dev/null)
|
||||
endif
|
||||
|
||||
INCLUDES=
|
||||
PKGCOMMON=pprzlink,xml-light,netclient,nettls-gnutls,glibivy,lablgtk2
|
||||
XINCLUDES=
|
||||
XPKGCOMMON=pprzlink,xml-light,glibivy,$(LABLGTK2GNOMECANVAS),lablgtk2.glade
|
||||
XPKGCOMMON=pprzlink,xml-light,glibivy,lablgtk2
|
||||
|
||||
SRC = fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_parser.ml expr_lexer.ml extXml.ml env.ml xml2h.ml latlong.ml egm96.ml srtm.ml http.ml gm.ml iGN.ml geometry_2d.ml cserial.o ubx.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml fp_proc.ml quaternion.ml
|
||||
SRC += gen_common.ml radio.ml settings.ml module.ml flight_plan.ml autopilot.ml airframe.ml telemetry.ml aircraft.ml
|
||||
CMO = $(SRC:.ml=.cmo)
|
||||
CMX = $(SRC:.ml=.cmx)
|
||||
|
||||
XSRC = gtk_tools.ml platform.ml contrastLabel.ml acIcon.ml wind_sock.ml gtk_papget_editor.ml gtk_papget_text_editor.ml gtk_papget_gauge_editor.ml gtk_papget_led_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
|
||||
XSRC = gtk_tools.ml
|
||||
XCMO = $(XSRC:.ml=.cmo)
|
||||
XCMX = $(XSRC:.ml=.cmx)
|
||||
|
||||
@@ -82,13 +62,13 @@ lib-pprz.cmxa dlllib-pprz.so: $(CMX)
|
||||
@echo OOL $@
|
||||
$(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^
|
||||
|
||||
xlib-pprz.cma libxlib-pprz.a: $(XCMO)
|
||||
xlib-pprz.cma: $(XCMO)
|
||||
@echo OL $@
|
||||
$(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^
|
||||
$(Q)$(OCAMLC) -a $(XINCLUDES) -o $@ $^
|
||||
|
||||
xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX)
|
||||
xlib-pprz.cmxa: $(XCMX)
|
||||
@echo OOL $@
|
||||
$(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^
|
||||
$(Q)$(OCAMLOPT) -a $(XINCLUDES) -o $@ $^
|
||||
|
||||
# trying to set correct dependencies for parallel build
|
||||
# these are order only depedencies
|
||||
@@ -96,10 +76,6 @@ lib-pprz.cma: | liblib-pprz.a dlllib-pprz.so
|
||||
|
||||
lib-pprz.cmxa: | liblib-pprz.a dlllib-pprz.so
|
||||
|
||||
xlib-pprz.cma: | libxlib-pprz.a dllxlib-pprz.so
|
||||
|
||||
xlib-pprz.cmxa: | libxlib-pprz.a dllxlib-pprz.so
|
||||
|
||||
xml_get.cmo : xml_get.ml lib-pprz.cma
|
||||
@echo OC $@
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -I . lib-pprz.cma -c $<
|
||||
@@ -118,11 +94,6 @@ tests : lib-pprz.cma $(TESTS_CMO)
|
||||
$(XCMO) $(XCMX): PKGCOMMON=$(XPKGCOMMON)
|
||||
|
||||
|
||||
GTKCFLAGS := $(shell pkg-config --cflags gtk+-2.0) -DGTK_DISABLE_DEPRECATED
|
||||
ml_gtk_drag.o : ml_gtk_drag.c
|
||||
@echo OC $<
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $<
|
||||
|
||||
%.cmo : %.ml
|
||||
@echo OC $<
|
||||
$(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $<
|
||||
@@ -143,40 +114,8 @@ ml_gtk_drag.o : ml_gtk_drag.c
|
||||
@echo OCY $<
|
||||
$(Q)$(OCAMLYACC) $<
|
||||
|
||||
gtk_papget_editor.ml : widgets.glade
|
||||
@echo GLADE $@
|
||||
$(eval $@_TMP := $(shell $(MKTEMP)))
|
||||
$(Q)grep -v invisible_char $< > $($@_TMP)
|
||||
$(Q)lablgladecc2 -root papget_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@
|
||||
$(Q)rm -f $($@_TMP)
|
||||
|
||||
gtk_papget_text_editor.ml : widgets.glade
|
||||
@echo GLADE $@
|
||||
$(eval $@_TMP := $(shell $(MKTEMP)))
|
||||
$(Q)grep -v invisible_char $< > $($@_TMP)
|
||||
$(Q)lablgladecc2 -root table_text_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@
|
||||
$(Q)rm -f $($@_TMP)
|
||||
|
||||
gtk_papget_gauge_editor.ml : widgets.glade
|
||||
@echo GLADE $@
|
||||
$(eval $@_TMP := $(shell $(MKTEMP)))
|
||||
$(Q)grep -v invisible_char $< > $($@_TMP)
|
||||
$(Q)lablgladecc2 -root table_gauge_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@
|
||||
$(Q)rm -f $($@_TMP)
|
||||
|
||||
gtk_papget_led_editor.ml : widgets.glade
|
||||
@echo GLADE $@
|
||||
$(eval $@_TMP := $(shell $(MKTEMP)))
|
||||
$(Q)grep -v invisible_char $< > $($@_TMP)
|
||||
$(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@
|
||||
$(Q)rm -f $($@_TMP)
|
||||
|
||||
META.pprz: META.pprz.template
|
||||
@echo COPY $<
|
||||
$(shell sed -e 's/LABLGTK2GNOMECANVAS/$(LABLGTK2GNOMECANVAS)/g' $< > $@)
|
||||
|
||||
clean :
|
||||
$(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli META.pprz
|
||||
$(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli
|
||||
|
||||
.PHONY: all byte native clean
|
||||
|
||||
|
||||
@@ -1,214 +0,0 @@
|
||||
(*
|
||||
* A Label with a contrasting outline
|
||||
*
|
||||
* Copyright (C) 2013 Piotr Esden-Tempski <piotr@esden.net>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
type icon = {
|
||||
lines : float array list;
|
||||
ellipse : float array list;
|
||||
width: int
|
||||
}
|
||||
|
||||
let icon_fixedwing_template = {
|
||||
lines = [
|
||||
[| 0.; -6.; 0.; 14.|];
|
||||
[| -9.; 0.; 9.; 0.|];
|
||||
[| -4.; 10.; 4.; 10.|]
|
||||
];
|
||||
ellipse = [];
|
||||
width = 4
|
||||
}
|
||||
|
||||
let icon_flyingwing_template = {
|
||||
lines = [
|
||||
[| -13.; 4.; 0.; -7.; 13.; 4.|];
|
||||
[| -13.; 5.; 0.; 0.; 13.; 5.|];
|
||||
];
|
||||
ellipse = [];
|
||||
width = 4
|
||||
}
|
||||
|
||||
let icon_rotorcraft_template = {
|
||||
lines = [
|
||||
[| 0.; -8.; 0.; 8.|];
|
||||
[| -8.; 0.; 8.; 0.|];
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|];
|
||||
];
|
||||
ellipse = [
|
||||
[| 8.; -5.; 18.; 5.|];
|
||||
[| -8.; -5.; -18.; 5.|];
|
||||
[| -5.; 8.; 5.; 18.|];
|
||||
[| -5.; -8.; 5.; -18.|];
|
||||
];
|
||||
width = 2
|
||||
}
|
||||
|
||||
let icon_quadrotor_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.; -8.; 8.; 8.|]; (** Center Ring **)
|
||||
[| 8.; -5.; 18.; 5.|];
|
||||
[| -8.; -5.; -18.; 5.|];
|
||||
[| -5.; 8.; 5.; 18.|];
|
||||
[| -5.; -8.; 5.; -18.|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_hexarotor_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **)
|
||||
[| 6.26; 1.50; 16.26; 11.50|];
|
||||
[| -6.26; -1.50; -16.26; -11.50|];
|
||||
[| -5.00; 8.00; 5.00; 18.00|];
|
||||
[| -5.00; -8.00; 5.00; -18.00|];
|
||||
[| 6.26; -1.50; 16.26; -11.50|];
|
||||
[| -6.26; 1.50; -16.26; 11.50|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_octorotor_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **)
|
||||
[| 8.00; -5.00; 18.00; 5.00|];
|
||||
[| -8.00; -5.00; -18.00; 5.00|];
|
||||
[| -5.00; 8.00; 5.00; 18.00|];
|
||||
[| -5.00; -8.00; 5.00; -18.00|];
|
||||
[| 4.19; -4.19; 14.19; -14.19|];
|
||||
[| -4.19; 4.19; -14.19; 14.19|];
|
||||
[| 14.19; 14.19; 4.19; 4.19|];
|
||||
[| -14.19; -14.19; -4.19; -4.19|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_quadrotor_x_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.00; -8.00; 8.00; 8.00|]; (** Center Ring **)
|
||||
[| 4.19; 4.19; 14.19; 14.19|];
|
||||
[| -4.19; -4.19; -14.19; -14.19|];
|
||||
[| -4.19; 4.19; -14.19; 14.19|];
|
||||
[| 4.19; -4.19; 14.19; -14.19|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_quadrotor_xi_template = {
|
||||
lines = [
|
||||
[| 6.;-15.; 0.;-24.; -6.;-15.|]; (** Front Marker **)
|
||||
[| 0.; -4.; 0.; 4.|];
|
||||
[|-4.; -6.; 0.; -4.; 4.; -6.|];
|
||||
[|-4.; 6.; 0.; 4.; 4.; 6.|];
|
||||
];
|
||||
ellipse = [
|
||||
[| 4.19; 4.19; 14.19; 14.19|];
|
||||
[| -4.19; -4.19; -14.19; -14.19|];
|
||||
[| -4.19; 4.19; -14.19; 14.19|];
|
||||
[| 4.19; -4.19; 14.19; -14.19|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_hexarotor_x_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.0; -8.00; 8.0; 8.00|]; (** Center Ring **)
|
||||
[| 1.5; 6.26; 11.5; 16.26|];
|
||||
[| -1.5; -6.26; -11.5; -16.26|];
|
||||
[| 8.0; -5.00; 18.0; 5.00|];
|
||||
[| -8.0; -5.00; -18.0; 5.00|];
|
||||
[| 1.5; -6.26; 11.5; -16.26|];
|
||||
[| -1.5; 6.26; -11.5; 16.26|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_octorotor_x_template = {
|
||||
lines = [
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.; -8.; 8.; 8.|]; (** Center Ring **)
|
||||
[| 0.; 7.; 10.; 17.|];
|
||||
[| 7.; 0.; 17.; 10.|];
|
||||
[| 0.; -7.; 10.; -17.|];
|
||||
[| -7.; 0.; -17.; 10.|];
|
||||
[| 0.; 7.; -10.; 17.|];
|
||||
[| 7.; 0.; 17.; -10.|];
|
||||
[| 0.; -7.; -10.; -17.|];
|
||||
[| -7.; 0.; -17.; -10.|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
let icon_home_template = {
|
||||
lines = [
|
||||
[| -9.; -9.; -9.; 9.; 9.; 9.; 9.; -9.|];
|
||||
[| -12.; -7.; 0.; -15.; 12.; -7.|];
|
||||
];
|
||||
ellipse = [];
|
||||
width = 3;
|
||||
}
|
||||
|
||||
let icon_intruder_template = {
|
||||
lines = [
|
||||
[| 0.; 0.; 0.; -24. |];
|
||||
[| 6.; -15.; 0.; -24.; -6.; -15.|]; (** Front Marker **)
|
||||
];
|
||||
ellipse = [
|
||||
[| -8.; -8.; 8.; 8.|];
|
||||
];
|
||||
width = 1
|
||||
}
|
||||
|
||||
class widget = fun ?(color="red") ?(icon_template=icon_fixedwing_template) (group:GnoCanvas.group) ->
|
||||
let new_line width color points =
|
||||
GnoCanvas.line ~fill_color:color ~props:[`WIDTH_PIXELS width; `CAP_STYLE `ROUND] ~points:points group in
|
||||
let new_ellipse width color points =
|
||||
GnoCanvas.ellipse ~props:[`OUTLINE_COLOR color; `WIDTH_PIXELS width] ~x1:points.(0) ~y1:points.(1) ~x2:points.(2) ~y2:points.(3) group in
|
||||
let icon_bg =
|
||||
(List.map (fun points -> new_line (icon_template.width+2) "black" points) icon_template.lines,
|
||||
List.map (fun points -> new_ellipse (icon_template.width+2) "black" points) icon_template.ellipse) in
|
||||
let icon =
|
||||
(List.map (fun points -> new_line icon_template.width color points) icon_template.lines,
|
||||
List.map (fun points -> new_ellipse icon_template.width color points) icon_template.ellipse) in
|
||||
object(self)
|
||||
method set_color color =
|
||||
List.iter2 (fun segment ellipse -> segment#set [`FILL_COLOR color]; ellipse#set [`FILL_COLOR color]) (fst icon) (snd icon)
|
||||
method set_bg_color color =
|
||||
List.iter2 (fun segment ellipse -> segment#set [`FILL_COLOR color]; ellipse#set [`FILL_COLOR color]) (fst icon_bg) (snd icon_bg)
|
||||
end
|
||||
|
||||
@@ -1,52 +0,0 @@
|
||||
(*
|
||||
* A Label with a contrasting outline
|
||||
*
|
||||
* Copyright (C) 2013 Piotr Esden-Tempski <piotr@esden.net>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
type icon = {
|
||||
lines : float array list;
|
||||
ellipse : float array list;
|
||||
width: int
|
||||
}
|
||||
|
||||
val icon_fixedwing_template : icon
|
||||
val icon_flyingwing_template : icon
|
||||
val icon_rotorcraft_template : icon
|
||||
val icon_quadrotor_template : icon
|
||||
val icon_hexarotor_template : icon
|
||||
val icon_octorotor_template : icon
|
||||
val icon_quadrotor_x_template : icon
|
||||
val icon_hexarotor_x_template : icon
|
||||
val icon_octorotor_x_template : icon
|
||||
val icon_quadrotor_xi_template : icon
|
||||
val icon_home_template : icon
|
||||
val icon_intruder_template : icon
|
||||
|
||||
class widget :
|
||||
?color : string ->
|
||||
?icon_template : icon ->
|
||||
GnoCanvas.group ->
|
||||
object
|
||||
method set_color : string -> unit
|
||||
method set_bg_color : string -> unit
|
||||
end
|
||||
|
||||
@@ -1,60 +0,0 @@
|
||||
(*
|
||||
* A Label with a contrasting outline
|
||||
*
|
||||
* Copyright (C) 2013 Piotr Esden-Tempski <piotr@esden.net>
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(*
|
||||
* This module creates labels with outlines by creating 9
|
||||
* overlapping labels slightly offset from eachother. Where the 8
|
||||
* labels in the background have a different color from last center one.
|
||||
*)
|
||||
|
||||
let label_offset_matrix =
|
||||
[
|
||||
(* X Y *)
|
||||
( 0., -1.); (* N *)
|
||||
( 0., 1.); (* S *)
|
||||
( 1., 0.); (* E *)
|
||||
(-1., 0.); (* W *)
|
||||
( 1., -1.); (* NE *)
|
||||
( 1., 1.); (* SE *)
|
||||
(-1., 1.); (* SW *)
|
||||
(-1., -1.); (* NW *)
|
||||
( 0., 0.); (* Z *)
|
||||
]
|
||||
|
||||
class widget = fun ?(name = "Noname") ?(size = 500) ?(bg_color = "black") ?(color = "white") x y (group:GnoCanvas.group) ->
|
||||
let new_text offset =
|
||||
GnoCanvas.text group ~props:[`TEXT name;
|
||||
`X (x +. (fst offset)); `Y (y +. (snd offset));
|
||||
`ANCHOR `SW;
|
||||
`FILL_COLOR (if offset = (0., 0.) then color else bg_color)] in
|
||||
let labels = List.map new_text label_offset_matrix in
|
||||
object(self)
|
||||
method set_name s = List.iter (fun label -> label#set [`TEXT s]) labels
|
||||
method set_x x = List.iter2 (fun label offset -> label#set [`X (x +. (fst offset))])
|
||||
labels label_offset_matrix
|
||||
method set_y y = List.iter2 (fun label offset -> label#set [`Y (y +. (snd offset))])
|
||||
labels label_offset_matrix
|
||||
method affine_absolute a = List.iter (fun label -> label#affine_absolute a) labels
|
||||
end
|
||||
|
||||
@@ -1,39 +0,0 @@
|
||||
(*
|
||||
* A Label with a contrasting outline
|
||||
*
|
||||
* Copyright (C) 2013 Piotr Esden-Tempski <piotr@esden.net>
|
||||
*
|
||||
* 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 widget :
|
||||
?name:string ->
|
||||
?size:int ->
|
||||
?bg_color:string ->
|
||||
?color:string ->
|
||||
float ->
|
||||
float ->
|
||||
GnoCanvas.group ->
|
||||
object
|
||||
method set_name : string -> unit
|
||||
method set_x : float -> unit
|
||||
method set_y : float -> unit
|
||||
method affine_absolute : float array -> unit
|
||||
end
|
||||
|
||||
@@ -1,147 +0,0 @@
|
||||
(*
|
||||
* OpenGL utils
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
(* = YLF 28/10/2001 = *)
|
||||
(* = = *)
|
||||
(* = Derniere update : 28/10/2002 = *)
|
||||
(* = = *)
|
||||
(* = = *)
|
||||
(* = 28/10/2002 : create_draw_glarea_base et = *)
|
||||
(* = et connect_draw_glarea_simple = *)
|
||||
(* = 15/05/2002 : gl_to_gtk_color et gtk_to_gl_color = *)
|
||||
(* = 12/04/2002 : create_draw_glarea_simple = *)
|
||||
(* = = *)
|
||||
(* ================================================================================== *)
|
||||
|
||||
open Gtk_tools
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Creation d'une drawing area OpenGL = *)
|
||||
(* = = *)
|
||||
(* = width = hauteur de la zone = *)
|
||||
(* = height = hauteur de la zone = *)
|
||||
(* = pack_method = maniere de placer la zone (ex. : hbox#pack) = *)
|
||||
(* ============================================================================= *)
|
||||
let create_draw_glarea_base width height pack_method =
|
||||
(* Creation des widgets *)
|
||||
GlGtk.area [`DEPTH_SIZE 1; `RGBA; `DOUBLEBUFFER]
|
||||
~width:width ~height:height ~packing:pack_method ()
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Connection des fonctions de base a une drawing area OpenGL = *)
|
||||
(* = = *)
|
||||
(* = area = la zone = *)
|
||||
(* = init_func = fonction d'initialisation (realize) = *)
|
||||
(* = display_func = fonction de dessin dans la zone = *)
|
||||
(* = reshape_func = appelee lors d'un changement de taille = *)
|
||||
(* ============================================================================= *)
|
||||
let connect_draw_glarea_simple area
|
||||
init_func display_func reshape_func =
|
||||
(* La nouvelle fonction de dessin appelle celle qui est passee en parametre quand *)
|
||||
(* necessaire et fait le flush ensuite *)
|
||||
let draw = (fun () -> if (area:GlGtk.area)#misc#visible then begin
|
||||
display_func (); Gl.flush (); area#swap_buffers ()
|
||||
end) in
|
||||
|
||||
(* Connection des fonctions *)
|
||||
ignore(area#connect#realize ~callback:init_func) ;
|
||||
ignore(area#connect#display ~callback:draw) ;
|
||||
ignore(area#connect#reshape ~callback:reshape_func) ;
|
||||
|
||||
(* Renvoie la nouvelle fonction de dessin *)
|
||||
draw
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Creation d'une drawing area OpenGL = *)
|
||||
(* = = *)
|
||||
(* = width = hauteur de la zone = *)
|
||||
(* = height = hauteur de la zone = *)
|
||||
(* = pack_method = maniere de placer la zone (ex. : hbox#pack) = *)
|
||||
(* = init_func = fonction d'initialisation (realize) = *)
|
||||
(* = display_func = fonction de dessin dans la zone = *)
|
||||
(* = reshape_func = appelee lors d'un changement de taille = *)
|
||||
(* ============================================================================= *)
|
||||
let create_draw_glarea_simple width height pack_method
|
||||
init_func display_func reshape_func =
|
||||
(* Creation des widgets *)
|
||||
let area = create_draw_glarea_base width height pack_method in
|
||||
|
||||
let draw = connect_draw_glarea_simple area
|
||||
init_func display_func reshape_func in
|
||||
|
||||
(* Renvoie la zone de dessin et la nouvelle fonction de dessin *)
|
||||
(area, draw)
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Connexion evenements souris a une zone de dessin OpenGL = *)
|
||||
(* = = *)
|
||||
(* = area = la zone de dessin = *)
|
||||
(* = mouse_press = fonction appelee lors d'un click souris = *)
|
||||
(* = mouse_move = fonction appelee lors d'un deplacement = *)
|
||||
(* = mouse_release = fonction appelee lors du relachement d'un bouton = *)
|
||||
(* ============================================================================= *)
|
||||
let glarea_mouse_connect area mouse_press mouse_move mouse_release =
|
||||
(area:GlGtk.area)#event#add [`POINTER_MOTION; `BUTTON_PRESS; `BUTTON_RELEASE] ;
|
||||
area#event#set_extensions `ALL;
|
||||
ignore(area#event#connect#button_press ~callback:mouse_press) ;
|
||||
ignore(area#event#connect#motion_notify ~callback:mouse_move) ;
|
||||
ignore(area#event#connect#button_release ~callback:mouse_release)
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Connexion evenements clavier a une zone de dessin = *)
|
||||
(* = = *)
|
||||
(* = area = la zone de dessin = *)
|
||||
(* = key_press = fonction appelee lors de l'appui sur une touche = *)
|
||||
(* = key_release = fonction appelee lors du relachement d'une touche = *)
|
||||
(* ============================================================================= *)
|
||||
let glarea_key_connect area key_press key_release =
|
||||
(* Par defaut l'evenement key_release n'est pas associe au widget *)
|
||||
(area:GlGtk.area)#event#add [`KEY_RELEASE] ;
|
||||
ignore(area#event#connect#key_press
|
||||
~callback:(fun ev -> key_press (GdkEvent.Key.keyval ev))) ;
|
||||
ignore(area#event#connect#key_release
|
||||
~callback:(fun ev -> key_release (GdkEvent.Key.keyval ev))) ;
|
||||
area#misc#set_can_focus true ;
|
||||
area#misc#grab_focus ()
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Passage de couleur GTK vers GL = *)
|
||||
(* = = *)
|
||||
(* = color = couleur GTK (`NAME ou `RGB) a transformer = *)
|
||||
(* ============================================================================= *)
|
||||
let gtk_to_gl_color color =
|
||||
let t = GDraw.color color in
|
||||
((float_of_int (Gdk.Color.red t))/.65535.0,
|
||||
(float_of_int (Gdk.Color.green t))/.65535.0,
|
||||
(float_of_int (Gdk.Color.blue t))/.65535.0)
|
||||
|
||||
(* ============================================================================= *)
|
||||
(* = Passage de couleur GL vers GTK = *)
|
||||
(* = = *)
|
||||
(* = (r, g, b) = couleur GL a transformer en equivalent GTK = *)
|
||||
(* ============================================================================= *)
|
||||
let gl_to_gtk_color (r, g, b) =
|
||||
`RGB(int_of_float (r*.65535.0), int_of_float (g*.65535.0),
|
||||
int_of_float (b*.65535.0))
|
||||
|
||||
(* =============================== FIN ========================================= *)
|
||||
@@ -1,88 +0,0 @@
|
||||
(*
|
||||
* OpenGL utils
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(** Module de gestion des zones de dessin OpenGL
|
||||
|
||||
{b Dépendences : Platform}
|
||||
|
||||
*)
|
||||
|
||||
|
||||
(** {6 Drawing Areas OpenGL} *)
|
||||
|
||||
|
||||
(** [create_draw_glarea_base width height pack_method] crée une zone de
|
||||
dessin OpenGL de largeur [width] et de hauteur [height]. Cette zone est
|
||||
placée comme indiqué dans [pack_method]. La zone créée est renvoyée *)
|
||||
val create_draw_glarea_base :
|
||||
int -> int -> (GObj.widget -> unit) -> GlGtk.area
|
||||
|
||||
(** [connect_draw_glarea_simple area init_func display_func reshape_func]
|
||||
connecte les signaux de base à une zone de dessin créée avec
|
||||
{!Gtk_tools_GL.create_draw_glarea_base}. La fonction de redessin
|
||||
est renvoyée *)
|
||||
val connect_draw_glarea_simple :
|
||||
GlGtk.area ->
|
||||
(unit -> unit) ->
|
||||
(unit -> 'a) -> (width:int -> height:int -> unit) -> unit -> unit
|
||||
|
||||
(** [create_draw_glarea_simple width height pack_method
|
||||
init_func display_func reshape_func] crée une zone de dessin OpenGL et y
|
||||
connecte les signaux. Un couple contenant la zone et la fonction de
|
||||
redessin est renvoyé *)
|
||||
val create_draw_glarea_simple :
|
||||
int ->
|
||||
int ->
|
||||
(GObj.widget -> unit) ->
|
||||
(unit -> unit) ->
|
||||
(unit -> 'a) ->
|
||||
(width:int -> height:int -> unit) -> GlGtk.area * (unit -> unit)
|
||||
|
||||
|
||||
(** {6 Signaux des Drawing Areas OpenGL} *)
|
||||
|
||||
|
||||
(** [glarea_mouse_connect area mouse_press mouse_move mouse_release]
|
||||
connecte les événements souris à la zone de dessin [area] *)
|
||||
val glarea_mouse_connect :
|
||||
GlGtk.area ->
|
||||
(GdkEvent.Button.t -> bool) ->
|
||||
(GdkEvent.Motion.t -> bool) -> (GdkEvent.Button.t -> bool) -> unit
|
||||
|
||||
(** [glarea_key_connect area key_press key_release] connecte les
|
||||
événements claviers à la zone de dessin [area] *)
|
||||
val glarea_key_connect :
|
||||
GlGtk.area -> (Gdk.keysym -> bool) -> (Gdk.keysym -> bool) -> unit
|
||||
|
||||
|
||||
(** {6 Couleurs Gtk <-> OpenGL} *)
|
||||
|
||||
|
||||
(** [gtk_to_gl_color color] crée une couleur OpenGL (r, g, b) à partir
|
||||
de [color]. Les composantes RGB sont dans l'intervalle [\[0.0, 1.0\]] *)
|
||||
val gtk_to_gl_color : GDraw.color -> float * float * float
|
||||
|
||||
(** [gl_to_gtk_color (r, g, b)] fonction inverse de la precedente *)
|
||||
val gl_to_gtk_color :
|
||||
float * float * float -> [> `RGB of int * int * int]
|
||||
@@ -1,236 +0,0 @@
|
||||
(*
|
||||
* Icons library
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
let question_icon =
|
||||
[|"48 48 69 1";
|
||||
" c #000000";". c #060708";"X c #06080a";"o c #0a0a0a";"O c #19150d";
|
||||
"+ c gray8";"@ c gray10";"# c #221c12";"$ c #393939";"% c #2b3d61";
|
||||
"& c #354564";"* c #654f24";"= c #6c5526";"- c #705627";"; c #715929";
|
||||
": c #735f3b";"> c #7c622d";"; c #7f6941";"< c gray39";"1 c #727272";
|
||||
"2 c #737579";"3 c gray50";"4 c #81642e";"5 c #876a31";"6 c #8c6d31";
|
||||
"7 c #937435";"8 c #9b7b3a";"9 c #a27f3b";"0 c #927c52";"q c #a6823c";
|
||||
"w c #a9853d";"e c #a68748";"r c #a38e55";"t c #a48b5a";"y c #b38d40";
|
||||
"u c #bc9443";"i c #be9b53";"p c #bea363";"a c #bfa16a";"s c #bea272";
|
||||
"d c #c09745";"f c #c39f56";"g c #c9a45b";"h c #d2a64c";"j c #d8ab4e";
|
||||
"k c #d8ac5a";"l c #d8b15f";"z c #c3a466";"x c #c6a76a";"c c #c9ac73";
|
||||
"v c #d2b06c";"b c #d9b263";"n c #d8b56e";"m c #dbba73";"M c #d8ba7b";
|
||||
"N c #f7c35a";"B c #f7c96d";"V c #f7cf7e";"C c #aaaaaa";"Z c #d8be86";
|
||||
"A c #dcc494";"S c #f7d48c";"D c #f7d899";"F c #f7dca5";"G c #f7dfaf";
|
||||
"H c #f7e2b8";"J c #f7e5c0";"K c white";"L c None";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLo LLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLL 9uj8q> LLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLL jDDHDMMMiq LLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLL NHHDSNNNVMlq= LLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLo NGFNe77wNNVnlq LLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLL pDHN7 7NNBll4 +LLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLo BJV7 % fNVjlq LLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL rSGj &33 tNBljq KLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL hVNq &3KK tBBnj4 .CKLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL NSNq 2KKL tNnnj* CKLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL vlu4 3KL zBMjq 3CKLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL XX tKL 6vZlj; 3CKLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLL X X3K uSZju +3KLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLL 0<C333. wBZjj 3CKLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLL 2333K NSvk8 +3KLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL =fAmcaO CCKLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL 5vngx, .3CKLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL 7Mbks 2CKLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL uMbk0 3KLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL jZlj: CCKLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL iMju 1KLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL eeq4 XCKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL @$ 3CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL X3KLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLL t2<33CKLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLL# X..KLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL mVSu LLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL VDDj LLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL SSlu CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL Snju CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLL hlu; .CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLL CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLL 3CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLL XoX33CKLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLL 333CKLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL";
|
||||
"LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL"|]
|
||||
|
||||
let error_icon =
|
||||
[|"48 48 133 2";
|
||||
" c #000000";". c #070909";"X c #0c0403";"o c #0a0a0a";"O c #0d0f10";
|
||||
"+ c #130605";"@ c #1d0907";"# c #1c0908";"$ c #131313";"% c #1b1b1b";
|
||||
"& c #250c0a";"* c #2c0e0b";"= c #310d0a";"- c #3a0f0b";"; c #35100e";
|
||||
": c #3d130f";"> c #361210";"; c #242424";"< c #2c2c2c";"1 c #323232";
|
||||
"2 c #3b3b3b";"3 c #41130e";"4 c #401411";"5 c #4d1712";"6 c #4e1814";
|
||||
"7 c #571b15";"8 c #591710";"9 c #581b15";"0 c #5c1e1a";"q c #6e190f";
|
||||
"w c #671c16";"e c #6b1d15";"r c #791e15";"t c #66221d";"y c #6c231e";
|
||||
"u c #7d231c";"i c #742620";"p c #772822";"a c #7f2821";"s c #484848";
|
||||
"d c #545454";"f c #656565";"g c #7e7e7e";"h c #951f11";"j c #981f11";
|
||||
"k c #83241b";"l c #87281e";"z c #892116";"x c #8b261c";"c c #89281f";
|
||||
"v c #952214";"b c #932419";"n c #92291f";"m c #9c2213";"M c #9a261a";
|
||||
"N c #9b291d";"B c #832b24";"V c #8c2a23";"C c #8e2e28";"Z c #8f3832";
|
||||
"A c #942c24";"S c #9b2d23";"D c #943029";"F c #9e3026";"G c #9d3229";
|
||||
"H c #9e3b32";"J c #a52415";"K c #a42618";"L c #a3291c";"P c #a82211";
|
||||
"I c #aa2718";"U c #ab291b";"Y c #b22413";"T c #b12718";"R c #b5291a";
|
||||
"E c #bb2513";"W c #bc2b1a";"Q c #a12d22";"! c #a92f20";"~ c #a03026";
|
||||
"^ c #a03229";"/ c #a5392e";"( c #ab3224";") c #a9352a";"_ c #a83a2e";
|
||||
"` c #a43c33";"' c #af3f33";"] c #c32613";"[ c #c72816";"{ c #c62d1b";
|
||||
"} c #ce2e1c";"| c #d22813";" . c #d02e1b";".. c #db2a15";"X. c #df301c";
|
||||
"o. c #e22b15";"O. c #ec2d15";"+. c #e4311b";"@. c #ea311b";"#. c #ea3a1b";
|
||||
"$. c #f4321a";"%. c #f6381c";"&. c #fd3216";"*. c #fb3318";"=. c #fc3b1a";
|
||||
"-. c #c1782e";";. c #ff401e";":. c #d48d1d";">. c #cd8622";";. c #c18138";
|
||||
"<. c #c79d37";"1. c #c49c39";"2. c #ca9d31";"3. c #cda137";"4. c #cfa43c";
|
||||
"5. c #d5a82e";"6. c #dcac2b";"7. c #d4a534";"8. c #d1a53a";"9. c #d8a733";
|
||||
"0. c #d9aa32";"q. c #daad3c";"w. c #dfb035";"e. c #ddb039";"r. c #e1ae23";
|
||||
"t. c #e1b233";"y. c #cfa540";"u. c #d4aa43";"i. c #d2aa48";"p. c #d8ac40";
|
||||
"a. c #dfb445";"s. c #fdfdfd";"d. c None";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.=.&.*.*.$.O.@.@.@.@.@. d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.=.=.&.O.| ] E Y Y Y P Y W { } } W d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.&.&...] Y P P P P j v J J J I U R W R d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.=.&.O.] Y P P P P P m m P I J J K K L U U U z d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.=.&...E P P P P P P v J J J J J I K K L K L L L r d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.=.&.| Y P P P P P P J v J J K I K ) ( K K L K L L N 8 d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.=.&.| P P P P P P P P J J m m J K K K ( ) L L N L L N k # d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.=.o.Y P P P P J P ! ! J I J m m L K K K ) ) ) Q L L Q N w o d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.=.&.E P P P J P ! ! P ( ( J K K K b m L L K L _ ) Q L L S x ; o d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.*.| P P P P P J h S ! K ( ( K K K K b b L L L L ) _ Q Q L S 7 d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.#.*.E P P J h I P m P K ( ( ( ) J K K L b b N Q L L _ _ ( S Q u # $ d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.%...P P P P j J K I I K K ( ( ' ) L L L L M b N Q Q S / _ S S c = o d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. %.[ I :.r.r.r.r.r.r.6.6.6.6.6.e.a.e.0.0.0.0.7.2.2.7.8.8.-.Q S A 3 o d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. $.E P r.r.r.r.r.r.6.r.6.6.6.6.6.q.e.q.0.9.9.9.9.7.7.8.7.8.Q S A 5 . o d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. $.E P r.r.r.t.r.r.6.r.6.6.6.0.9.5.3.q.p.9.9.9.7.4.8.8.8.y.~ Q A 7 . , d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. #.Y P r.r.r.r.t.t.6.6.6.6.6.6.6.9.5.2.7.p.p.7.4.7.<.1.1.1.~ F D 9 . % d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. +.T J r.r.6.r.6.0.w.6.6.6.0.0.0.9.9.9.2.7.u.u.u.8.8.8.y.y.^ S C 6 % d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. X.T J r.6.6.6.6.6.e.e.0.0.0.6.2.9.7.7.7.2.3.8.u.u.y.8.4.y.^ G V : % d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. } R J >.6.6.6.6.6.6.e.e.9.0.9.2.2.9.7.7.3.3.4.8.i.i.4.y.,.^ G a & % s.d.d.d.d.";
|
||||
"d.d.d.d.d.d. R W K K K I K L N M S ) _ L L Q S S S S S Q S S ^ ^ ` ^ ^ F D w X . % s.d.d.d.d.";
|
||||
"d.d.d.d.d.d. q { U I K L K L U M b L / Q Q L Q n n Q A Q Q G Q ^ ^ ` G G C 6 o , s.d.d.d.d.";
|
||||
"d.d.d.d.d.d. . U U K K L L L Q L N N N ^ S Q Q S c V A A ^ S G G ^ ^ ` D i # . . o 1 d.d.d.d.d.";
|
||||
"d.d.d.d.d.d. o e R U L L L L L Q L N Q ) / S Q Q S F ~ S ^ ^ G ^ ^ G H Z 6 % d d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d. . z U L L L L Q L S N N S ` Q S Q ~ Q ^ A A ^ G D / G C t + o < s.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d. + M K L S L Q Q ! Q S S S / Q Q ^ ^ ^ G D ^ ^ ^ G D p * $ s s.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d. . - M Q L L Q Q Q Q Q Q Q ` ` V A Q ^ ^ D D ^ G D p > o , g d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d. = x S S Q Q Q Q ~ ~ ~ A ` Z G ^ ^ G G G G C y * % d s.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.1 . @ e N N S S Q Q ~ ~ ~ S H ` G ^ G G D B 0 & % s s.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d. 3 k n S S S F F F G F ` G D D B y 4 . . O 1 s.s.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d. . X ; t k V V A A A C V B p 0 > X O < g s.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d. . # * 4 7 0 9 6 : * # . $ 2 g s.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d. . . . o , f s.s.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d. , % . . . . $ % d g s.s.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d. $ . . . o o . O O , s g s.s.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d. 1 , , % % % , , 1 d s.s.s.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.s.s.s.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.";
|
||||
"d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d.d."|]
|
||||
|
||||
let warning_icon =
|
||||
[|"48 48 97 2";" c #000000";". c #0b0501";"X c #0b0900";"o c #0a0a0a";
|
||||
"O c #170402";"+ c #120e00";"@ c #1c0705";"# c #151001";"$ c #1c1501";
|
||||
"% c #131313";"& c #220704";"* c #260806";"= c #2c0805";"- c #2e0a08";
|
||||
"; c #251d02";": c #3b0b07";"> c #3d0c08";"; c #2a2103";"< c #312604";
|
||||
"1 c #3a2d05";"2 c gray17";"3 c #410c06";"4 c #440d09";"5 c #4b0d07";
|
||||
"6 c #490e09";"7 c #4d100c";"8 c #520e07";"9 c #571109";"0 c #5c110b";
|
||||
"q c #413205";"w c #4c3b06";"e c #513f07";"r c #62120a";"t c #6d140b";
|
||||
"y c #73150d";"u c #78150b";"i c #731711";"p c #7a1710";"a c #791812";
|
||||
"s c #524007";"d c #675009";"f c #69520a";"g c #71570a";"h c #745a0c";
|
||||
"j c #7b610a";"k c #85170c";"l c #86180d";"z c #8a180d";"x c #851a12";
|
||||
"c c #8a1a11";"v c #901a0e";"b c #9a1b0e";"n c #931d12";"m c #9c1e14";
|
||||
"M c #a41c0e";"N c #a91d0f";"B c #a01d11";"V c #b31f0f";"C c #b21f10";
|
||||
"Z c #b9200f";"A c #b62010";"S c #bc2111";"D c #ab4216";"F c #b14010";
|
||||
"G c #ba5b12";"H c #bf6f16";"J c #924f48";"K c #c62210";"L c #ca2311";
|
||||
"P c #d32412";"I c #da2613";"U c #e32712";"Y c #e42e1a";"T c #eb2713";
|
||||
"R c #ec2813";"E c #f42913";"W c #c26c13";"Q c #c67e15";"! c #c87e14";
|
||||
"~ c #b9930e";"^ c #bd9312";"/ c #cb8614";"( c #cd8912";") c #c39b0f";
|
||||
"_ c #c59913";"` c #cb9e13";"' c #d18913";"] c #d7a816";"[ c #d7a81a";
|
||||
"{ c #d8a51c";"} c #dcaa14";"| c #d8a919";" . c #dfb112";".. c #e0ad12";
|
||||
"X. c #e0b213";"o. c #808080";"O. c None";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.R E L c o.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.T E P N l X O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E P N M b 0 O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E U V M M B z - % O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.R T Z M M A B b r O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E L M M G W M B v : O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.M E I M M M . .M B B u O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.R T Z M M .... .' B B v 5 O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E L M M W . . . .B B B y O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E I N M M ....~ ..} ( M b z 5 O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.U E Z M M ' ) X q } ..M B B y O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.M E P M M M .j . + ..} ( B m z 6 O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.T U V M M X. ., $ } } } B M m y O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.N E L M M ( X. .; ; } } } ( M m v 6 O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.N R I M M M ..X. .; ; q } } } } m B b y O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.t R S M M ( X. .} w q q } } } } ( B m c 4 O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.N E P N M M . . ...$ ; q } } } } ] m m m r O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.U R A M M . . ...} X X ; } } } } } ' m m x = O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.N R P N M ' . .} } } . + X < } } | } | | m m m 0 % O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.Y R A B M } ........} + s } } } | } | ( m m p @ O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.N R P B N ' .} ....} } 1 e + h } } | } | | | m m c 6 O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.Y T Z M B .} ....} } } ^ f < _ ] | } | } | | / m n i . O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.N R P M B ( .....} } } } } } } | } } | } | | [ | m m c > O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.Y T A B M .} ..} } } } } ` ; ; _ } | } | | [ | { H m n 0 O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.M R P M B ( ..} } ..} } } } w f | } ] | | [ [ { / m m a = O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.J R A B M } } } } } } } } } 1 X h | | | | | | | [ [ m m x 7 o o O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.M T I M M / ..} } } } } } } } ^ < j ] } | | | | | | [ [ H m m 0 o o O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.t R K M M m M M B B B G W / / } } } | | | | | | [ [ | { / D m a @ 2 O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.3 L B m M M M m B B B B B B m m m m B m m m m m m m m m m m m x > O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O u 5 t t u l z n m m B B B B m m m m m m m m m m m m m m m m m 0 O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O. o . & = 3 > 0 0 r t i y i x c x c c c x c x x x x x x a i 7 o O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O. o . & @ & & 4 > 4 > 4 > > > : : > > > > - @ O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O. . o . o o o o O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O. o o . . o o o O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O. o o o O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O. O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.";
|
||||
"O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O.O."|]
|
||||
@@ -1,27 +0,0 @@
|
||||
(*
|
||||
* Icons library
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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 question_icon : string array
|
||||
val error_icon : string array
|
||||
val warning_icon : string array
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,135 +0,0 @@
|
||||
(*
|
||||
* Geographic display
|
||||
*
|
||||
* Copyright (C) 2004-2008 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
type projection = Mercator | UTM | LambertIIe
|
||||
class type geographic = object method pos : Latlong.geographic end
|
||||
|
||||
class widget :
|
||||
?height:int ->
|
||||
?srtm:bool ->
|
||||
?width:int ->
|
||||
?projection:projection ->
|
||||
?georef:Latlong.geographic ->
|
||||
unit ->
|
||||
object
|
||||
method add_info_georef : string -> < pos : Latlong.geographic > -> unit
|
||||
method edit_georef_name : string -> string -> unit
|
||||
method delete_georef : string -> unit
|
||||
method clear_georefs : unit -> unit
|
||||
method altitude : Latlong.geographic -> int
|
||||
method any_event : GdkEvent.any -> bool
|
||||
method arc :
|
||||
?nb_points:int ->
|
||||
?width:int ->
|
||||
?fill_color:string ->
|
||||
float * float -> float -> float -> float -> GnoCanvas.line
|
||||
method background : GnoCanvas.group
|
||||
method background_event : GnoCanvas.item_event -> bool
|
||||
method maps : GnoCanvas.group array
|
||||
method canvas : GnoCanvas.canvas
|
||||
method center : Latlong.geographic -> unit
|
||||
method circle :
|
||||
?group:GnoCanvas.group ->
|
||||
?width:int ->
|
||||
?fill_color:string ->
|
||||
?opacity:int ->
|
||||
?color:string -> Latlong.geographic -> Latlong.fmeter -> GnoCanvas.ellipse
|
||||
method convert_positions_to_points : Latlong.geographic array -> float array
|
||||
method connect_view : (unit -> unit) -> unit
|
||||
method current_zoom : float
|
||||
method display_alt : Latlong.geographic -> unit
|
||||
method display_geo : Latlong.geographic -> unit
|
||||
method display_group : string -> unit
|
||||
method display_pixbuf :
|
||||
?opacity:int ->
|
||||
?level:int ->
|
||||
(int * int) * Latlong.geographic ->
|
||||
(int * int) * Latlong.geographic -> GdkPixbuf.pixbuf -> GnoCanvas.pixbuf
|
||||
method display_xy : string -> unit
|
||||
method factory : GMenu.menu_shell GMenu.factory
|
||||
method file_menu : GMenu.menu
|
||||
method fit_to_window : unit -> unit
|
||||
method fix_bg_coords : Latlong.fmeter * Latlong.fmeter -> Latlong.fmeter * Latlong.fmeter
|
||||
method frame : GPack.box
|
||||
method georef : Latlong.geographic option
|
||||
method georefs : (string * < pos : Latlong.geographic >) list
|
||||
method get_center : unit -> Latlong.geographic
|
||||
method goto : unit -> unit
|
||||
method info : GPack.box
|
||||
method key_press : GdkEvent.Key.t -> bool
|
||||
method menubar : GMenu.menu_shell
|
||||
method mouse_motion : GdkEvent.Motion.t -> bool
|
||||
method move_item :
|
||||
?z:float ->
|
||||
GnomeCanvas.re_p GnoCanvas.item -> Latlong.geographic -> unit
|
||||
method moveto : Latlong.geographic -> unit
|
||||
method of_world : Latlong.fmeter * Latlong.fmeter -> Latlong.geographic
|
||||
method pack_labels : unit
|
||||
method projection : string
|
||||
method photoprojection :
|
||||
?group:GnoCanvas.group ->
|
||||
?width:int ->
|
||||
?fill_color:string ->
|
||||
?color:string ->
|
||||
?number:string -> Latlong.geographic -> Latlong.fmeter -> GnoCanvas.text
|
||||
method polygon :
|
||||
?group:GnoCanvas.group ->
|
||||
?width:int ->
|
||||
?fill_color:string ->
|
||||
?opacity:int ->
|
||||
?color:string -> Latlong.geographic array -> GnoCanvas.polygon
|
||||
method pt2D_of : Latlong.geographic -> Geometry_2d.pt_2D
|
||||
method region : ((float * float) * (Latlong.fmeter * Latlong.fmeter)) option
|
||||
method register_to_fit : geographic -> unit
|
||||
method root : GnoCanvas.group
|
||||
method segment :
|
||||
?group:GnoCanvas.group ->
|
||||
?width:int ->
|
||||
?fill_color:string -> Latlong.geographic -> Latlong.geographic -> GnoCanvas.line
|
||||
method set_georef : Latlong.geographic -> unit
|
||||
method set_utc_time : int -> int -> int -> unit
|
||||
method set_wind_sock : float -> string -> unit
|
||||
method still : GnoCanvas.group
|
||||
method switch_background : bool -> unit
|
||||
method switch_utc_time : bool -> unit
|
||||
method switch_utm_grid : bool -> unit
|
||||
method text :
|
||||
?group:GnoCanvas.group ->
|
||||
?fill_color:string ->
|
||||
?x_offset:float ->
|
||||
?y_offset:float -> Latlong.geographic -> string -> GnoCanvas.text
|
||||
method toolbar : GPack.box
|
||||
method top_still : float
|
||||
method utc_time : GnoCanvas.text
|
||||
method wind_sock : Wind_sock.item
|
||||
method window_to_world :
|
||||
winx:float -> winy:float -> Latlong.fmeter * Latlong.fmeter
|
||||
method world_of : Latlong.geographic -> Latlong.fmeter * Latlong.fmeter
|
||||
method zoom : float -> unit
|
||||
method zoom_adj : GData.adjustment
|
||||
method zoom_down : unit -> unit
|
||||
method zoom_in_place : float -> unit
|
||||
method zoom_in_center : float -> unit
|
||||
method zoom_up : unit -> unit
|
||||
end
|
||||
@@ -1,401 +0,0 @@
|
||||
(*
|
||||
* Displaying and editing a flight plan on a MapCanvas
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
open Printf
|
||||
open Latlong
|
||||
|
||||
let (//) = Filename.concat
|
||||
|
||||
let sof = string_of_float
|
||||
let sof1 = fun x -> sprintf "%.1f" x
|
||||
let sof6 = fun x -> sprintf "%.6f" x
|
||||
let float_attr = fun xml a -> float_of_string (ExtXml.attrib xml a)
|
||||
let rec assoc_nocase at = function
|
||||
[] -> raise Not_found
|
||||
| (a, v)::avs ->
|
||||
if String.uppercase_ascii at = String.uppercase_ascii a then v else assoc_nocase at avs
|
||||
|
||||
(** Returns the WGS84 coordinates of a waypoint, either from its relative x and
|
||||
y coordinates or from its lat and long *)
|
||||
let geo_of_xml = fun utm_ref get_attrib ->
|
||||
try
|
||||
let x = get_attrib "x"
|
||||
and y = get_attrib "y" in
|
||||
Latlong.of_utm WGS84 (utm_add utm_ref (x, y))
|
||||
with
|
||||
Not_found | Xml.No_attribute _ ->
|
||||
try
|
||||
let lat = get_attrib "lat"
|
||||
and lon = get_attrib "lon" in
|
||||
make_geo_deg lat lon
|
||||
with
|
||||
Not_found -> failwith (sprintf "x and y or lat and lon attributes expected in waypoint")
|
||||
|
||||
|
||||
(** Connect a change in the XML editor to the graphical rep *)
|
||||
let update_wp utm_ref (wp:MapWaypoints.waypoint) = function
|
||||
XmlEdit.Deleted -> wp#delete ()
|
||||
| XmlEdit.New_child _ -> failwith "update_wp"
|
||||
| XmlEdit.Modified attribs ->
|
||||
try
|
||||
let float_attrib = fun a -> float_of_string (assoc_nocase a attribs) in
|
||||
|
||||
let wgs84 = geo_of_xml utm_ref float_attrib in
|
||||
|
||||
wp#geomap#edit_georef_name wp#name (assoc_nocase "name" attribs);
|
||||
wp#set wgs84;
|
||||
wp#set_name (assoc_nocase "name" attribs)
|
||||
with
|
||||
_ -> ()
|
||||
|
||||
let iter_stages = fun f xml_tree ->
|
||||
let xml_blocks = XmlEdit.child (XmlEdit.root xml_tree) "blocks" in
|
||||
let rec loop = fun n ->
|
||||
f n;
|
||||
List.iter loop (XmlEdit.children n) in
|
||||
loop xml_blocks
|
||||
|
||||
let try_replace_attrib = fun node tag prev_v v ->
|
||||
try
|
||||
if XmlEdit.attrib node tag = prev_v then
|
||||
XmlEdit.set_attrib node (tag, v)
|
||||
with
|
||||
Not_found -> ()
|
||||
|
||||
(** Update all the references to waypoint names (attribute "wp") *)
|
||||
(** FIXME This function is disabled for now since it is making
|
||||
* a huge mess when reordering the waypoints *)
|
||||
(*let update_wp_refs previous_name xml_tree = function
|
||||
XmlEdit.Deleted -> () (** FIXME *)
|
||||
| XmlEdit.New_child _ -> ()
|
||||
| XmlEdit.Modified attribs ->
|
||||
try
|
||||
let new_name = assoc_nocase "name" attribs in
|
||||
let update = fun node ->
|
||||
try_replace_attrib node "wp" !previous_name new_name;
|
||||
try_replace_attrib node "from" !previous_name new_name in
|
||||
iter_stages update xml_tree;
|
||||
previous_name := new_name
|
||||
with
|
||||
Not_found -> ()
|
||||
*)
|
||||
|
||||
let waypoints_node = fun xml_tree ->
|
||||
let xml_root = XmlEdit.root xml_tree in
|
||||
XmlEdit.child xml_root "waypoints"
|
||||
|
||||
let is_relative_waypoint = fun node ->
|
||||
try
|
||||
ignore (XmlEdit.attrib node "x");
|
||||
ignore (XmlEdit.attrib node "y");
|
||||
true
|
||||
with
|
||||
Not_found -> false
|
||||
|
||||
|
||||
let absolute_coords = fun wp ->
|
||||
let wgs84 = wp#pos in
|
||||
[ "lat", sof6 ((Rad>>Deg) wgs84.posn_lat);
|
||||
"lon", sof6 ((Rad>>Deg) wgs84.posn_long) ]
|
||||
|
||||
|
||||
(** Connect a change from the graphical rep to the xml tree *)
|
||||
let update_xml = fun xml_tree utm0 wp id ->
|
||||
let xml_wpts = XmlEdit.children (waypoints_node xml_tree) in
|
||||
let node = List.find (fun w -> XmlEdit.id w = id) xml_wpts in
|
||||
let default_alt = float_of_string (XmlEdit.attrib (XmlEdit.root xml_tree) "alt") in
|
||||
if wp#deleted then begin
|
||||
XmlEdit.delete node
|
||||
end else
|
||||
let coords =
|
||||
if is_relative_waypoint node then
|
||||
let utm = utm_of WGS84 wp#pos in
|
||||
try
|
||||
let (dx, dy) = utm_sub utm utm0 in
|
||||
["x",sof1 dx; "y",sof1 dy]
|
||||
with
|
||||
_ ->
|
||||
prerr_endline "MapFP.update_xml: waypoint too far from ref; using absolute geodetic coordinates";
|
||||
absolute_coords wp
|
||||
else (* Absolute waypoint: use lat and lon attributes *)
|
||||
absolute_coords wp in
|
||||
|
||||
let alt_attrib =
|
||||
if abs_float (wp#alt -. default_alt) < 1. then [] else ["alt", sof1 wp#alt] in
|
||||
XmlEdit.set_attribs node (("name",wp#name) :: alt_attrib @ coords)
|
||||
|
||||
|
||||
|
||||
|
||||
let new_wp = fun ?(editable = false) (geomap:MapCanvas.widget) xml_tree waypoints utm_ref ?(alt = 0.) node ->
|
||||
let float_attrib = fun a -> float_of_string (XmlEdit.attrib node a) in
|
||||
|
||||
let wgs84 = geo_of_xml utm_ref float_attrib in
|
||||
|
||||
let alt = try float_attrib "alt" with _ -> alt in
|
||||
let name = XmlEdit.attrib node "name" in
|
||||
let show = editable || name.[0] <> '_' in
|
||||
let wp = MapWaypoints.waypoint ~show waypoints ~name ~alt wgs84 in
|
||||
geomap#register_to_fit (wp:>MapCanvas.geographic);
|
||||
XmlEdit.connect node (update_wp utm_ref wp);
|
||||
(*XmlEdit.connect node (update_wp_refs (ref name) xml_tree);*) (* FIXME broken functionality *)
|
||||
let id = XmlEdit.id node in
|
||||
if editable then
|
||||
wp#connect (fun () -> update_xml xml_tree utm_ref wp id);
|
||||
wp
|
||||
|
||||
let gensym =
|
||||
let x = ref 0 in
|
||||
fun p -> incr x; Printf.sprintf "%s%d" p !x
|
||||
|
||||
let rec new_gensym = fun p l ->
|
||||
let s = gensym p in
|
||||
if List.mem s l then new_gensym p l else s
|
||||
|
||||
let georef_of_xml = fun xml ->
|
||||
let lat0 = Latlong.deg_of_string (ExtXml.attrib xml "lat0")
|
||||
and lon0 = Latlong.deg_of_string (ExtXml.attrib xml "lon0") in
|
||||
{ posn_lat = (Deg>>Rad)lat0; posn_long = (Deg>>Rad)lon0 }
|
||||
|
||||
|
||||
let display_lines = fun ?group color (geomap:MapCanvas.widget) points ->
|
||||
let n = Array.length points in
|
||||
let l = ref [] in
|
||||
for i = 0 to n - 1 do
|
||||
l := !l @ [(geomap#segment ?group ~width:3 ~fill_color:color points.(i) points.((i+1)mod n))]
|
||||
done;
|
||||
!l
|
||||
|
||||
let space_regexp = Str.regexp " "
|
||||
let comma_regexp = Str.regexp ","
|
||||
let wgs84_of_kml_point = fun s ->
|
||||
match Str.split comma_regexp s with
|
||||
[long; lat; altitude] ->
|
||||
let lat = float_of_string lat
|
||||
and long = float_of_string long in
|
||||
{posn_lat = (Deg>>Rad) lat; posn_long = (Deg>>Rad) long}
|
||||
| _ -> failwith (Printf.sprintf "wgs84_of_kml_point: %s" s)
|
||||
|
||||
|
||||
(** It should be somewhere else ! *)
|
||||
let display_kml = fun ?group color geomap xml ->
|
||||
try
|
||||
let document = ExtXml.child xml "Document" in
|
||||
let rec loop = fun child ->
|
||||
let tag = String.lowercase_ascii (Xml.tag child) in
|
||||
match tag with
|
||||
| "linestring" | "linearring" ->
|
||||
let coordinates = ExtXml.child child "coordinates" in
|
||||
begin
|
||||
match Xml.children coordinates with
|
||||
[Xml.PCData text] ->
|
||||
let points = Str.split space_regexp text in
|
||||
let points = List.map wgs84_of_kml_point points in
|
||||
(* remove a point if polygon (first in this case) since first and last are the same *)
|
||||
let points = if tag = "linearring" && List.length points > 0 then List.tl points else points in
|
||||
ignore(display_lines ?group color geomap (Array.of_list points))
|
||||
| _ -> failwith "coordinates expected"
|
||||
end
|
||||
| "folder" | "placemark" | "polygon" | "outerboundaryis" ->
|
||||
List.iter loop (Xml.children child)
|
||||
| _ -> () in
|
||||
List.iter loop (Xml.children document)
|
||||
with Xml.Not_element xml -> failwith (Xml.to_string xml)
|
||||
|
||||
|
||||
|
||||
|
||||
class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dtd xml ->
|
||||
(** Xml Editor *)
|
||||
let xml_tree_view, xml_window = XmlEdit.create ?format_attribs ?editable (Dtd.parse_file fp_dtd) xml in
|
||||
let xml_root = XmlEdit.root xml_tree_view in
|
||||
let xml_wpts = XmlEdit.child xml_root "waypoints" in
|
||||
|
||||
(** Geographic ref *)
|
||||
let alt = float_attr xml "alt" in
|
||||
let ref_wgs84 = georef_of_xml xml in
|
||||
let utm0 = utm_of WGS84 ref_wgs84 in
|
||||
|
||||
(** The graphical waypoints *)
|
||||
let wpts_group = new MapWaypoints.group ~show_moved ~color ?editable geomap in
|
||||
|
||||
let array_of_waypoints = ref (Array.make 13 None) in
|
||||
let add_wp_to_array = fun index w ->
|
||||
let n = Array.length !array_of_waypoints in
|
||||
if index >= n then begin
|
||||
let new_array = Array.make (n*2) None in
|
||||
Array.blit !array_of_waypoints 0 new_array 0 n;
|
||||
array_of_waypoints := new_array
|
||||
end;
|
||||
!array_of_waypoints.(index) <- Some w in
|
||||
|
||||
let yaws = Hashtbl.create 5 in (* Yes Another Waypoints Store *)
|
||||
let create_wp =
|
||||
let i = ref 1 in
|
||||
fun node ->
|
||||
let w = new_wp ?editable geomap xml_tree_view wpts_group utm0 ~alt node in
|
||||
Hashtbl.add yaws (XmlEdit.attrib node "name") (!i, w);
|
||||
add_wp_to_array !i w;
|
||||
incr i;
|
||||
w in
|
||||
|
||||
(* The sectors *)
|
||||
(* Parse and store sectors *)
|
||||
let sectors =
|
||||
let waypoints = ExtXml.child xml "waypoints" in
|
||||
try
|
||||
List.fold_left (fun l x ->
|
||||
match String.lowercase_ascii (Xml.tag x) with
|
||||
"kml" ->
|
||||
let file = ExtXml.attrib x "file" in
|
||||
display_kml ~group:wpts_group#group color geomap (ExtXml.parse_file (Env.flight_plans_path // file));
|
||||
l
|
||||
| "sector" ->
|
||||
let wgs84 = fun wp_name ->
|
||||
let wp_name = Xml.attrib wp_name "name" in
|
||||
let select = fun wp -> Xml.attrib wp "name" = wp_name in
|
||||
let wp = ExtXml.child waypoints ~select "waypoint" in
|
||||
let float_attr = fun xml a -> float_of_string (Xml.attrib xml a) in
|
||||
geo_of_xml utm0 (float_attr wp) in
|
||||
let points = List.map wgs84 (Xml.children x) in
|
||||
let points = Array.of_list points in
|
||||
let color_sector = ExtXml.attrib_or_default x "color" color in
|
||||
let segments = display_lines ~group:wpts_group#group color_sector geomap points in
|
||||
let wp_names = List.map (fun wp -> Xml.attrib wp "name") (Xml.children x) in
|
||||
[(wp_names, segments, color_sector)] @ l
|
||||
| _ -> failwith "Unknown sectors child")
|
||||
[] (Xml.children (ExtXml.child xml "sectors"))
|
||||
with Not_found -> [] in
|
||||
|
||||
(* The waypoints *)
|
||||
let _ = List.iter
|
||||
(fun wp ->
|
||||
let w = create_wp wp in
|
||||
let name = XmlEdit.attrib wp "name" in
|
||||
if name = "HOME" then begin
|
||||
let c = ref (GnoCanvas.ellipse geomap#canvas#root) in
|
||||
let update = fun _ ->
|
||||
try
|
||||
let max_dist_from_home = float_of_string (XmlEdit.attrib xml_root "MAX_DIST_FROM_HOME") in
|
||||
!c#destroy ();
|
||||
c := geomap#circle ~group:wpts_group#group ~width:5 ~color w#pos max_dist_from_home
|
||||
with _ -> () in
|
||||
update ();
|
||||
w#connect update;
|
||||
XmlEdit.connect wp update;
|
||||
XmlEdit.connect xml_root update
|
||||
end)
|
||||
(XmlEdit.children xml_wpts) in
|
||||
|
||||
(** Expands the blocks *)
|
||||
let _ =
|
||||
XmlEdit.expand_node xml_tree_view xml_root;
|
||||
let blocks = XmlEdit.child xml_root "blocks" in
|
||||
XmlEdit.expand_node xml_tree_view blocks in
|
||||
|
||||
object
|
||||
method georef = ref_wgs84
|
||||
method window = xml_window
|
||||
method destroy () =
|
||||
wpts_group#group#destroy ();
|
||||
xml_window#destroy ()
|
||||
method show () = wpts_group#group#show ()
|
||||
method hide () = wpts_group#group#hide ()
|
||||
method index wp = Hashtbl.find yaws (XmlEdit.attrib wp "name")
|
||||
method get_wp = fun i ->
|
||||
if i >= Array.length !array_of_waypoints then
|
||||
raise Not_found;
|
||||
match !array_of_waypoints.(i) with
|
||||
None -> raise Not_found
|
||||
| Some w -> w
|
||||
method waypoints = XmlEdit.children (waypoints_node xml_tree_view)
|
||||
method xml = XmlEdit.xml_of_view xml_tree_view
|
||||
method highlight_stage = fun block_no stage_no ->
|
||||
let block_no = string_of_int block_no in
|
||||
let stage_no = string_of_int stage_no in
|
||||
let blocks = XmlEdit.child xml_root "blocks" in
|
||||
List.iter
|
||||
(fun b ->
|
||||
if XmlEdit.attrib b "no" = block_no then begin
|
||||
XmlEdit.set_background ~all:true b "#00c000";
|
||||
let rec f = fun s ->
|
||||
try
|
||||
if XmlEdit.attrib s "no" = stage_no then
|
||||
XmlEdit.set_background s "#00ff00"
|
||||
else
|
||||
List.iter f (XmlEdit.children s)
|
||||
with
|
||||
Not_found -> () in
|
||||
List.iter f (XmlEdit.children b)
|
||||
end else
|
||||
XmlEdit.set_background ~all:true b "white")
|
||||
(XmlEdit.children blocks)
|
||||
|
||||
method add_waypoint (geo:geographic) =
|
||||
let wpt_names = List.map (fun n -> XmlEdit.attrib n "name") (XmlEdit.children xml_wpts) in
|
||||
let name = new_gensym "wp" wpt_names in
|
||||
let utm = utm_of WGS84 geo in
|
||||
let (dx, dy) = utm_sub utm utm0 in
|
||||
let node = XmlEdit.add_child xml_wpts "waypoint" ["x",sof dx;"y",sof dy;"name",name] in
|
||||
create_wp node
|
||||
|
||||
method insert_path = fun path ->
|
||||
let xml_block =
|
||||
try XmlEdit.parent (XmlEdit.selection xml_tree_view) "block" with
|
||||
_ ->
|
||||
let xml_blocks = XmlEdit.child xml_root "blocks" in
|
||||
XmlEdit.child xml_blocks "block" in
|
||||
let path_node = XmlEdit.add_child xml_block "path" ["radius", "42."] in
|
||||
List.iter
|
||||
(fun ((wp:MapWaypoints.waypoint), r) ->
|
||||
let _n = XmlEdit.add_child path_node "path_point" ["wp", wp#name; "radius", sof r] in
|
||||
()
|
||||
)
|
||||
path
|
||||
|
||||
method connect_activated = fun cb -> XmlEdit.connect_activated xml_tree_view cb
|
||||
|
||||
method update_sectors = fun wp_name ->
|
||||
List.iter (fun (wps_name, segments, color) ->
|
||||
let wp_in_sector = List.exists (fun name -> name = wp_name) wps_name in
|
||||
if wp_in_sector then begin
|
||||
(* Build WP array *)
|
||||
let points = List.map (fun n -> let (_, w) = Hashtbl.find yaws n in w#pos) wps_name in
|
||||
let points = Array.of_list points in
|
||||
let segments = Array.of_list segments in
|
||||
let n = Array.length points in
|
||||
(* Update segments *)
|
||||
for i = 0 to n - 1 do
|
||||
let (x1, y1) = geomap#world_of points.(i)
|
||||
and (x2, y2) = geomap#world_of (points.((i+1)mod n)) in
|
||||
segments.(i)#set [`POINTS [|x1; y1; x2; y2 |]]
|
||||
done
|
||||
end
|
||||
) sectors
|
||||
|
||||
initializer (
|
||||
(** Create a graphic waypoint when it is created from the xml editor *)
|
||||
XmlEdit.connect xml_wpts (function XmlEdit.New_child node -> ignore (create_wp node) | _ -> ())
|
||||
)
|
||||
end
|
||||
@@ -1,56 +0,0 @@
|
||||
(*
|
||||
* Displaying and editing a flight plan on a MapCanvas
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(** [flight_plan geomap color dtd_tile xml] *)
|
||||
class flight_plan :
|
||||
?format_attribs:((string * string) list -> string) ->
|
||||
?editable:bool ->
|
||||
show_moved:bool ->
|
||||
MapCanvas.widget ->
|
||||
string ->
|
||||
string ->
|
||||
Xml.xml ->
|
||||
object
|
||||
method add_waypoint : Latlong.geographic -> MapWaypoints.waypoint
|
||||
method destroy : unit -> unit
|
||||
method georef : Latlong.geographic
|
||||
method hide : unit -> unit
|
||||
method index : XmlEdit.node -> int * MapWaypoints.waypoint
|
||||
method get_wp : int -> MapWaypoints.waypoint (** May raise Not_found *)
|
||||
method show : unit -> unit
|
||||
method window : GObj.widget
|
||||
method waypoints : XmlEdit.node list
|
||||
method xml : Xml.xml
|
||||
method insert_path : (MapWaypoints.waypoint * float) list -> unit
|
||||
method highlight_stage : int -> int -> unit
|
||||
method connect_activated : (XmlEdit.node->unit) -> unit
|
||||
method update_sectors : string -> unit
|
||||
end
|
||||
|
||||
(** Extracts [lat0] and [Lon0] attributes *)
|
||||
val georef_of_xml : Xml.xml -> Latlong.geographic
|
||||
|
||||
(** Display a polygon based on a kml file *)
|
||||
val display_kml : ?group:GnoCanvas.group -> string -> MapCanvas.widget -> Xml.xml -> unit
|
||||
|
||||
@@ -1,219 +0,0 @@
|
||||
(*
|
||||
* Displaying Google Maps on a MapCanvas object
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
let array_forall = fun f a ->
|
||||
Array.fold_right (fun x r -> f x && r) a true
|
||||
|
||||
open Printf
|
||||
|
||||
|
||||
module LL = Latlong
|
||||
|
||||
(** Quadtreee of displayed tiles *)
|
||||
type tiles_tree =
|
||||
Empty
|
||||
| Tile
|
||||
| Node of tiles_tree array
|
||||
let gm_tiles = Node (Array.make 4 Empty)
|
||||
|
||||
(** Google Maps paths in the quadtree are coded with q,r,s and t*)
|
||||
let index_of = function
|
||||
'q' -> 0 | 'r' -> 1 | 's' -> 2 | 't' -> 3
|
||||
| _ -> invalid_arg "index_of"
|
||||
let char_of = function
|
||||
0 -> 'q' | 1 -> 'r' | 2 -> 's' | 3 -> 't'
|
||||
| _ -> invalid_arg "char_of"
|
||||
|
||||
(** Checking that a tile is already displayed *)
|
||||
let mem_tile = fun tile_key ->
|
||||
let rec loop = fun i tree ->
|
||||
tree = Tile ||
|
||||
i < String.length tile_key &&
|
||||
match tree with
|
||||
Empty -> false
|
||||
| Tile -> true
|
||||
| Node sons -> loop (i+1) sons.(index_of tile_key.[i]) in
|
||||
loop 0 gm_tiles
|
||||
|
||||
(** Adding a tile to the store *)
|
||||
let add_tile = fun tile_key ->
|
||||
let rec loop = fun i tree j ->
|
||||
if i < String.length tile_key then
|
||||
match tree.(j) with
|
||||
Empty ->
|
||||
let sons = Array.make 4 Empty in
|
||||
tree.(j) <- Node sons;
|
||||
loop (i+1) sons (index_of tile_key.[i])
|
||||
| Tile -> () (* Already there *)
|
||||
| Node sons ->
|
||||
loop (i+1) sons (index_of tile_key.[i])
|
||||
else
|
||||
tree.(j) <- Tile in
|
||||
loop 0 [|gm_tiles|] 0
|
||||
|
||||
|
||||
let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level ->
|
||||
let south_lat = tile.Gm.sw_corner.LL.posn_lat
|
||||
and west_long = tile.Gm.sw_corner.LL.posn_long in
|
||||
let north_lat = south_lat +. tile.Gm.height
|
||||
and east_long = west_long +. tile.Gm.width in
|
||||
let ne = LL.make_geo north_lat east_long in
|
||||
|
||||
let (tx, ty) = Gm.tile_size in
|
||||
try
|
||||
let pixbuf = GdkPixbuf.from_file jpg_file in
|
||||
ignore (GMain.Idle.add (fun () ->
|
||||
let map = geomap#display_pixbuf ((0,tx), tile.Gm.sw_corner) ((ty,0),ne) pixbuf ~level in
|
||||
map#raise 1;
|
||||
false));
|
||||
add_tile tile.Gm.key
|
||||
with
|
||||
GdkPixbuf.GdkPixbufError(_, msg) ->
|
||||
match GToolbox.question_box ~title:"Corrupted file" ~buttons:["Erase"; "Cancel"] (sprintf "%s. Erase ?" msg) with
|
||||
1 ->
|
||||
Sys.remove jpg_file
|
||||
| _ -> ()
|
||||
|
||||
|
||||
|
||||
(** Displaying the tile around the given point *)
|
||||
let display_tile = fun (geomap:MapCanvas.widget) wgs84 level ->
|
||||
let desired_tile = Gm.tile_of_geo ~level wgs84 1 in
|
||||
|
||||
let key = desired_tile.Gm.key in
|
||||
if not (mem_tile key) then
|
||||
let (tile, jpg_file) = Gm.get_image key in
|
||||
display_the_tile geomap tile jpg_file (String.length tile.Gm.key)
|
||||
|
||||
|
||||
exception New_displayed of int
|
||||
(** [New_displayed zoom] Raised when a new is loadded *)
|
||||
|
||||
let fill_window = fun (geomap:MapCanvas.widget) zoomlevel ->
|
||||
(** First estimate the coverage of the window *)
|
||||
let width_c, height_c = Gdk.Drawable.get_size geomap#canvas#misc#window
|
||||
and (xc0, yc0) = geomap#canvas#get_scroll_offsets in
|
||||
let (xw0, yw0) = geomap#window_to_world (float xc0) (float (yc0+height_c))
|
||||
and (xw1, yw1) = geomap#window_to_world (float (xc0+width_c)) (float yc0) in
|
||||
let sw = geomap#of_world (xw0, yw0)
|
||||
and ne = geomap#of_world (xw1, yw1) in
|
||||
let west = sw.LL.posn_long /. LL.pi
|
||||
and east = ne.LL.posn_long /. LL.pi
|
||||
and north = LL.mercator_lat ne.LL.posn_lat /. LL.pi
|
||||
and south = LL.mercator_lat sw.LL.posn_lat /. LL.pi in
|
||||
|
||||
let east = if east < west then east +. 2. else east in
|
||||
|
||||
(** Get Hashtbl from cache *)
|
||||
let tbl = Gm.get_hashtbl_of_cache () in
|
||||
|
||||
(** Go through the quadtree and look for the holes *)
|
||||
let rec loop = fun twest tsouth tsize trees i zoom key ->
|
||||
(* Check for intersection *)
|
||||
if not (twest > east || (twest+.tsize < west && (east < 1. (* Standard case *) || twest+.2.>east (* Over 180� *))) || tsouth > north || tsouth+.tsize < south) then
|
||||
let tsize2 = tsize /. 2. in
|
||||
try
|
||||
match trees.(i) with
|
||||
Tile -> ()
|
||||
| Empty ->
|
||||
if zoom = 1 then
|
||||
let tile, image = Gm.get_image ~tbl key in
|
||||
let level = String.length tile.Gm.key in
|
||||
display_the_tile geomap tile image level;
|
||||
raise (New_displayed (zoomlevel+1-String.length tile.Gm.key))
|
||||
else begin
|
||||
trees.(i) <- Node (Array.make 4 Empty);
|
||||
loop twest tsouth tsize trees i zoom key
|
||||
end
|
||||
| Node sons ->
|
||||
let continue = fun j tw ts ->
|
||||
loop tw ts tsize2 sons j (zoom-1) (key^String.make 1 (char_of j)) in
|
||||
|
||||
continue 0 twest (tsouth+.tsize2);
|
||||
continue 1 (twest+.tsize2) (tsouth+.tsize2);
|
||||
continue 2 (twest+.tsize2) tsouth;
|
||||
continue 3 twest tsouth;
|
||||
|
||||
(* If the current node is complete, replace it by a Tile *)
|
||||
if array_forall (fun x -> x = Tile) sons then begin
|
||||
trees.(i) <- Tile
|
||||
end
|
||||
with
|
||||
New_displayed z when z = zoom ->
|
||||
trees.(i) <- Tile
|
||||
| Gm.Not_available -> () in
|
||||
loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t"
|
||||
|
||||
|
||||
exception To_copy of int * string
|
||||
|
||||
let gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf =
|
||||
let dest_x, width, src_x =
|
||||
if dest_x < 0 then 0, width+dest_x, src_x-dest_x else dest_x, width, src_x in
|
||||
let dest_y, height, src_y =
|
||||
if dest_y < 0 then 0, height+dest_y, src_y-dest_y else dest_y, height, src_y in
|
||||
let width = min width (GdkPixbuf.get_width dest - dest_x)
|
||||
and height = min height (GdkPixbuf.get_height dest -dest_y) in
|
||||
GdkPixbuf.copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y pixbuf
|
||||
|
||||
let pixbuf = fun sw ne zoomlevel->
|
||||
assert (sw.LL.posn_lat < ne.LL.posn_lat);
|
||||
assert (sw.LL.posn_long < ne.LL.posn_long);
|
||||
let west = sw.LL.posn_long /. LL.pi
|
||||
and east = ne.LL.posn_long /. LL.pi
|
||||
and north = LL.mercator_lat ne.LL.posn_lat /. LL.pi
|
||||
and south = LL.mercator_lat sw.LL.posn_lat /. LL.pi in
|
||||
|
||||
let pixel_size = 1. /. (2. ** 16.) /. 256. in
|
||||
let width = truncate ((east -. west) /. pixel_size)
|
||||
and height = truncate ((north -. south) /. pixel_size) in
|
||||
let dest = GdkPixbuf.create ~width ~height () in
|
||||
let rec loop = fun twest tsouth tsize zoom key ->
|
||||
if not (twest > east || twest+.tsize < west || tsouth > north || tsouth+.tsize < south) then
|
||||
let tsize2 = tsize /. 2. in
|
||||
try
|
||||
if zoom = 1
|
||||
then
|
||||
let tile, image = Gm.get_image key in
|
||||
raise (To_copy (zoomlevel+1-String.length tile.Gm.key, image))
|
||||
else begin
|
||||
let continue = fun j tw ts ->
|
||||
loop tw ts tsize2 (zoom-1) (key^String.make 1 (char_of j)) in
|
||||
continue 0 twest (tsouth+.tsize2);
|
||||
continue 1 (twest+.tsize2) (tsouth+.tsize2);
|
||||
continue 2 (twest+.tsize2) tsouth;
|
||||
continue 3 twest tsouth;
|
||||
end
|
||||
with
|
||||
To_copy (z, image) when z = zoom ->
|
||||
let dest_x = truncate ((twest -. west) /. pixel_size)
|
||||
and dest_y = truncate ((north -. (tsouth+.tsize)) /. pixel_size) in
|
||||
let width = truncate (tsize /. pixel_size) in
|
||||
let src_x = 0
|
||||
and src_y = 0 in
|
||||
let pixbuf = GdkPixbuf.from_file image in
|
||||
gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height:width ~src_x ~src_y pixbuf
|
||||
| Gm.Not_available -> () in
|
||||
loop (-1.) (-1.) 2. zoomlevel "t";
|
||||
dest
|
||||
@@ -1,32 +0,0 @@
|
||||
(*
|
||||
* Displaying Google Maps on a MapCanvas object
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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 display_tile : MapCanvas.widget -> Latlong.geographic -> int -> unit
|
||||
(** Displaying the Google Maps tile around the given point (zoom=1) up to max level *)
|
||||
|
||||
val fill_window : MapCanvas.widget -> int -> unit
|
||||
(** Filling the canvas window with Google Maps tiles at given zoomlevel*)
|
||||
|
||||
val pixbuf : Latlong.geographic -> Latlong.geographic -> int -> GdkPixbuf.pixbuf
|
||||
(** [pixbuf south_west north_east zoomlevel] Returns a map background of the given area *)
|
||||
@@ -1,46 +0,0 @@
|
||||
(*
|
||||
* Displaying IGN Maps on a MapCanvas object
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
module LL = Latlong
|
||||
|
||||
let displayed_tiles = Hashtbl.create 41
|
||||
let mem_tile = fun t -> Hashtbl.mem displayed_tiles t.IGN.key
|
||||
let add_tile = fun t -> Hashtbl.add displayed_tiles t.IGN.key ()
|
||||
|
||||
|
||||
let opacity = 100 (* FIXME *)
|
||||
|
||||
(** Displaying the tile around the given point *)
|
||||
let display_tile = fun (geomap:MapCanvas.widget) wgs84 ->
|
||||
let tile = IGN.tile_of_geo wgs84 in
|
||||
|
||||
if not (mem_tile tile) then
|
||||
let jpg_file = IGN.get_tile tile in
|
||||
|
||||
let (sx,sy) = IGN.tile_size in
|
||||
let pixbuf = GdkPixbuf.from_file jpg_file in
|
||||
|
||||
let map = geomap#display_pixbuf ~opacity ((0,sx), tile.IGN.sw_corner) ((sy,0),tile.IGN.ne_corner) pixbuf in
|
||||
map#raise 1;
|
||||
add_tile tile
|
||||
@@ -1,25 +0,0 @@
|
||||
(*
|
||||
* Displaying IGN Maps on a MapCanvas object
|
||||
*
|
||||
* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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 display_tile : MapCanvas.widget -> Latlong.geographic -> unit
|
||||
@@ -1,337 +0,0 @@
|
||||
(*
|
||||
* Track objects
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
open Printf
|
||||
module G2d = Geometry_2d
|
||||
module LL = Latlong
|
||||
|
||||
module G = MapCanvas
|
||||
|
||||
module CL = ContrastLabel
|
||||
module ACI = AcIcon
|
||||
|
||||
let affine_pos_and_angle z xw yw angle =
|
||||
let rad_angle = angle /. 180. *. acos(-1.) in
|
||||
let cos_a = cos rad_angle in
|
||||
let sin_a = sin rad_angle in
|
||||
[| cos_a /. z ; sin_a /. z ; ~-. sin_a /. z; cos_a /. z; xw ; yw |]
|
||||
|
||||
let rec norm_angle_360 = fun alpha ->
|
||||
if alpha > 360.0 then norm_angle_360 (alpha -. 360.0)
|
||||
else if alpha < 0.0 then norm_angle_360 (alpha +. 360.0)
|
||||
else alpha
|
||||
|
||||
|
||||
(** variables used for handling cam moves: *)
|
||||
|
||||
let cam_half_aperture = LL.pi /. 6.0
|
||||
let half_pi = LL.pi /. 2.0
|
||||
|
||||
type desired =
|
||||
NoDesired
|
||||
| DesiredCircle of LL.geographic*float*GnoCanvas.ellipse
|
||||
| DesiredSegment of LL.geographic*LL.geographic*GnoCanvas.line
|
||||
|
||||
class track = fun ?(name="Noname") ?(icon="fixedwing") ?(size = 500) ?(color="red") ?(show_carrot=true) (ac_id:string) (geomap:MapCanvas.widget) ->
|
||||
let group = GnoCanvas.group geomap#canvas#root in
|
||||
let empty = ({LL.posn_lat=0.; LL.posn_long=0.}, GnoCanvas.line group) in
|
||||
let v_empty = ({LL.posn_lat=0.; LL.posn_long=0.}, 0.0) in
|
||||
|
||||
let aircraft = GnoCanvas.group group
|
||||
and track = GnoCanvas.group group in
|
||||
let icon_template = match icon with
|
||||
| "home" -> ACI.icon_home_template
|
||||
| "rotorcraft" -> ACI.icon_rotorcraft_template
|
||||
| "quadrotor" -> ACI.icon_quadrotor_template
|
||||
| "hexarotor" -> ACI.icon_hexarotor_template
|
||||
| "octorotor" -> ACI.icon_octorotor_template
|
||||
| "quadrotor_x" -> ACI.icon_quadrotor_x_template
|
||||
| "hexarotor_x" -> ACI.icon_hexarotor_x_template
|
||||
| "octorotor_x" -> ACI.icon_octorotor_x_template
|
||||
| "quadrotor_xi" -> ACI.icon_quadrotor_xi_template
|
||||
| "flyingwing" -> ACI.icon_flyingwing_template
|
||||
| "intruder" -> ACI.icon_intruder_template
|
||||
| "fixedwing" | _ -> ACI.icon_fixedwing_template
|
||||
in
|
||||
let _ac_icon = new ACI.widget ~color ~icon_template aircraft in
|
||||
let ac_label = new CL.widget ~name ~color 25. 25. group in
|
||||
|
||||
let carrot = GnoCanvas.group group in
|
||||
let _ac_carrot =
|
||||
if show_carrot then
|
||||
ignore (GnoCanvas.polygon ~points:[|0.;0.;-5.;-10.;5.;-10.|] ~props:[`WIDTH_UNITS 1.;`FILL_COLOR "orange"; `OUTLINE_COLOR "orange"; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] carrot)
|
||||
else ()
|
||||
in
|
||||
|
||||
let cam = GnoCanvas.group group in
|
||||
|
||||
(** rectangle representing the field covered by the cam *)
|
||||
let _ac_cam_targeted =
|
||||
ignore ( GnoCanvas.ellipse ~x1: (-. 2.5) ~y1: (-. 2.5 ) ~x2: 2.5 ~y2: 2.5 ~fill_color:color ~props:[`WIDTH_UNITS 1.; `OUTLINE_COLOR color; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam) in
|
||||
let _ = cam#hide () in
|
||||
|
||||
let mission_target = GnoCanvas.group group in
|
||||
|
||||
(** red circle : target of the mission *)
|
||||
let _ac_mission_target =
|
||||
ignore ( GnoCanvas.ellipse ~x1: (-5.) ~y1: (-5.) ~x2: 5. ~y2: 5. ~fill_color:"red" ~props:[`WIDTH_UNITS 1.; `OUTLINE_COLOR "red"; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] mission_target) in
|
||||
let _ = mission_target#hide () in
|
||||
|
||||
let _desired_circle = GnoCanvas.ellipse group
|
||||
and _desired_segment = GnoCanvas.line group in
|
||||
|
||||
let _ = aircraft#raise_to_top () in
|
||||
|
||||
object (self)
|
||||
val mutable top = 0
|
||||
val mutable color = color
|
||||
val mutable segments = Array.make size empty
|
||||
val mutable v_segments = Array.make size empty
|
||||
val mutable v_top = 0
|
||||
val mutable v_path = Array.make 10 v_empty
|
||||
val mutable last = None
|
||||
val mutable last_heading = 0.0
|
||||
val mutable last_altitude = 0.0
|
||||
val mutable last_speed = 0.0
|
||||
val mutable last_climb = 0.0
|
||||
val mutable last_flight_time = 0.0
|
||||
val mutable last_x_val = 0.0
|
||||
val mutable cam_on = false
|
||||
val mutable params_on = false
|
||||
val mutable v_params_on = false
|
||||
val mutable desired_track = NoDesired
|
||||
val zone = GnoCanvas.rect group
|
||||
val mutable ac_cam_cover = GnoCanvas.polygon ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam
|
||||
val mutable event_cb = None
|
||||
val mutable destroyed = false
|
||||
method color = color
|
||||
method set_color c = color <- c
|
||||
method track = track
|
||||
method v_path = v_path
|
||||
method aircraft = aircraft
|
||||
method id = ac_id
|
||||
method name = name
|
||||
method set_label = fun s ->
|
||||
ac_label#set_name s
|
||||
method clear_one = fun i ->
|
||||
if segments.(i) != empty then begin
|
||||
(snd segments.(i))#destroy ();
|
||||
segments.(i) <- empty
|
||||
end
|
||||
method incr = fun seg ->
|
||||
let s = Array.length seg in
|
||||
top <- (top + 1) mod s
|
||||
method v_incr = fun path ->
|
||||
let s = Array.length path in
|
||||
v_top <- (v_top + 1) mod s
|
||||
method clear = fun () ->
|
||||
for i = 0 to Array.length segments - 1 do
|
||||
self#clear_one i
|
||||
done;
|
||||
top <- 0
|
||||
method set_cam_state = fun b ->
|
||||
cam_on <- b;
|
||||
if b then begin
|
||||
cam#show ();
|
||||
mission_target#show ()
|
||||
end else begin
|
||||
cam#hide ();
|
||||
mission_target#hide ()
|
||||
end
|
||||
|
||||
method update_ap_status = fun time ->
|
||||
last_flight_time <- time
|
||||
method set_params_state = fun b ->
|
||||
params_on <- b;
|
||||
if not b then (* Reset to the default simple label *)
|
||||
ac_label#set_name name;
|
||||
ac_label#set_y 25.
|
||||
method set_v_params_state = fun b -> v_params_on <- b
|
||||
method set_last = fun x -> last <- x
|
||||
method last = last
|
||||
method pos = match last with Some pos -> pos | None -> failwith "No pos"
|
||||
method last_heading = last_heading
|
||||
method last_altitude = last_altitude
|
||||
method last_speed = last_speed
|
||||
method last_climb = last_climb
|
||||
|
||||
method height = fun () ->
|
||||
match last with
|
||||
None -> last_altitude
|
||||
| Some wgs84 ->
|
||||
let h = try float (Srtm.of_wgs84 wgs84) with _ -> 0. in
|
||||
last_altitude -. h
|
||||
|
||||
(** add track points on map2D, according to the
|
||||
track parameter and store altitude for the vertical path *)
|
||||
method add_point = fun geo alt ->
|
||||
self#clear_one top;
|
||||
let last_geo =
|
||||
match last with
|
||||
None -> geo
|
||||
| Some last_geo -> last_geo in
|
||||
segments.(top) <- (geo, geomap#segment ~group ~fill_color:color last_geo geo);
|
||||
self#incr segments;
|
||||
self#set_last (Some geo);
|
||||
v_path.(v_top) <- (geo, alt);
|
||||
self#v_incr v_path
|
||||
|
||||
method clear_map2D = self#clear ()
|
||||
|
||||
method move_icon = fun wgs84 heading altitude speed climb ->
|
||||
let (xw,yw) = geomap#world_of wgs84 in
|
||||
aircraft#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw heading);
|
||||
last_heading <- heading;
|
||||
last_altitude <- altitude;
|
||||
last_speed <- speed ;
|
||||
last_climb <- climb;
|
||||
|
||||
if params_on then begin
|
||||
let last_height = self#height () in
|
||||
ac_label#set_name (sprintf "%s\n%+.0f m\n%.1f m/s" name last_height last_speed);
|
||||
ac_label#set_y 70.
|
||||
end;
|
||||
|
||||
ac_label#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.);
|
||||
self#add_point wgs84 altitude;
|
||||
|
||||
method move_carrot = fun wgs84 ->
|
||||
let (xw,yw) = geomap#world_of wgs84 in
|
||||
carrot#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.);
|
||||
|
||||
(** draws the circular path to be followed by the aircraft in circle mode *)
|
||||
method draw_circle = fun en radius ->
|
||||
let create = fun () ->
|
||||
desired_track <- DesiredCircle (en, radius, geomap#circle ~color:"#00ff00" en radius) in
|
||||
match desired_track with
|
||||
DesiredCircle (c, r, circle) ->
|
||||
if c <> en || r <> radius then begin
|
||||
circle#destroy ();
|
||||
create ()
|
||||
end
|
||||
| DesiredSegment (p1,p2,s) ->
|
||||
s#destroy ();
|
||||
create ()
|
||||
| NoDesired ->
|
||||
create ()
|
||||
|
||||
(** draws the linear path to be followed by the aircraft between two waypoints *)
|
||||
method draw_segment = fun en1 en2 ->
|
||||
let create = fun () ->
|
||||
desired_track <- DesiredSegment (en1, en2, geomap#segment ~fill_color:"#00ff00" en1 en2) in
|
||||
match desired_track with
|
||||
DesiredCircle (c, r, circle) ->
|
||||
circle#destroy ();
|
||||
create ()
|
||||
| DesiredSegment (p1,p2,s) ->
|
||||
if p1 <> en1 || p2 <> en2 then begin
|
||||
s#destroy ();
|
||||
create ()
|
||||
end
|
||||
| NoDesired ->
|
||||
create ()
|
||||
|
||||
method delete_desired_track = fun () ->
|
||||
begin
|
||||
match desired_track with
|
||||
DesiredCircle (c, r, circle) ->
|
||||
circle#destroy ()
|
||||
| DesiredSegment (p1,p2,s) ->
|
||||
s#destroy ();
|
||||
| NoDesired ->
|
||||
()
|
||||
end;
|
||||
desired_track <- NoDesired
|
||||
|
||||
method draw_zone = fun geo1 geo2 ->
|
||||
let (x1, y1) = geomap#world_of geo1
|
||||
and (x2, y2) = geomap#world_of geo2 in
|
||||
zone#set [`X1 x1; `Y1 y1; `X2 x2; `Y2 y2; `OUTLINE_COLOR "#ffc0c0"; `WIDTH_PIXELS 2]
|
||||
|
||||
(** moves the rectangle representing the field covered by the camera *)
|
||||
method move_cam = fun positions mission_target_wgs84 ->
|
||||
match last, cam_on with
|
||||
Some last_ac, true ->
|
||||
let points = geomap#convert_positions_to_points positions in
|
||||
ac_cam_cover#set [`POINTS points;
|
||||
`OUTLINE_COLOR color];
|
||||
let (mission_target_xw, mission_target_yw) = geomap#world_of mission_target_wgs84 in
|
||||
mission_target#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value mission_target_xw mission_target_yw 0.0)
|
||||
| _ -> ()
|
||||
method zoom = fun z ->
|
||||
let a = aircraft#i2w_affine in
|
||||
let z' = sqrt (a.(0)*.a.(0)+.a.(1)*.a.(1)) in
|
||||
for i = 0 to 3 do a.(i) <- a.(i) /. z' *. 1./.z done;
|
||||
aircraft#affine_absolute a
|
||||
|
||||
method resize = fun new_size ->
|
||||
let a = Array.make new_size empty in
|
||||
let size = Array.length segments in
|
||||
let m = min new_size size in
|
||||
let j = ref ((top - m + size) mod size) in
|
||||
for i = 0 to m - 1 do
|
||||
a.(i) <- segments.(!j);
|
||||
j := (!j + 1) mod size
|
||||
done;
|
||||
for i = 1 to size - new_size do (* Never done if new_size > size *)
|
||||
self#clear_one !j;
|
||||
j := (!j + 1) mod size
|
||||
done;
|
||||
top <- m mod new_size;
|
||||
segments <- a
|
||||
|
||||
method size = Array.length segments
|
||||
|
||||
method event (ev : GnoCanvas.item_event) =
|
||||
begin
|
||||
match ev with
|
||||
| `BUTTON_PRESS ev ->
|
||||
begin
|
||||
match GdkEvent.Button.button ev with
|
||||
| 1 ->
|
||||
begin
|
||||
match event_cb with
|
||||
| Some cb -> cb ac_id
|
||||
| None -> ()
|
||||
end
|
||||
| _ -> ()
|
||||
end
|
||||
| _ -> ()
|
||||
end;
|
||||
true
|
||||
initializer ignore(aircraft#connect#event self#event)
|
||||
|
||||
method set_event_cb = fun (cb: string -> unit) -> event_cb <- Some cb
|
||||
|
||||
initializer
|
||||
(* could not properly disconnect adjustment signal, so only calling zoom method if group is still displayed *)
|
||||
ignore(geomap#zoom_adj#connect#value_changed (fun () -> if not destroyed then self#zoom geomap#zoom_adj#value));
|
||||
ignore(group#connect#destroy (fun () -> destroyed <- true))
|
||||
|
||||
(* destroy method *)
|
||||
method destroy = fun () -> group#destroy ()
|
||||
|
||||
initializer
|
||||
Gc.finalise (fun self -> self#destroy ()) self
|
||||
end
|
||||
@@ -1,74 +0,0 @@
|
||||
(*
|
||||
* Track objects
|
||||
*
|
||||
* Copyright (C) 2004-2010 CENA/ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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 track :
|
||||
?name:string ->
|
||||
?icon:string ->
|
||||
?size:int ->
|
||||
?color:string ->
|
||||
?show_carrot:bool ->
|
||||
string ->
|
||||
MapCanvas.widget ->
|
||||
object
|
||||
method add_point : Latlong.geographic -> float -> unit
|
||||
method aircraft : GnoCanvas.group
|
||||
method id : string
|
||||
method name : string
|
||||
method clear : unit -> unit
|
||||
method clear_map2D : unit
|
||||
method clear_one : int -> unit
|
||||
method color : string
|
||||
method delete_desired_track : unit -> unit
|
||||
method draw_circle : Latlong.geographic -> Latlong.fmeter -> unit
|
||||
method draw_segment : Latlong.geographic -> Latlong.geographic -> unit
|
||||
method draw_zone : Latlong.geographic -> Latlong.geographic -> unit
|
||||
method height : unit -> float
|
||||
method incr : (Latlong.geographic * GnoCanvas.line) array -> unit
|
||||
method last : Latlong.geographic option
|
||||
method last_altitude : float
|
||||
method last_climb : float
|
||||
method last_heading : float
|
||||
method last_speed : float
|
||||
method move_cam : Latlong.geographic array -> Latlong.geographic -> unit
|
||||
method move_carrot : Latlong.geographic -> unit
|
||||
method move_icon :
|
||||
Latlong.geographic -> float -> float -> float -> float -> unit
|
||||
method pos : Latlong.geographic
|
||||
method resize : int -> unit
|
||||
method set_cam_state : bool -> unit
|
||||
method set_color : string -> unit
|
||||
method set_label : string -> unit
|
||||
method set_last : Latlong.geographic option -> unit
|
||||
method set_params_state : bool -> unit
|
||||
method set_v_params_state : bool -> unit
|
||||
method size : int
|
||||
method track : GnoCanvas.group
|
||||
method update_ap_status : float -> unit
|
||||
method v_incr : (Latlong.geographic * float) array -> unit
|
||||
method v_path : (Latlong.geographic * float) array
|
||||
method zoom : float -> unit
|
||||
method event : GnoCanvas.item_event -> bool
|
||||
method set_event_cb : (string -> unit) -> unit
|
||||
method destroy : unit -> unit
|
||||
end
|
||||
@@ -1,309 +0,0 @@
|
||||
(*
|
||||
* Waypoints objects
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
module LL = Latlong
|
||||
open Printf
|
||||
open LL
|
||||
|
||||
module CL = ContrastLabel
|
||||
|
||||
(*
|
||||
* Waypoint label offsets
|
||||
*)
|
||||
let s = 6. (* x offset *)
|
||||
|
||||
class group = fun ?(color="red") ?(editable=true) ?(show_moved=false) (geomap:MapCanvas.widget) ->
|
||||
let g = GnoCanvas.group geomap#canvas#root in
|
||||
object
|
||||
method group=g
|
||||
method geomap=geomap
|
||||
method color=color
|
||||
method editable=editable
|
||||
method show_moved = show_moved
|
||||
end
|
||||
|
||||
let rotation_45 =
|
||||
let s = sin (Latlong.pi/.4.) in
|
||||
[|s;s;-.s;s;0.;0.|]
|
||||
|
||||
class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) wgs84 ->
|
||||
let geomap=wpts_group#geomap
|
||||
and color = wpts_group#color
|
||||
and editable = wpts_group#editable in
|
||||
let xw, yw = geomap#world_of wgs84 in
|
||||
let callbacks = Hashtbl.create 5 in
|
||||
let updated () =
|
||||
Hashtbl.iter (fun cb _ -> cb ()) callbacks in
|
||||
|
||||
let wpt_group = GnoCanvas.group wpts_group#group in
|
||||
|
||||
let item =
|
||||
GnoCanvas.rect wpt_group ~x1:(-.s) ~y1:(-.s) ~x2:s ~y2:s ~props:[`FILL_COLOR color; `OUTLINE_COLOR "black"] in
|
||||
|
||||
let anim = function
|
||||
None ->
|
||||
Some (Glib.Timeout.add 500 (fun () -> Gdk.X.beep (); item#affine_relative rotation_45; true))
|
||||
| Some x -> Some x in
|
||||
|
||||
|
||||
object (self)
|
||||
val mutable x0 = 0.
|
||||
val mutable y0 = 0.
|
||||
|
||||
val label = new CL.widget ~name:name ~color:"white" s 0. wpt_group
|
||||
val mutable name = name (* FIXME: already in label ! *)
|
||||
val mutable alt = alt
|
||||
val mutable ground_alt = 0.
|
||||
val mutable moved = None
|
||||
val mutable deleted = false
|
||||
val mutable commit_cb = None
|
||||
initializer
|
||||
if not show then wpt_group#hide ()
|
||||
initializer
|
||||
item#affine_absolute rotation_45;
|
||||
self#move xw yw
|
||||
method connect = fun (cb:unit -> unit) ->
|
||||
Hashtbl.add callbacks cb ()
|
||||
method set_commit_callback = fun (cb:unit -> unit) -> commit_cb <- Some cb
|
||||
method name = name
|
||||
method set_name n =
|
||||
if n <> name then begin
|
||||
name <- n;
|
||||
label#set_name name
|
||||
end
|
||||
method geomap = geomap
|
||||
method alt = alt
|
||||
method label = label
|
||||
method xy = let a = wpt_group#i2w_affine in (a.(4), a.(5))
|
||||
method move dx dy =
|
||||
wpt_group#move dx dy;
|
||||
wpt_group#raise_to_top ()
|
||||
method edit =
|
||||
let dialog = GWindow.window ~type_hint:`DIALOG ~modal:true ~position:`MOUSE ~border_width:10 ~title:"Waypoint Edit" () in
|
||||
let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in
|
||||
|
||||
let ename = GEdit.entry ~text:name ~editable ~packing:dvbx#add () in
|
||||
let hbox = GPack.hbox ~packing:dvbx#add () in
|
||||
|
||||
let optmenu = GMenu.option_menu ~packing:hbox#add () in
|
||||
let e_pos = GEdit.entry ~width_chars:25 ~packing:hbox#add () in
|
||||
|
||||
(* We would like to share the menu of the map: it does not work ! *)
|
||||
let selected_georef = ref WGS84_dec in
|
||||
let display_coordinates = fun () ->
|
||||
e_pos#set_text (string_of_coordinates !selected_georef self#pos)
|
||||
and set_coordinates = fun () ->
|
||||
self#set (geographic_of_coordinates !selected_georef e_pos#text) in
|
||||
|
||||
display_coordinates ();
|
||||
|
||||
let initial_wgs84 = self#pos in
|
||||
|
||||
let menu = GMenu.menu () in
|
||||
let set = fun kind () ->
|
||||
set_coordinates ();
|
||||
selected_georef := kind;
|
||||
display_coordinates () in
|
||||
let mi = GMenu.menu_item ~label:"WGS84" ~packing:menu#append () in
|
||||
ignore (mi#connect#activate ~callback:(set WGS84_dec));
|
||||
let mi = GMenu.menu_item ~label:"WGS84_dms" ~packing:menu#append () in
|
||||
ignore (mi#connect#activate ~callback:(set WGS84_dms));
|
||||
let mi = GMenu.menu_item ~label:"LambertIIe" ~packing:menu#append () in
|
||||
ignore (mi#connect#activate ~callback:(set LBT2e));
|
||||
List.iter (fun (label, geo) ->
|
||||
let mi = GMenu.menu_item ~label ~packing:menu#append () in
|
||||
ignore (mi#connect#activate ~callback:(set (Bearing geo))))
|
||||
geomap#georefs;
|
||||
optmenu#set_menu menu;
|
||||
|
||||
let ha = GPack.hbox ~packing:dvbx#add () in
|
||||
let minus10= GButton.button ~label:"-10" ~packing:ha#add () in
|
||||
(* let ea = GEdit.entry ~text:(string_of_float alt) ~packing:ha#add () in *)
|
||||
let ea = GEdit.spin_button ~rate:0. ~digits:2 ~width:50 ~packing:ha#add ()
|
||||
and adj = GData.adjustment
|
||||
~value:alt ~lower:(-100.) ~upper:10000.
|
||||
~step_incr:1. ~page_incr:10.0 ~page_size:0. () in
|
||||
ea#set_adjustment adj;
|
||||
ea#set_value alt; (* this should be done by set_adjustment but seems to fail on ubuntu 13.10 (at least) *)
|
||||
|
||||
let agl = alt -. (try float (Srtm.of_wgs84 initial_wgs84) with _ -> ground_alt) in
|
||||
let agl_lab = GMisc.label ~text:(sprintf " AGL: %4.0fm" agl) ~packing:ha#add () in
|
||||
let plus10= GButton.button ~label:"+10" ~packing:ha#add () in
|
||||
let change_alt = fun x ->
|
||||
ea#set_value (ea#value +. x) in
|
||||
ignore(minus10#connect#pressed (fun _ -> change_alt (-10.)));
|
||||
ignore(plus10#connect#pressed (fun _ -> change_alt (10.)));
|
||||
|
||||
(* called when ok button is clicked in WP Edit dialog *)
|
||||
let callback = fun _ ->
|
||||
geomap#edit_georef_name name ename#text;
|
||||
self#set_name ename#text;
|
||||
alt <- ea#value;
|
||||
label#set_name name;
|
||||
set_coordinates ();
|
||||
updated ();
|
||||
if wpts_group#show_moved then
|
||||
moved <- anim moved;
|
||||
begin
|
||||
match commit_cb with
|
||||
Some cb -> cb ()
|
||||
| None -> ()
|
||||
end;
|
||||
dialog#destroy ()
|
||||
in
|
||||
let dhbx = GPack.box `HORIZONTAL ~packing: dvbx#add () in
|
||||
|
||||
let cancel = GButton.button ~stock:`CANCEL ~packing: dhbx#add () in
|
||||
let destroy = fun () ->
|
||||
self#set initial_wgs84;
|
||||
self#reset_moved ();
|
||||
wpt_group#lower_to_bottom ();
|
||||
dialog#destroy () in
|
||||
ignore(cancel#connect#clicked ~callback:destroy);
|
||||
|
||||
(** Delete button for editable waypoints *)
|
||||
if editable then begin
|
||||
let delete = GButton.button ~stock:`DELETE ~packing: dhbx#add () in
|
||||
let delete_callback = fun () ->
|
||||
dialog#destroy ();
|
||||
self#delete ();
|
||||
geomap#delete_georef name;
|
||||
updated ()
|
||||
in
|
||||
ignore(delete#connect#clicked ~callback:delete_callback)
|
||||
end;
|
||||
|
||||
let ok = GButton.button ~stock:`OK ~packing: dhbx#add () in
|
||||
List.iter
|
||||
(fun e -> ignore (e#connect#activate ~callback))
|
||||
[ename; e_pos];
|
||||
ok#grab_default ();
|
||||
|
||||
ignore(ok#connect#clicked ~callback:(fun _ -> callback (); dialog#destroy ()));
|
||||
|
||||
(* Update AGL on pos or alt change *)
|
||||
let callback = fun _ ->
|
||||
try
|
||||
set_coordinates ();
|
||||
let wgs84 = self#pos in
|
||||
let agl = ea#value -. (try float (Srtm.of_wgs84 wgs84) with _ -> ground_alt) in
|
||||
agl_lab#set_text (sprintf " AGL: %4.0fm" agl)
|
||||
with _ -> ()
|
||||
in
|
||||
ignore (ea#connect#changed ~callback);
|
||||
ignore (e_pos#connect#changed ~callback);
|
||||
dialog#show ()
|
||||
|
||||
val mutable motion = false
|
||||
method event (ev : GnoCanvas.item_event) =
|
||||
begin
|
||||
match ev with
|
||||
| `BUTTON_PRESS ev ->
|
||||
begin
|
||||
match GdkEvent.Button.button ev with
|
||||
| 1 ->
|
||||
motion <- false;
|
||||
let x = GdkEvent.Button.x ev
|
||||
and y = GdkEvent.Button.y ev in
|
||||
x0 <- x; y0 <- y;
|
||||
let curs = Gdk.Cursor.create `FLEUR in
|
||||
item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs
|
||||
(GdkEvent.Button.time ev)
|
||||
| _ -> ()
|
||||
end
|
||||
| `MOTION_NOTIFY ev ->
|
||||
let state = GdkEvent.Motion.state ev in
|
||||
if Gdk.Convert.test_modifier `BUTTON1 state then begin
|
||||
motion <- true;
|
||||
let x = GdkEvent.Motion.x ev
|
||||
and y = GdkEvent.Motion.y ev in
|
||||
let dx = geomap#current_zoom *. (x-. x0)
|
||||
and dy = geomap#current_zoom *. (y -. y0) in
|
||||
self#move dx dy ;
|
||||
updated ();
|
||||
if wpts_group#show_moved then
|
||||
moved <- anim moved;
|
||||
x0 <- x; y0 <- y
|
||||
end
|
||||
| `BUTTON_RELEASE ev ->
|
||||
if GdkEvent.Button.button ev = 1 then begin
|
||||
item#ungrab (GdkEvent.Button.time ev);
|
||||
self#edit
|
||||
end
|
||||
| _ -> ()
|
||||
end;
|
||||
true
|
||||
initializer ignore(item#connect#event self#event)
|
||||
method moved = moved <> None
|
||||
method reset_moved () =
|
||||
match moved with
|
||||
| None -> ()
|
||||
| Some x ->
|
||||
Glib.Timeout.remove x;
|
||||
item#affine_absolute rotation_45;
|
||||
moved <- None
|
||||
|
||||
method deleted = deleted
|
||||
method item = item
|
||||
method pos = geomap#of_world self#xy
|
||||
method set ?altitude ?(update=false) wgs84 =
|
||||
let (xw, yw) = geomap#world_of wgs84
|
||||
and (xw0, yw0) = self#xy
|
||||
and z = geomap#zoom_adj#value in
|
||||
|
||||
let dx = (xw-.xw0)*.z
|
||||
and dy = (yw-.yw0)*.z
|
||||
and dz = match altitude with Some a -> a -. alt | _ -> 0. in
|
||||
|
||||
let current_ecef = ecef_of_geo WGS84 self#pos self#alt
|
||||
and new_ecef = ecef_of_geo WGS84 wgs84 (alt+.dz) in
|
||||
|
||||
let new_pos = ecef_distance current_ecef new_ecef > 2. in
|
||||
match moved, new_pos with
|
||||
| None, _ ->
|
||||
self#move dx dy;
|
||||
alt <- alt+.dz;
|
||||
if update then updated ()
|
||||
| Some _, true -> ()
|
||||
| Some _, false -> self#reset_moved ()
|
||||
method set_ground_alt ga = ground_alt <- ga
|
||||
method delete () =
|
||||
deleted <- true; (* BOF *)
|
||||
geomap#delete_georef name;
|
||||
wpt_group#destroy ()
|
||||
method zoom (z:float) =
|
||||
if List.length wpt_group#get_items > 0 then
|
||||
let a = wpt_group#i2w_affine in
|
||||
a.(0) <- 1./.z; a.(3) <- 1./.z;
|
||||
wpt_group#affine_absolute a
|
||||
initializer wpt_group#raise_to_top ()
|
||||
initializer self#zoom geomap#zoom_adj#value
|
||||
initializer ignore(geomap#zoom_adj#connect#value_changed (fun () -> self#zoom geomap#zoom_adj#value))
|
||||
end
|
||||
|
||||
let gensym = let n = ref 0 in fun prefix -> incr n; prefix ^ string_of_int !n
|
||||
|
||||
let waypoint = fun ?show group ?(name = gensym "wp") ?alt en ->
|
||||
new waypoint ?show group name ?alt en
|
||||
|
||||
@@ -1,68 +0,0 @@
|
||||
(*
|
||||
* Waypoints objects
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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 group :
|
||||
?color:string ->
|
||||
?editable:bool ->
|
||||
?show_moved:bool ->
|
||||
MapCanvas.widget ->
|
||||
object
|
||||
method color : string
|
||||
method editable : bool
|
||||
method show_moved : bool
|
||||
method geomap : MapCanvas.widget
|
||||
method group : GnoCanvas.group
|
||||
end
|
||||
|
||||
class waypoint :
|
||||
?show:bool ->
|
||||
group ->
|
||||
string ->
|
||||
?alt:float ->
|
||||
Latlong.geographic ->
|
||||
object
|
||||
method alt : float
|
||||
method geomap : MapCanvas.widget
|
||||
method delete : unit -> unit
|
||||
method edit : unit
|
||||
method pos : Latlong.geographic
|
||||
method event : GnoCanvas.item_event -> bool
|
||||
method item : GnoCanvas.rect
|
||||
method label : ContrastLabel.widget
|
||||
method move : float -> float -> unit
|
||||
method name : string
|
||||
method set : ?altitude:float -> ?update:bool -> Latlong.geographic -> unit
|
||||
method set_ground_alt : float -> unit
|
||||
method set_name : string -> unit
|
||||
method xy : float * float
|
||||
method zoom : float -> unit
|
||||
method moved : bool
|
||||
method reset_moved : unit -> unit
|
||||
method deleted : bool
|
||||
method connect : (unit -> unit) -> unit
|
||||
method set_commit_callback : (unit -> unit) -> unit
|
||||
end
|
||||
|
||||
|
||||
val waypoint : ?show:bool -> group -> ?name:string -> ?alt:float -> Latlong.geographic -> waypoint
|
||||
@@ -1,32 +0,0 @@
|
||||
#include <string.h>
|
||||
#include <gtk/gtk.h>
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/callback.h>
|
||||
#include <caml/fail.h>
|
||||
|
||||
extern value Val_GtkTreePath(GtkTreePath*);
|
||||
|
||||
#define Pointer_val(val) ((void*)Field(val,1))
|
||||
|
||||
#ifdef G_DISABLE_CAST_CHECKS
|
||||
#define check_cast(f,v) f(Pointer_val(v))
|
||||
#else
|
||||
#define check_cast(f,v) (Pointer_val(v) == NULL ? NULL : f(Pointer_val(v)))
|
||||
#endif
|
||||
|
||||
#define GtkTreeView_val(val) check_cast(GTK_TREE_VIEW,val)
|
||||
|
||||
CAMLprim value
|
||||
ml_gtk_tree_view_get_drag_dest_row(value val_tree) {
|
||||
CAMLparam0();
|
||||
CAMLlocal1(ret);
|
||||
GtkTreePath *path;
|
||||
GtkTreeViewDropPosition pos;
|
||||
gtk_tree_view_get_drag_dest_row(GtkTreeView_val(val_tree), &path, &pos);
|
||||
ret = alloc_tuple(2);
|
||||
Store_field(ret,0,Val_GtkTreePath(path));
|
||||
Store_field(ret,1,Val_int(pos));
|
||||
CAMLreturn(ret);
|
||||
}
|
||||
@@ -1,423 +0,0 @@
|
||||
(*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
open Printf
|
||||
|
||||
module PC = Papget_common
|
||||
module PR = Papget_renderer
|
||||
module E = Expr_syntax
|
||||
let (//) = Filename.concat
|
||||
|
||||
class type item = object
|
||||
method config : unit -> Xml.xml
|
||||
method deleted : bool
|
||||
end
|
||||
|
||||
class type value =
|
||||
object
|
||||
method last_value : string
|
||||
method connect : (string -> unit) -> unit
|
||||
method config : unit -> Xml.xml list
|
||||
method type_ : string
|
||||
end
|
||||
|
||||
|
||||
|
||||
(** [index_of_fields s] Returns i if s matches x[i] else 0. *)
|
||||
let base_and_index =
|
||||
let field_regexp = Str.regexp "\\([^\\.]+\\)\\[\\([0-9]+\\)\\]" in
|
||||
fun field_descr ->
|
||||
if Str.string_match field_regexp field_descr 0 then
|
||||
( Str.matched_group 1 field_descr,
|
||||
int_of_string (Str.matched_group 2 field_descr))
|
||||
else
|
||||
(field_descr, 0)
|
||||
|
||||
|
||||
class message_field = fun ?sender ?(class_name="telemetry") msg_name field_descr ->
|
||||
object
|
||||
val mutable callbacks = []
|
||||
val mutable last_value = "0."
|
||||
|
||||
method last_value = last_value
|
||||
|
||||
method connect = fun cb -> callbacks <- cb :: callbacks
|
||||
method config = fun () ->
|
||||
let field = sprintf "%s:%s" msg_name field_descr in
|
||||
let ac_id = match sender with None -> [] | Some id -> [PC.property "ac_id" id] in
|
||||
[ PC.property "field" field ] @ ac_id
|
||||
method type_ = "message_field"
|
||||
|
||||
initializer
|
||||
let module P = PprzLink.Messages (struct let name = class_name end) in
|
||||
let process_message = fun _sender values ->
|
||||
let (field_name, index) = base_and_index field_descr in
|
||||
let value =
|
||||
match PprzLink.assoc field_name values with
|
||||
PprzLink.Array array -> array.(index)
|
||||
| scalar -> scalar in
|
||||
|
||||
last_value <- PprzLink.string_of_value value;
|
||||
|
||||
List.iter (fun cb -> cb last_value) callbacks in
|
||||
ignore (P.message_bind ?sender msg_name process_message)
|
||||
end
|
||||
|
||||
|
||||
let hash_vars = fun ?sender expr ->
|
||||
let htable = Hashtbl.create 3 in
|
||||
let rec loop = function
|
||||
E.Ident i -> prerr_endline i
|
||||
| E.Int _ | E.Float _ -> ()
|
||||
| E.Call (_id, list) | E.CallOperator (_id, list) -> List.iter loop list
|
||||
| E.Index (_id, e) -> loop e
|
||||
| E.Deref (_e, _f) as deref -> fprintf stderr "Warning: Deref operator is not allowed in Papgets expressions (%s)" (E.sprint deref)
|
||||
| E.Field (i, f) ->
|
||||
if not (Hashtbl.mem htable (i,f)) then
|
||||
let msg_obj = new message_field ?sender i f in
|
||||
Hashtbl.add htable (i, f) msg_obj in
|
||||
loop expr;
|
||||
htable
|
||||
|
||||
|
||||
let wrap = fun f ->
|
||||
fun x y -> string_of_float (f (float_of_string x) (float_of_string y))
|
||||
let eval_bin_op = function
|
||||
| "*" -> wrap ( *. )
|
||||
| "+" -> wrap ( +. )
|
||||
| "-" -> wrap ( -. )
|
||||
| "/" -> wrap ( /. )
|
||||
| "**" -> wrap ( ** )
|
||||
| op -> failwith (sprintf "Papget.eval_expr '%s'" op)
|
||||
|
||||
let eval_expr = fun (extra_functions:(string * (string list -> string)) list) h e ->
|
||||
let rec loop = function
|
||||
E.Ident ident -> failwith (sprintf "Papget.eval_expr '%s'" ident)
|
||||
| E.Int int -> string_of_int int
|
||||
| E.Float float -> string_of_float float
|
||||
| E.CallOperator (ident, [e1; e2]) ->
|
||||
eval_bin_op ident (loop e1) (loop e2)
|
||||
| E.Call (ident, args) when List.mem_assoc ident extra_functions ->
|
||||
(List.assoc ident extra_functions) (List.map loop args)
|
||||
| E.Call (ident, _l) | E.CallOperator (ident, _l) ->
|
||||
failwith (sprintf "Papget.eval_expr '%s(...)'" ident)
|
||||
| E.Index (ident, _e) -> failwith (sprintf "Papget.eval_expr '%s[...]'" ident)
|
||||
| E.Deref (_e, _f) as deref -> failwith (sprintf "Papget.eval_expr Deref operator is not allowed in Papgets expressions (%s)" (E.sprint deref))
|
||||
| E.Field (i, f) ->
|
||||
try
|
||||
(Hashtbl.find h (i,f))#last_value
|
||||
with
|
||||
Not_found -> failwith (sprintf "Papget.eval_expr '%s.%s'" i f)
|
||||
in loop e
|
||||
|
||||
|
||||
|
||||
class expression = fun ?(extra_functions=[]) ?sender expr ->
|
||||
let h = hash_vars ?sender expr in
|
||||
object
|
||||
val mutable callbacks = []
|
||||
val mutable last_value = "0."
|
||||
|
||||
method last_value = last_value
|
||||
|
||||
method connect = fun cb -> callbacks <- cb :: callbacks
|
||||
|
||||
method config = fun () ->
|
||||
let ac_id = match sender with None -> [] | Some id -> [PC.property "ac_id" id] in
|
||||
[ PC.property "expr" (Expr_syntax.sprint expr)] @ ac_id
|
||||
|
||||
method type_ = "expression"
|
||||
|
||||
initializer
|
||||
Hashtbl.iter
|
||||
(fun (i,f) (msg_obj:value) ->
|
||||
let val_updated = fun _new_val ->
|
||||
last_value <- eval_expr extra_functions h expr;
|
||||
List.iter (fun cb -> cb last_value) callbacks
|
||||
in
|
||||
msg_obj#connect val_updated)
|
||||
h
|
||||
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_item = fun ~config canvas_renderer ->
|
||||
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 dialog_widget = None
|
||||
|
||||
method renderer = renderer
|
||||
|
||||
method xy =
|
||||
let (x0, y0) = renderer#item#i2w 0. 0. in
|
||||
renderer#item#parent#w2i x0 y0
|
||||
|
||||
method deleted = deleted
|
||||
|
||||
method update = fun value ->
|
||||
try
|
||||
(renderer#update:string->unit) value
|
||||
with
|
||||
exc -> prerr_endline (Printexc.to_string exc)
|
||||
|
||||
method event = fun (ev : GnoCanvas.item_event) ->
|
||||
let item = (renderer#item :> PR.movable_item) in
|
||||
match ev with
|
||||
`BUTTON_PRESS ev ->
|
||||
begin
|
||||
match GdkEvent.Button.button ev with
|
||||
| 1 ->
|
||||
motion <- false;
|
||||
let x = GdkEvent.Button.x ev and y = GdkEvent.Button.y ev in
|
||||
let (xm, ym) = renderer#item#parent#w2i x y in
|
||||
let (x0, y0) = renderer#item#i2w 0. 0. in
|
||||
let (xi, yi) = renderer#item#parent#w2i x0 y0 in
|
||||
x_press <- xm -. xi; y_press <- ym -. yi;
|
||||
let curs = Gdk.Cursor.create `FLEUR in
|
||||
item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs
|
||||
(GdkEvent.Button.time ev)
|
||||
| _ -> ()
|
||||
end;
|
||||
true
|
||||
| `MOTION_NOTIFY ev ->
|
||||
let state = GdkEvent.Motion.state ev in
|
||||
if Gdk.Convert.test_modifier `BUTTON1 state then begin
|
||||
motion <- true;
|
||||
let x = GdkEvent.Motion.x ev
|
||||
and y = GdkEvent.Motion.y ev in
|
||||
let (xw, yw) = renderer#item#parent#w2i x y in
|
||||
item#set [`X (xw-.x_press); `Y (yw-.y_press)];
|
||||
renderer#item#parent#affine_relative [|1.;0.;0.;1.;0.;0.|]
|
||||
end;
|
||||
true
|
||||
| `BUTTON_RELEASE ev ->
|
||||
if GdkEvent.Button.button ev = 1 then begin
|
||||
item#ungrab (GdkEvent.Button.time ev);
|
||||
(* get item and window size *)
|
||||
let bounds = item#get_bounds in
|
||||
let w, h = Gdk.Drawable.get_size item#canvas#misc#window in
|
||||
if not motion then begin
|
||||
self#edit ()
|
||||
end
|
||||
else if (truncate bounds.(0) > w) || (truncate bounds.(2) < 0) || (truncate bounds.(1) > h) || (truncate bounds.(3) < 0) then begin
|
||||
(* delete an item if placed out of the window on the left or top side *)
|
||||
item#destroy ();
|
||||
deleted <- true
|
||||
end;
|
||||
motion <- false
|
||||
end;
|
||||
true
|
||||
| _ -> false
|
||||
|
||||
method edit = fun () ->
|
||||
let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in
|
||||
let dialog = new Gtk_papget_editor.papget_editor ~file () in
|
||||
|
||||
let ac_id = PC.get_prop "ac_id" config "Any" in
|
||||
dialog#toplevel#set_title ("Papget Editor (A/C: "^ac_id^")");
|
||||
|
||||
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
|
||||
tree#foreach
|
||||
(fun _path row ->
|
||||
if tree#get ~row ~column = renderer#tag then begin
|
||||
combo#set_active_iter (Some row);
|
||||
true
|
||||
end else
|
||||
false);
|
||||
|
||||
let connect_item_editor = fun () ->
|
||||
begin (* Remove the current child ? *)
|
||||
try
|
||||
let child = dialog#box_item_editor#child in
|
||||
dialog#box_item_editor#remove child
|
||||
with
|
||||
Gpointer.Null -> ()
|
||||
end;
|
||||
renderer#edit dialog#box_item_editor#add in
|
||||
|
||||
connect_item_editor ();
|
||||
|
||||
(* Connect the renderer chooser *)
|
||||
ignore (combo#connect#changed
|
||||
(fun () ->
|
||||
match combo#active_iter with
|
||||
| None -> ()
|
||||
| Some row ->
|
||||
let data = combo#model#get ~row ~column in
|
||||
if data <> renderer#tag then
|
||||
let new_renderer = List.assoc data tagged_renderers in
|
||||
let group = renderer#item#parent in
|
||||
let (x, y) = renderer#item#i2w 0. 0. in
|
||||
let (x, y) = group#w2i x y in
|
||||
renderer#item#destroy ();
|
||||
renderer <- new_renderer group x y;
|
||||
self#connect ();
|
||||
connect_item_editor ()));
|
||||
|
||||
(* Connect the buttons *)
|
||||
ignore (dialog#button_delete#connect#clicked
|
||||
(fun () ->
|
||||
dialog#papget_editor#destroy ();
|
||||
renderer#item#destroy ();
|
||||
deleted <- true));
|
||||
ignore (dialog#button_ok#connect#clicked (fun () -> dialog#papget_editor#destroy ()));
|
||||
|
||||
dialog_widget <- Some dialog
|
||||
|
||||
val mutable connection =
|
||||
canvas_renderer#item#connect#event (fun _ -> false)
|
||||
method connect = fun () ->
|
||||
if PC.get_prop "locked" config "false" = "false" then
|
||||
let item = (renderer#item :> PR.movable_item) in
|
||||
connection <- item#connect#event self#event
|
||||
|
||||
initializer
|
||||
self#connect ()
|
||||
end
|
||||
|
||||
class canvas_float_item = fun ~config canvas_renderer ->
|
||||
object
|
||||
inherit canvas_item ~config canvas_renderer as super
|
||||
|
||||
val mutable affine = "1"
|
||||
|
||||
method update = fun value ->
|
||||
let scaled_value =
|
||||
try
|
||||
let (a, b) = Ocaml_tools.affine_transform affine
|
||||
and fvalue = float_of_string value in
|
||||
string_of_float (fvalue *. a +. b)
|
||||
with
|
||||
_ -> value in
|
||||
super#update scaled_value
|
||||
|
||||
method edit = fun () ->
|
||||
super#edit ();
|
||||
match dialog_widget with
|
||||
None -> ()
|
||||
| Some dialog ->
|
||||
(* 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);
|
||||
dialog#hbox_scale#misc#show ()
|
||||
end
|
||||
|
||||
|
||||
class canvas_display_float_item = fun ~config (msg_obj:value) (canvas_renderer:PR.t) ->
|
||||
object (self)
|
||||
inherit canvas_float_item ~config canvas_renderer as item
|
||||
|
||||
initializer
|
||||
affine <- PC.get_prop "scale" config "1";
|
||||
msg_obj#connect self#update_field
|
||||
|
||||
method update_field = fun value ->
|
||||
if not deleted then begin
|
||||
item#update value
|
||||
end
|
||||
|
||||
method config = fun () ->
|
||||
let renderer_props = renderer#config ()
|
||||
and val_props = msg_obj#config ()
|
||||
and scale_prop = PC.property "scale" affine in
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", msg_obj#type_;
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, scale_prop::val_props@renderer_props)
|
||||
end
|
||||
|
||||
|
||||
(****************************************************************************)
|
||||
(** A clickable item is not editable: The #edit method is overiden with a
|
||||
provided callback *)
|
||||
class canvas_clickable_item = fun type_ properties callback canvas_renderer ->
|
||||
object
|
||||
inherit canvas_item ~config:properties canvas_renderer as item
|
||||
method edit = fun () -> callback ()
|
||||
|
||||
method config = fun () ->
|
||||
let props = renderer#config () in
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", type_;
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, properties@props)
|
||||
end
|
||||
|
||||
|
||||
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:PR.t) ->
|
||||
object
|
||||
inherit canvas_clickable_item "variable_setting" properties callback canvas_renderer
|
||||
end
|
||||
|
||||
|
||||
|
||||
(****************************************************************************)
|
||||
class canvas_video_plugin_item = fun properties (canvas_renderer:PR.t) (adj:GData.adjustment) ->
|
||||
object (self)
|
||||
inherit canvas_item ~config:properties canvas_renderer as item
|
||||
method update_zoom = fun zoom ->
|
||||
item#update zoom
|
||||
method config = fun () ->
|
||||
let props = renderer#config () in
|
||||
let (x, y) = item#xy in
|
||||
let attrs =
|
||||
[ "type", "video_plugin";
|
||||
"display", String.lowercase_ascii item#renderer#tag;
|
||||
"x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in
|
||||
Xml.Element ("papget", attrs, properties@props)
|
||||
initializer ignore(adj#connect#value_changed (fun () -> self#update_zoom (string_of_float adj#value)))
|
||||
end
|
||||
@@ -1,123 +0,0 @@
|
||||
(*
|
||||
* 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 type value =
|
||||
object
|
||||
method last_value : string
|
||||
method connect : (string -> unit) -> unit
|
||||
method config : unit -> Xml.xml list
|
||||
method type_ : string
|
||||
end
|
||||
|
||||
class message_field :
|
||||
?sender:string ->
|
||||
?class_name:string ->
|
||||
string ->
|
||||
string ->
|
||||
value
|
||||
|
||||
class expression :
|
||||
?extra_functions:(string * (string list -> string)) list ->
|
||||
?sender:string ->
|
||||
Expr_syntax.expression ->
|
||||
value
|
||||
|
||||
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 ->
|
||||
value ->
|
||||
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
|
||||
|
||||
class canvas_video_plugin_item :
|
||||
Xml.xml list ->
|
||||
Papget_renderer.t ->
|
||||
GData.adjustment ->
|
||||
object
|
||||
inherit canvas_item_type
|
||||
method config : unit -> Xml.xml
|
||||
method update_zoom : string -> unit
|
||||
(*
|
||||
|
||||
method connect : unit -> unit
|
||||
method deleted : bool
|
||||
method edit : unit -> unit
|
||||
method event : GnoCanvas.item_event -> bool
|
||||
method renderer : Papget_renderer.t
|
||||
method xy : float * float
|
||||
*)
|
||||
end
|
||||
|
||||
@@ -1,49 +0,0 @@
|
||||
(*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
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)
|
||||
|
||||
let dnd_source = fun (widget:GObj.widget) papget_xml ->
|
||||
let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0} ] in
|
||||
widget#drag#source_set dnd_targets ~modi:[`BUTTON1] ~actions:[`COPY];
|
||||
let data_get = fun _ (sel:GObj.selection_context) ~info ~time ->
|
||||
sel#return (Xml.to_string papget_xml) in
|
||||
ignore (widget#drag#connect#data_get ~callback:data_get);
|
||||
@@ -1,34 +0,0 @@
|
||||
(*
|
||||
* 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
|
||||
(** [get_property name config] *)
|
||||
|
||||
val get_prop : string -> Xml.xml list -> string -> string
|
||||
(** [get_prop name config_list default_value] *)
|
||||
|
||||
val property : string -> string -> Xml.xml
|
||||
val xml : string -> string -> (string * string) list -> Xml.xml
|
||||
val float_property : string -> float -> Xml.xml
|
||||
val dnd_source : GObj.widget -> Xml.xml -> unit
|
||||
@@ -1,392 +0,0 @@
|
||||
(*
|
||||
* Paparazzi widget renderers
|
||||
*
|
||||
* Copyright (C) 2008-2009 ENAC, Pascal Brisset
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
open Printf
|
||||
module PC = Papget_common
|
||||
let (//) = Filename.concat
|
||||
|
||||
class type movable_item =
|
||||
object
|
||||
inherit GnoCanvas.base_item
|
||||
method set : GnomeCanvas.group_p list -> unit
|
||||
end
|
||||
|
||||
class type t =
|
||||
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
|
||||
|
||||
|
||||
(*************************** Text ***********************************)
|
||||
class canvas_text = fun ?(config=[]) canvas_group x y ->
|
||||
let group = GnoCanvas.group ~x ~y canvas_group in
|
||||
let text = GnoCanvas.text ~text:"_" group in
|
||||
object (self)
|
||||
val mutable format = PC.get_prop "format" config "%.2f"
|
||||
val mutable size = float_of_string (PC.get_prop "size" config "15.")
|
||||
val mutable color = PC.get_prop "color" config "#00ff00"
|
||||
|
||||
method tag = "Text"
|
||||
method item = (group :> movable_item)
|
||||
method config = fun () ->
|
||||
[ PC.property "format" format;
|
||||
PC.float_property "size" size;
|
||||
PC.property "color" color ]
|
||||
method update = fun (value : string) ->
|
||||
let renderer = fun x ->
|
||||
try sprintf (Scanf.format_from_string format "%f") (float_of_string x) with _ -> 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;
|
||||
text_editor#comboboxentry_color#set_active 0;
|
||||
|
||||
(* 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);
|
||||
let callback = fun () ->
|
||||
color <- text_editor#comboboxentry_color#entry#text in
|
||||
ignore (text_editor#comboboxentry_color#connect#changed ~callback);
|
||||
end
|
||||
|
||||
|
||||
(***************************Vertical Ruler ***********************************)
|
||||
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.
|
||||
|
||||
|
||||
class canvas_ruler = fun ?(config=[]) canvas_group x y ->
|
||||
let h = float_of_string (PC.get_prop "height" config "100.")
|
||||
and index_on_right = bool_of_string (PC.get_prop "index_on_right" config "false")
|
||||
and point_per_unit = float_of_string (PC.get_prop "point_per_unit" config "2.")
|
||||
and w = float_of_string (PC.get_prop "width" config "32.")
|
||||
and step = int_of_string (PC.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 = -. point_per_unit *. (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. *. point_per_unit 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 /. point_per_unit) / step in
|
||||
for i = 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 () ->
|
||||
[ PC.float_property "height" h;
|
||||
PC.property "index_on_right" (sprintf "%b" index_on_right);
|
||||
PC.float_property "width" w;
|
||||
PC.float_property "point_per_unit" point_per_unit;
|
||||
PC.property "step" (sprintf "%d" step) ]
|
||||
end
|
||||
|
||||
(*************************** Gauge ***********************************)
|
||||
class canvas_gauge = fun ?(config=[]) canvas_group x y ->
|
||||
let size = PC.get_prop "size" config "50." in
|
||||
(*let text_props = [`ANCHOR `CENTER; `FILL_COLOR "white"] in*)
|
||||
|
||||
let r1 = max 10. ((float_of_string size) /. 2.) in
|
||||
let r2 = r1 +. 3. in
|
||||
let r3 = 3.5 in
|
||||
let max_rot = 2. *. Latlong.pi /. 3. in
|
||||
|
||||
let root = GnoCanvas.group ~x ~y canvas_group in
|
||||
(*let gauge = GnoCanvas.group root in*)
|
||||
|
||||
(*let props = (text_props@[`ANCHOR `EAST]) in*)
|
||||
|
||||
let _ = GnoCanvas.ellipse ~x1:r2 ~y1:r2 ~x2:(-.r2) ~y2:(-.r2)
|
||||
~props:[`NO_FILL_COLOR; `OUTLINE_COLOR "grey"; `WIDTH_PIXELS 6] root in
|
||||
let points = [|0.;-.r1;0.;-.r1+.3.|] in
|
||||
let props = [`WIDTH_PIXELS 2; `FILL_COLOR "red"] in
|
||||
let _ = GnoCanvas.line ~points ~props root in
|
||||
let il = GnoCanvas.line ~points ~props root in
|
||||
let () = il#affine_absolute (affine_pos_and_angle 0. 0. (-. Latlong.pi /. 3.)) in
|
||||
let ill = GnoCanvas.line ~points ~props root in
|
||||
let () = ill#affine_absolute (affine_pos_and_angle 0. 0. (-. 2. *. Latlong.pi /. 3.)) in
|
||||
let ir = GnoCanvas.line ~points ~props root in
|
||||
let () = ir#affine_absolute (affine_pos_and_angle 0. 0. (Latlong.pi /. 3.)) in
|
||||
let irr = GnoCanvas.line ~points ~props root in
|
||||
let () = irr#affine_absolute (affine_pos_and_angle 0. 0. (2. *. Latlong.pi /. 3.)) in
|
||||
|
||||
let idx = GnoCanvas.polygon ~points:[|r3-.0.2;0.;0.;-.r1;-.(r3-.0.2);0.|]
|
||||
~props:[`FILL_COLOR "red"; `OUTLINE_COLOR "white"] root in
|
||||
let _ = GnoCanvas.ellipse ~x1:r3 ~y1:r3 ~x2:(-.r3) ~y2:(-.r3) ~props:[`OUTLINE_COLOR "grey"] ~fill_color:"red" root in
|
||||
let text_min = GnoCanvas.text ~x:(-.r1) ~y:(r1/.2.) ~props:[`ANCHOR `NE; `FILL_COLOR "#00ff00"] root in
|
||||
let text_max = GnoCanvas.text ~x:r1 ~y:(r1/.2.) ~props:[`ANCHOR `NW; `FILL_COLOR "#00ff00"] root in
|
||||
let text_mid = GnoCanvas.text ~x:0. ~y:(-.r2-.3.) ~props:[`ANCHOR `SOUTH; `FILL_COLOR "#00ff00"] root in
|
||||
let text_text = GnoCanvas.text ~x:0. ~y:(r2+.3.) ~props:[`ANCHOR `NORTH; `FILL_COLOR "#00ff00"] root in
|
||||
|
||||
object
|
||||
val mutable min = PC.get_prop "min" config "-50."
|
||||
val mutable max = PC.get_prop "max" config "50."
|
||||
val mutable text = PC.get_prop "text" config ""
|
||||
|
||||
method tag = "Gauge"
|
||||
method edit = fun (pack:GObj.widget -> unit) ->
|
||||
let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in
|
||||
let gauge_editor = new Gtk_papget_gauge_editor.table_gauge_editor ~file () in
|
||||
pack gauge_editor#table_gauge_editor#coerce;
|
||||
|
||||
(* Initialize the entries *)
|
||||
gauge_editor#entry_min#set_text min;
|
||||
gauge_editor#entry_max#set_text max;
|
||||
gauge_editor#entry_text#set_text text;
|
||||
|
||||
(* Connect the entries *)
|
||||
let callback = fun () ->
|
||||
min <- gauge_editor#entry_min#text in
|
||||
ignore (gauge_editor#entry_min#connect#activate ~callback);
|
||||
let callback = fun () ->
|
||||
max <- gauge_editor#entry_max#text in
|
||||
ignore (gauge_editor#entry_max#connect#activate ~callback);
|
||||
let callback = fun () ->
|
||||
text <- gauge_editor#entry_text#text in
|
||||
ignore (gauge_editor#entry_text#connect#activate ~callback);
|
||||
|
||||
method update = fun value ->
|
||||
let value = float_of_string value in
|
||||
(* Gauge drawer *)
|
||||
let fmin = float_of_string min in
|
||||
let fmax = float_of_string max in
|
||||
let rot = ref (-.max_rot +. 2. *. max_rot *. (value -. fmin) /. (fmax -. fmin)) in
|
||||
if !rot > max_rot then rot := max_rot;
|
||||
if !rot < -.max_rot then rot := -.max_rot;
|
||||
idx#affine_absolute (affine_pos_and_angle 0. 0. !rot);
|
||||
text_min#set [`TEXT min];
|
||||
text_max#set [`TEXT max];
|
||||
text_mid#set [`TEXT (string_of_float ((fmin +. fmax)/.2.))];
|
||||
text_text#set [`TEXT text]
|
||||
|
||||
method item = (root :> movable_item)
|
||||
method config = fun () ->
|
||||
[ PC.property "min" min;
|
||||
PC.property "max" max;
|
||||
PC.property "size" size;
|
||||
PC.property "text" text ]
|
||||
end
|
||||
|
||||
(*************************** Led ***********************************)
|
||||
class canvas_led = fun ?(config=[]) canvas_group x y ->
|
||||
let size = float_of_string (PC.get_prop "size" config "15.") in
|
||||
|
||||
let root = GnoCanvas.group ~x ~y canvas_group in
|
||||
|
||||
let r = (max 2. (size /. 2.)) +. 1. in
|
||||
let led = GnoCanvas.ellipse ~x1:r ~y1:r ~x2:(-.r) ~y2:(-.r)
|
||||
~props:[`NO_FILL_COLOR; `OUTLINE_COLOR "grey"; `WIDTH_UNITS 2.] root in
|
||||
|
||||
let led_text = GnoCanvas.text ~x:(-.r-.3.) ~y:0. ~props:[`ANCHOR `EAST; `FILL_COLOR "#00ff00"] root in
|
||||
|
||||
object
|
||||
val mutable size = float_of_string (PC.get_prop "size" config "15.")
|
||||
val mutable text = PC.get_prop "text" config ""
|
||||
val mutable test_value = float_of_string (PC.get_prop "test_value" config "0.")
|
||||
val mutable test_inv = bool_of_string (PC.get_prop "test_invert" config "false")
|
||||
|
||||
method tag = "Led"
|
||||
method edit = fun (pack:GObj.widget -> unit) ->
|
||||
let file = Env.paparazzi_src // "sw" // "lib" // "ocaml" // "widgets.glade" in
|
||||
let led_editor = new Gtk_papget_led_editor.table_led_editor ~file () in
|
||||
pack led_editor#table_led_editor#coerce;
|
||||
|
||||
(* Initialize the entries *)
|
||||
led_editor#entry_text#set_text text;
|
||||
led_editor#spinbutton_size#set_value size;
|
||||
led_editor#spinbutton_test#set_value test_value;
|
||||
|
||||
(* Connect the entries *)
|
||||
let callback = fun () ->
|
||||
text <- led_editor#entry_text#text in
|
||||
ignore (led_editor#entry_text#connect#activate ~callback);
|
||||
let callback = fun () ->
|
||||
size <- led_editor#spinbutton_size#value in
|
||||
ignore (led_editor#spinbutton_size#connect#activate ~callback);
|
||||
let callback = fun () ->
|
||||
test_value <- led_editor#spinbutton_test#value in
|
||||
ignore (led_editor#spinbutton_test#connect#activate ~callback);
|
||||
let callback = fun () ->
|
||||
test_inv <- led_editor#check_invert#active in
|
||||
ignore (led_editor#check_invert#connect#toggled ~callback);
|
||||
|
||||
method update = fun value ->
|
||||
let value = float_of_string value in
|
||||
let inv = if test_inv then not else (fun x -> x) in
|
||||
(* Led drawer *)
|
||||
if inv (value = test_value) then led#set [`FILL_COLOR "red"]
|
||||
else led#set [`FILL_COLOR "#00ff00"];
|
||||
let r = (max 2. (size /. 2.)) +. 1. in
|
||||
led#set [`X1 r; `Y1 r; `X2 (-.r); `Y2 (-.r)];
|
||||
led_text#set [`TEXT text; `SIZE_POINTS size; `X (-.r-.3.)]
|
||||
|
||||
method item = (root :> movable_item)
|
||||
method config = fun () ->
|
||||
[ PC.float_property "size" size;
|
||||
PC.property "text" text ]
|
||||
end
|
||||
|
||||
(****************************************************************************)
|
||||
class canvas_button = fun ?(config=[]) canvas_group x y ->
|
||||
let icon = PC.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 () ->
|
||||
[ PC.property "icon" icon]
|
||||
initializer
|
||||
group#raise_to_top ();
|
||||
end
|
||||
|
||||
|
||||
(****************************************************************************)
|
||||
class canvas_mplayer = fun ?(config=[]) canvas_group x y ->
|
||||
let video_feed = PC.get_prop "video_feed" config "video_URI" in
|
||||
let width = float_of_string (PC.get_prop "width" config "320.")
|
||||
and height = float_of_string (PC.get_prop "height" config "240.") in
|
||||
let socket = GWindow.socket () in
|
||||
let group = GnoCanvas.group ~x ~y canvas_group in
|
||||
let item = GnoCanvas.widget ~width ~height ~widget:socket group in
|
||||
|
||||
object
|
||||
method tag = "Mplayer"
|
||||
method item = (group :> movable_item)
|
||||
method edit = fun (pack:GObj.widget -> unit) -> ()
|
||||
method update = fun (value:string) ->
|
||||
let zoom = try float_of_string value with _ -> 1. in
|
||||
item#set [`WIDTH (width /. zoom); `HEIGHT (height /. zoom)]
|
||||
method config = fun () ->
|
||||
[ PC.property "video_feed" video_feed;
|
||||
PC.float_property "width" width;
|
||||
PC.float_property "height" height ]
|
||||
initializer
|
||||
group#lower_to_bottom ();
|
||||
let com = sprintf "exec mplayer -vo xv -really-quiet -nomouseinput %s -wid 0x%lx -geometry %.0fx%.0f" video_feed socket#xwindow width height in
|
||||
let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in
|
||||
ignore (Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; com|] dev_null dev_null dev_null)
|
||||
end
|
||||
|
||||
|
||||
(****************************************************************************)
|
||||
class canvas_plugin = fun ?(config=[]) canvas_group x y ->
|
||||
let command = PC.get_prop "command" config "missing_plugin_command" in
|
||||
let width = float_of_string (PC.get_prop "width" config "320.")
|
||||
and height = float_of_string (PC.get_prop "height" config "240.") in
|
||||
let socket = GWindow.socket () in
|
||||
let group = GnoCanvas.group ~x ~y canvas_group in
|
||||
let item = GnoCanvas.widget ~width ~height ~widget:socket group in
|
||||
|
||||
object
|
||||
method tag = "Plugin"
|
||||
method item = (group :> movable_item)
|
||||
method edit = fun (pack:GObj.widget -> unit) -> ()
|
||||
method update = fun (value:string) ->
|
||||
let zoom = try float_of_string value with _ -> 1. in
|
||||
item#set [`WIDTH (width /. zoom); `HEIGHT (height /. zoom) ]
|
||||
method config = fun () ->
|
||||
[ PC.property "command" command;
|
||||
PC.float_property "width" width;
|
||||
PC.float_property "height" height ]
|
||||
initializer
|
||||
group#lower_to_bottom ();
|
||||
let com = sprintf "exec %s0x%lx" command socket#xwindow in
|
||||
let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in
|
||||
ignore (Unix.create_process "/bin/sh" [|"/bin/sh"; "-c"; com|] dev_null dev_null dev_null)
|
||||
end
|
||||
|
||||
|
||||
|
||||
let renderers =
|
||||
[ (new canvas_text :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t);
|
||||
(new canvas_ruler :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t);
|
||||
(new canvas_gauge :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t);
|
||||
(new canvas_led :> ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t) ]
|
||||
|
||||
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)
|
||||
|
||||
@@ -1,64 +0,0 @@
|
||||
(*
|
||||
* 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
|
||||
(** [canvas_text config group x y] *)
|
||||
|
||||
class canvas_ruler : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_ruler config group x y] *)
|
||||
|
||||
class canvas_gauge : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_gauge config group x y] *)
|
||||
|
||||
class canvas_led : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_led config group x y] *)
|
||||
|
||||
class canvas_button : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_button config group x y] *)
|
||||
|
||||
class canvas_mplayer : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_mplayer config group x y] *)
|
||||
|
||||
class canvas_plugin : ?config:Xml.xml list -> #GnoCanvas.group -> float -> float -> t
|
||||
(** [canvas_plugin config group x y] *)
|
||||
|
||||
val lazy_tagged_renderers :
|
||||
(string * (?config:Xml.xml list -> GnoCanvas.group -> float -> float -> t))
|
||||
list lazy_t
|
||||
(** List of renderers available to display a telemetry field value *)
|
||||
@@ -1,29 +0,0 @@
|
||||
(*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
let platform_name =
|
||||
let os = Sys.os_type in
|
||||
if os = "Win32" then Unix.putenv "GTK_RC_FILES" (Unix.getcwd () ^ "/wingtk.rc") ;
|
||||
os
|
||||
|
||||
let platform_is_unix = platform_name = "Unix"
|
||||
let platform_is_win32 = platform_name = "Win32"
|
||||
@@ -1,30 +0,0 @@
|
||||
(*
|
||||
* Copyright (C) 2004 CENA/ENAC, Yann Le Fablec
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(** Renvoie le nom de la plateforme : Unix ou Win32 *)
|
||||
val platform_name : string
|
||||
|
||||
(** Teste si la plateforme courante est Unix *)
|
||||
val platform_is_unix : bool
|
||||
|
||||
(** Teste si la plateforme courante est Windows (Win32) *)
|
||||
val platform_is_win32 : bool
|
||||
@@ -1,399 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<glade-interface>
|
||||
<!-- interface-requires gtk+ 2.6 -->
|
||||
<!-- interface-naming-policy toplevel-contextual -->
|
||||
<widget class="GtkWindow" id="papget_text_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="title" translatable="yes">Text Papget Properties</property>
|
||||
<property name="window_position">mouse</property>
|
||||
<child>
|
||||
<widget class="GtkTable" id="table_text_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="n_rows">3</property>
|
||||
<property name="n_columns">2</property>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label39">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Format</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label40">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Size</property>
|
||||
<property name="justify">right</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label45">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Color</property>
|
||||
<property name="justify">right</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_format">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="invisible_char">●</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkSpinButton" id="spinbutton_size">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="adjustment">1 0 100 1 10 0</property>
|
||||
<property name="climb_rate">1</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkComboBoxEntry" id="comboboxentry_color">
|
||||
<property name="visible">True</property>
|
||||
<property name="has_tooltip">True</property>
|
||||
<property name="tooltip" translatable="yes">Colors defined in X11 rgb.txt</property>
|
||||
<property name="items" translatable="yes">green
|
||||
red
|
||||
blue
|
||||
yellow
|
||||
orange
|
||||
white</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
</child>
|
||||
</widget>
|
||||
<widget class="GtkWindow" id="papget_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="title" translatable="yes">Papget Editor (A/C: Any)</property>
|
||||
<property name="modal">True</property>
|
||||
<property name="default_width">300</property>
|
||||
<child>
|
||||
<widget class="GtkVBox" id="vbox">
|
||||
<property name="visible">True</property>
|
||||
<child>
|
||||
<widget class="GtkEventBox" id="box_item_chooser">
|
||||
<property name="visible">True</property>
|
||||
<child>
|
||||
<placeholder/>
|
||||
</child>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="position">0</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkHBox" id="hbox_scale">
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label41">
|
||||
<property name="visible">True</property>
|
||||
<property name="label" translatable="yes">Scale</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">False</property>
|
||||
<property name="position">0</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_scale">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="tooltip" translatable="yes">"a+b" to display value x as a.x+b</property>
|
||||
<property name="invisible_char">●</property>
|
||||
<property name="text" translatable="yes">1+0</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEventBox" id="box_item_editor">
|
||||
<property name="visible">True</property>
|
||||
<child>
|
||||
<placeholder/>
|
||||
</child>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="position">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkHBox" id="hbox9">
|
||||
<property name="visible">True</property>
|
||||
<property name="homogeneous">True</property>
|
||||
<child>
|
||||
<widget class="GtkButton" id="button_delete">
|
||||
<property name="label">gtk-delete</property>
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">False</property>
|
||||
<property name="use_stock">True</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">False</property>
|
||||
<property name="position">0</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkButton" id="button_ok">
|
||||
<property name="label">gtk-close</property>
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">False</property>
|
||||
<property name="use_stock">True</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="fill">False</property>
|
||||
<property name="position">1</property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="expand">False</property>
|
||||
<property name="position">3</property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
</child>
|
||||
</widget>
|
||||
<widget class="GtkWindow" id="papget_gauge_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="title" translatable="yes">Gauge Papget Properties</property>
|
||||
<property name="window_position">mouse</property>
|
||||
<child>
|
||||
<widget class="GtkTable" id="table_gauge_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="n_rows">3</property>
|
||||
<property name="n_columns">2</property>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label42">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Min</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label43">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Max</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_min">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="invisible_char">●</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_max">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="invisible_char">●</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_text">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="invisible_char">●</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label44">
|
||||
<property name="visible">True</property>
|
||||
<property name="xalign">0</property>
|
||||
<property name="label" translatable="yes">Text</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
<property name="y_options"></property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
</child>
|
||||
</widget>
|
||||
<widget class="GtkWindow" id="papget_led_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="title" translatable="yes">Led Papget Properties</property>
|
||||
<property name="window_position">mouse</property>
|
||||
<child>
|
||||
<widget class="GtkTable" id="table_led_editor">
|
||||
<property name="visible">True</property>
|
||||
<property name="n_rows">4</property>
|
||||
<property name="n_columns">2</property>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label1">
|
||||
<property name="visible">True</property>
|
||||
<property name="label" translatable="yes">Text</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label2">
|
||||
<property name="visible">True</property>
|
||||
<property name="label" translatable="yes">Size</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkSpinButton" id="spinbutton_size">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="adjustment">15 2 100 1 10 0</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">1</property>
|
||||
<property name="bottom_attach">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkEntry" id="entry_text">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label3">
|
||||
<property name="visible">True</property>
|
||||
<property name="label" translatable="yes">Test invert</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">3</property>
|
||||
<property name="bottom_attach">4</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkCheckButton" id="check_invert">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="receives_default">False</property>
|
||||
<property name="draw_indicator">True</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">3</property>
|
||||
<property name="bottom_attach">4</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkLabel" id="label4">
|
||||
<property name="visible">True</property>
|
||||
<property name="label" translatable="yes">Test value</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
<property name="x_options">GTK_FILL</property>
|
||||
</packing>
|
||||
</child>
|
||||
<child>
|
||||
<widget class="GtkSpinButton" id="spinbutton_test">
|
||||
<property name="visible">True</property>
|
||||
<property name="can_focus">True</property>
|
||||
<property name="adjustment">0 0 100 1 10 0</property>
|
||||
<property name="climb_rate">1</property>
|
||||
</widget>
|
||||
<packing>
|
||||
<property name="left_attach">1</property>
|
||||
<property name="right_attach">2</property>
|
||||
<property name="top_attach">2</property>
|
||||
<property name="bottom_attach">3</property>
|
||||
</packing>
|
||||
</child>
|
||||
</widget>
|
||||
</child>
|
||||
</widget>
|
||||
</glade-interface>
|
||||
@@ -1,67 +0,0 @@
|
||||
(*
|
||||
* Wind sock
|
||||
*
|
||||
* Copyright (C) 2007 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.
|
||||
*
|
||||
*)
|
||||
|
||||
let flatten = fun s a ->
|
||||
let n = Array.length a in
|
||||
let b = Array.make (2*n) 0. in
|
||||
for i = 0 to n - 1 do
|
||||
let (x, y) = a.(i) in
|
||||
b.(2*i) <- float x *. s;
|
||||
b.(2*i+1) <- float y *. s
|
||||
done;
|
||||
b
|
||||
|
||||
class item = fun ?(show = false) size_unit group ->
|
||||
let texture = `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") in
|
||||
|
||||
let group = GnoCanvas.group group in
|
||||
|
||||
(* Text *)
|
||||
let t = GnoCanvas.text group ~props:[`TEXT "12.1"; `X 0.; `Y 0.; `ANCHOR `CENTER; `FILL_COLOR "black"] in
|
||||
|
||||
(* Red left and right *)
|
||||
let props = [`FILL_COLOR "red"; texture] in
|
||||
let points = flatten size_unit [|(-6,4); (-2,3); (-2,-3); (-6,-4)|] in
|
||||
let _ = GnoCanvas.polygon group ~props ~points in
|
||||
let points = flatten size_unit [|(2,2); (6,1); (6,-1); (2,-2)|] in
|
||||
let _ = GnoCanvas.polygon group ~props ~points in
|
||||
|
||||
(* White center *)
|
||||
let props = [`FILL_COLOR "white"] in
|
||||
let points = flatten size_unit [|(-2,3); (2,2); (2,-2); (-2,-3)|] in
|
||||
let _ = GnoCanvas.polygon group ~props ~points in
|
||||
|
||||
(* contour *)
|
||||
let points = flatten size_unit [|(-6,4); (6,1); (6,-1); (-6,-4)|] in
|
||||
let props = [`OUTLINE_COLOR "white"; `WIDTH_PIXELS 1] in
|
||||
let contour = GnoCanvas.polygon group ~props ~points in
|
||||
|
||||
object
|
||||
method item = group
|
||||
method label = t
|
||||
initializer
|
||||
t#raise_to_top ();
|
||||
if not show then group#hide ()
|
||||
method set_color = fun color -> contour#set [`OUTLINE_COLOR color]
|
||||
end
|
||||
@@ -1,33 +0,0 @@
|
||||
(*
|
||||
* Wind sock
|
||||
*
|
||||
* Copyright (C) 2007 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(** [item ?show size_unit group] Length of the wind sock is 6 times
|
||||
[size_unit] *)
|
||||
class item : ?show:bool -> float -> #GnoCanvas.group ->
|
||||
object
|
||||
method item : GnoCanvas.group
|
||||
method label : GnoCanvas.text
|
||||
method set_color : string -> unit
|
||||
end
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -1,79 +0,0 @@
|
||||
(*
|
||||
* XML graphics editor
|
||||
*
|
||||
* Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin
|
||||
*
|
||||
* 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.
|
||||
*
|
||||
*)
|
||||
|
||||
(** XML types base on the xml-light library *)
|
||||
|
||||
type t
|
||||
(** The whole XML data structure *)
|
||||
|
||||
type node
|
||||
(** One data structure node. Warning: it is not an absolute
|
||||
node designation: it may not remain valid after strucure modifications
|
||||
(reordering, deletion addition, ... *)
|
||||
|
||||
type tag = string
|
||||
type attribute = string * string
|
||||
type attributes = attribute list
|
||||
|
||||
type event = Deleted | Modified of attributes | New_child of node
|
||||
|
||||
val create : ?format_attribs:((string * string) list -> string) -> ?editable:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget)
|
||||
(** [create ?format_attribs ?editable dtd xml] Opens a display of [xml] with contextual right button
|
||||
actions constrained by [dtd]. Returns the corresponding model. *)
|
||||
|
||||
val xml_of_node : node -> Xml.xml
|
||||
val xml_of_view : t -> Xml.xml
|
||||
(** [xml_of_view v] Returns the XML displayed data structure *)
|
||||
|
||||
val root : t -> node
|
||||
|
||||
val child : node -> tag -> node
|
||||
val tag : node -> string
|
||||
val attribs : node -> attributes
|
||||
val attrib : node -> string -> string (* Safe case match *)
|
||||
val children : node -> node list
|
||||
val parent : node -> tag -> node (** May raise Failure *)
|
||||
(** Xml-light like acces functions *)
|
||||
|
||||
val set_attrib : node -> attribute -> unit
|
||||
val set_attribs : node -> attributes -> unit
|
||||
val delete : node -> unit
|
||||
val add_child : node -> tag -> attributes -> node
|
||||
(** Modifications *)
|
||||
|
||||
val connect : node -> (event -> unit) -> unit
|
||||
val connect_activated : t -> (node -> unit) -> unit
|
||||
(** To be kept informed about modifications *)
|
||||
|
||||
val string_of_attribs : attributes -> string
|
||||
(** Default formatter for attributes *)
|
||||
|
||||
val selection : t -> node
|
||||
|
||||
val expand_node : ?all:bool -> t -> node -> unit
|
||||
|
||||
val set_background : ?all:bool -> node -> string -> unit
|
||||
|
||||
type id = int
|
||||
val id : node -> id
|
||||
Reference in New Issue
Block a user