From 14751f8d86085e65910a5a70ef73af0f38d9ba5d Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 9 Feb 2013 00:42:20 +0100 Subject: [PATCH 001/109] [gcs] specify max map zoom level with -maps_zoom option - defaults to 18, max is 22 - TODO: check that a valid zoomlevel was given - add it to the menu to change at runtime? - if available, larger (low zoomlevel) tiles in cache are loaded right away, even if higher zoomlevel maps could be downloaded. --- sw/ground_segment/cockpit/gcs.ml | 8 +++++--- sw/lib/ocaml/gm.ml | 2 +- sw/lib/ocaml/mapGoogle.ml | 12 ++++++------ sw/lib/ocaml/mapGoogle.mli | 8 ++++---- 4 files changed, 16 insertions(+), 14 deletions(-) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index b51807bbce..4ef18fbaea 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -174,10 +174,11 @@ end (************ Google, OSM Maps handling *****************************************) module GM = struct (** Fill the visible background with Google, OSM tiles *) + let zoomlevel = ref 18 let fill_tiles = fun geomap -> match geomap#georef with None -> () - | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap) + | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap !zoomlevel) let auto = ref false let update = fun geomap -> @@ -197,7 +198,7 @@ module GM = struct posn_long = min geo1.posn_long geo2.posn_long } and ne = { posn_lat = max geo1.posn_lat geo2.posn_lat; posn_long = max geo1.posn_long geo2.posn_long } in - let pix = MapGoogle.pixbuf sw ne in + let pix = MapGoogle.pixbuf sw ne !zoomlevel in let nw = { posn_lat = ne.posn_lat; posn_long = sw.posn_long } and se = { posn_lat = sw.posn_lat; posn_long = ne.posn_long } in save_map geomap ~projection:"Mercator" pix nw se @@ -347,6 +348,7 @@ let options = "-edit", Arg.Unit (fun () -> edit := true; layout_file := "editor.xml"), "Flight plan editor"; "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; "-maps_fill", Arg.Set GM.auto, "Automatically start loading background maps"; + "-maps_zoom", Arg.Set_int GM.zoomlevel, "Background maps zoomlevel (default: 18, max: 22)"; "-ign", Arg.String (fun s -> ign:=true; IGN.data_path := s), "IGN tiles path"; "-lambertIIe", Arg.Unit (fun () -> projection:=G.LambertIIe),"Switch to LambertIIe projection"; "-layout", Arg.Set_string layout_file, (sprintf " GUI layout. Default: %s" !layout_file); @@ -470,7 +472,7 @@ let create_geomap = fun switch_fullscreen editor_frame -> (** Separate from A/C menus *) ignore (geomap#factory#add_separator ()); - (** Set the initial soom *) + (** Set the initial zoom *) geomap#zoom !zoom; geomap, menu_fact diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 31b9cff1cc..3a92869d0c 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -28,7 +28,7 @@ open Latlong open Printf let tile_size = 256, 256 -let zoom_max = 18 +let zoom_max = 22 let cache_path = ref "/var/tmp" diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 650ec1ddf5..874b2c15e5 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -109,7 +109,7 @@ let display_tile = fun (geomap:MapCanvas.widget) wgs84 -> exception New_displayed of int (** [New_displayed zoom] Raised when a new is loadded *) -let fill_window = fun (geomap:MapCanvas.widget) -> +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 @@ -136,7 +136,7 @@ let fill_window = fun (geomap:MapCanvas.widget) -> if zoom = 1 then let tile, image = Gm.get_image key in display_the_tile geomap tile image; - raise (New_displayed (19-String.length tile.Gm.key)) + raise (New_displayed (zoomlevel+1-String.length tile.Gm.key)) else begin trees.(i) <- Node (Array.create 4 Empty); loop twest tsouth tsize trees i zoom key @@ -158,7 +158,7 @@ let fill_window = fun (geomap:MapCanvas.widget) -> New_displayed z when z = zoom -> trees.(i) <- Tile | Gm.Not_available -> () in - loop (-1.) (-1.) 2. [|gm_tiles|] 0 18 "t" + loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t" exception To_copy of int * string @@ -172,7 +172,7 @@ let gdk_pixbuf_safe_copy_area ~dest ~dest_x ~dest_y ~width ~height ~src_x ~src_y 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 -> +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 @@ -191,7 +191,7 @@ let pixbuf = fun sw ne -> if zoom = 1 then let tile, image = Gm.get_image key in - raise (To_copy (19-String.length tile.Gm.key, image)) + 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 @@ -210,5 +210,5 @@ let pixbuf = fun sw ne -> 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. 18 "t"; + loop (-1.) (-1.) 2. zoomlevel "t"; dest diff --git a/sw/lib/ocaml/mapGoogle.mli b/sw/lib/ocaml/mapGoogle.mli index 0255098cac..398b38bf24 100644 --- a/sw/lib/ocaml/mapGoogle.mli +++ b/sw/lib/ocaml/mapGoogle.mli @@ -25,8 +25,8 @@ val display_tile : MapCanvas.widget -> Latlong.geographic -> unit (** Displaying the Google Maps tile around the given point (zoom=1) *) -val fill_window : MapCanvas.widget -> unit -(** Filling the canvas window with Google Maps tiles *) +val fill_window : MapCanvas.widget -> int -> unit +(** Filling the canvas window with Google Maps tiles at given zoomlevel*) -val pixbuf : Latlong.geographic -> Latlong.geographic -> GdkPixbuf.pixbuf -(** [pixbuf south_west north_east] Returns a map background of the given area *) +val pixbuf : Latlong.geographic -> Latlong.geographic -> int -> GdkPixbuf.pixbuf +(** [pixbuf south_west north_east zoomlevel] Returns a map background of the given area *) From f662d2e81821f81309dc6d5ed13d4064cbbb1605 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 20 Feb 2013 02:58:18 +0100 Subject: [PATCH 002/109] [ocaml][tools] don't use custom runtime for ocaml, instead load shared libraries in ocamlrun since the ivy-ocaml lib currently can't be found with ocamlfind and libpprz is not installed system-wide, specify the paths directly with -dllpath --- sw/tools/Makefile | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/sw/tools/Makefile b/sw/tools/Makefile index ec51976748..bf724257fe 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -26,13 +26,13 @@ OCAML=ocaml OCAMLFIND=ocamlfind OCAMLC=ocamlc OCAMLDEP=ocamldep -LIBPPRZDIR=../lib/ocaml +LIBPPRZDIR=$(PAPARAZZI_SRC)/sw/lib/ocaml INCLUDES=-I $(LIBPPRZDIR) -# $(shell ocamlfind query -r -i-format xml-light) -#OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) -#OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient) LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma +# since the ivy-ocaml lib currently can't be found with ocamlfind, specify the path directly with -dllpath +LIBIVYDIR=/usr/lib/ocaml + all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs FP_CMO = fp_proc.cmo gen_flight_plan.cmo @@ -40,15 +40,15 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light -linkpkg ivy-ocaml.cma lib-pprz.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma $^ gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light,netclient -linkpkg ivy-ocaml.cma lib-pprz.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,netclient -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma $< %.out : %.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -custom -o $@ -package unix,str,xml-light -linkpkg ivy-ocaml.cma lib-pprz.cma gen_common.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma gen_common.cmo $< # disable this for now and use the compiled bytecode #@cat ../../pprz_src_test.sh > $@ From cf7121934f3209b0a4ebf7a4c0d6bf1ab2589bee Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 20 Feb 2013 15:01:13 +0100 Subject: [PATCH 003/109] verbose option for building ocaml lib --- sw/lib/ocaml/Makefile | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index bf3adb718f..8cea2b7689 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -23,6 +23,22 @@ Q=@ + +OCAMLC=ocamlc +OCAMLFIND=ocamlfind +OCAMLDEP=ocamldep +OCAMLOPT=ocamlopt +OCAMLLEX=ocamllex +OCAMLYACC=ocamlyacc +OCAMLLIBDIR=$(shell $(OCAMLC) -where) + +# default directory for temporary files +TMPDIR ?= /tmp + +# verbose ocamlmklib: Print commands before executing them +VERBOSITY = -verbose +#VERBOSITY = + LBITS := $(shell getconf LONG_BIT) ifeq ($(LBITS),64) FPIC = -ccopt -fPIC @@ -30,15 +46,8 @@ else FPIC = endif -INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) $(shell ocamlfind query -r -i-format pcre) +INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netclient) XINCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) -OCAMLC=ocamlc -OCAMLDEP=ocamldep -OCAMLOPT=ocamlopt -OCAMLLEX=ocamllex -OCAMLYACC=ocamlyacc -OCAMLLIBDIR=$(shell $(OCAMLC) -where) - 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) @@ -51,9 +60,6 @@ XCMX = $(XSRC:.ml=.cmx) TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) -# default directory for temporary files -TMPDIR ?= /tmp - $(XCMO) $(XCMX) myGtkInit.cmo : INCLUDES=$(XINCLUDES) all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt @@ -62,19 +68,19 @@ opt : lib-pprz.cmxa xlib-pprz.cmxa lib-pprz.cma liblib-pprz.a: $(CMO) @echo OL $@ - $(Q)ocamlmklib $(INCLUDES) -o lib-pprz $^ + $(Q)ocamlmklib $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ lib-pprz.cmxa dlllib-pprz.so: $(CMX) @echo OOL $@ - $(Q)ocamlmklib $(INCLUDES) -o lib-pprz $^ + $(Q)ocamlmklib $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ xlib-pprz.cma libxlib-pprz.a: $(XCMO) @echo OL $@ - $(Q)ocamlmklib $(XINCLUDES) -o xlib-pprz $^ + $(Q)ocamlmklib $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX) @echo OOL $@ - $(Q)ocamlmklib $(XINCLUDES) -o xlib-pprz $^ + $(Q)ocamlmklib $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ # trying to set correct dependencies for parallel build # these are order only depedencies From 69ddd2cabdef1b80852174d9f29804f30a9bf68d Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 21 Feb 2013 20:00:09 +0100 Subject: [PATCH 004/109] [makefile] cleaning makefiles from -custom param for ocaml --- sw/ground_segment/cockpit/Makefile | 29 ++++++++---------- sw/ground_segment/tmtc/Makefile | 48 ++++++++++++----------------- sw/lib/ocaml/Makefile | 49 ++++++++++++++++-------------- sw/tools/Makefile | 17 +++-------- 4 files changed, 63 insertions(+), 80 deletions(-) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index c3697ac744..477980b2a7 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -33,19 +33,14 @@ else endif FPIC=-fPIC -OCAMLC=ocamlc -OCAMLOPT=ocamlopt -OCAMLDEP=ocamldep -OCAMLOPTFLAGS=-thread -OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) -OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient) -LIBPPRZDIR=../../lib/ocaml -INCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format pcre) $(OCAMLNETINCLUDES) -LIBS=$(OCAMLNETCMA) glibivy-ocaml.cma lablgtk.cma lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma +include ../../Makefile.ocaml + +INCLUDES= +LIBS= lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma CMXA=$(LIBS:.cma=.cmxa) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma -LIBPPRZCMXA=$(LIBPPRZCMA:.cma=.cmxa) -XLIBPPRZCMA=$(LIBPPRZDIR)/xlib-pprz.cma + +INCLUDES= -I $(LIBPPRZDIR) -I ../multimon +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light,netstring,netclient,threads ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml particules.ml papgets.ml gcs.ml MAIN=gcs @@ -58,22 +53,22 @@ opt : $(MAIN).opt $(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) $(OCAMLCFLAGS) -custom $(INCLUDES) $(OCAMLNETINCLUDES) unix.cma str.cma netstring.cma netclient.cma xml-light.cma $(LIBS) threads.cma gtkThread.cmo myGtkInit.cmo $(CMO) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS) gtkThread.cmo myGtkInit.cmo $(CMO) -o $@ $(MAIN).opt : $(CMX) @echo OOL $@ - $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) str.cmxa unix.cmxa xml-light.cmxa $(LIBS:.cma=.cmxa) threads.cmxa gtkThread.cmx gtkInit.cmx $(CMX) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS:.cma=.cmxa) gtkThread.cmx gtkInit.cmx $(CMX) -o $@ %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< saveSettings.cmo : gtk_save_settings.cmo saveSettings.cmx: gtk_save_settings.cmx diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 8449654b50..735aa4e1a1 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -32,21 +32,12 @@ endif include ../../../conf/Makefile.local +include ../../Makefile.ocaml CONF = ../../../conf VAR = ../../../var -OCAMLC = ocamlc -OCAMLOPT = ocamlopt -OCAMLDEP = ocamldep -LIBPPRZDIR = ../../lib/ocaml -OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) -OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) -INCLUDES= -I $(LIBPPRZDIR) -I ../multimon $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(OCAMLNETINCLUDES) - -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma -LIBPPRZCMXA=$(LIBPPRZCMA:.cma=.cmxa) -XLIBPPRZCMA=$(LIBPPRZDIR)/xlib-pprz.cma -XLIBPPRZCMXA=$(XLIBPPRZCMA:.cma=.cmxa) +INCLUDES= -I $(LIBPPRZDIR) -I ../multimon +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light,netstring,netclient LIBMULTIMONCMA=../multimon/multimon.cma @@ -54,7 +45,8 @@ SERVERCMO = server_globals.cmo aircraft.cmo wind.cmo airprox.cmo kml.cmo fw_serv SERVERCMX = $(SERVERCMO:.cmo=.cmx) -all: link server messages settings dia diadec $(VAR)/boa.conf ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge +all: link server messages dia diadec $(VAR)/boa.conf ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge +#settings clean: rm -f link server messages settings dia diadec *.bak *~ core *.o .depend *.opt *.out *.cm* ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge gpsd2ivy c_ivy_client_example_1 c_ivy_client_example_2 c_ivy_client_example_3 @@ -67,75 +59,75 @@ $(VAR)/boa.conf :$(CONF)/boa.conf messages : messages.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $< settings : settings.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) ../cockpit/page_settings.cmo @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -I ../cockpit -o $@ unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma $(OCAMLNETCMA) glibivy-ocaml.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma gtkInit.cmo gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma lablgnomecanvas.cma gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) $< server : $(SERVERCMO) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma $(SERVERCMO) + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(SERVERCMO) server.opt : $(SERVERCMX) $(LIBPPRZCMXA) @echo OOL $@ - $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ str.cmxa unix.cmxa xml-light.cmxa lablgtk.cmxa glibivy-ocaml.cmxa lib-pprz.cmxa $(SERVERCMX) + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMXA) $(SERVERCMX) link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $< dia : dia.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< diadec : diadec.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< 150m : 150m.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $< settings.cmo : INCLUDES += -I ../cockpit settings.cmo : ../cockpit/page_settings.cmi %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLOPT) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) $< CC = gcc diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 8cea2b7689..4297f913b2 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -30,6 +30,7 @@ OCAMLDEP=ocamldep OCAMLOPT=ocamlopt OCAMLLEX=ocamllex OCAMLYACC=ocamlyacc +OCAMLMKLIB=ocamlmklib OCAMLLIBDIR=$(shell $(OCAMLC) -where) # default directory for temporary files @@ -46,21 +47,25 @@ else FPIC = endif -INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netclient) -XINCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) +INCLUDES= +#$(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netclient) $(shell ocamlfind query -r -i-format ivy) +PKGCOMMON=xml-light,netclient,ivy,lablgtk2 +XINCLUDES= +#$(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format ivy) +XPKGCOMMON=lablgtk2,xml-light,ivy 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) CMX = $(SRC:.ml=.cmx) -XSRC = gtk_tools.ml platform.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 platform.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 xmlEdit.ml mapFP.ml XCMO = $(XSRC:.ml=.cmo) XCMX = $(XSRC:.ml=.cmx) TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) -$(XCMO) $(XCMX) myGtkInit.cmo : INCLUDES=$(XINCLUDES) +OCAMLDLL = -dllpath $(shell ocamlfind query ivy) all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt opt : lib-pprz.cmxa xlib-pprz.cmxa @@ -68,19 +73,19 @@ opt : lib-pprz.cmxa xlib-pprz.cmxa lib-pprz.cma liblib-pprz.a: $(CMO) @echo OL $@ - $(Q)ocamlmklib $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ lib-pprz.cmxa dlllib-pprz.so: $(CMX) @echo OOL $@ - $(Q)ocamlmklib $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ -xlib-pprz.cma libxlib-pprz.a: $(XCMO) +xlib-pprz.cma libxlib-pprz.a: $(XCMO) ml_gtk_drag.o @echo OL $@ - $(Q)ocamlmklib $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ -xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX) +xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX) ml_gtk_drag.o @echo OOL $@ - $(Q)ocamlmklib $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ # trying to set correct dependencies for parallel build # these are order only depedencies @@ -90,48 +95,48 @@ xlib-pprz.cmxa: | libxlib-pprz.a dllxlib-pprz.so xml_get.out : lib-pprz.cma xml_get.cmo | opt @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -o $@ str.cma xml-light.cma -I . $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package str,xml-light -linkpkg -I . $^ tests : lib-pprz.cma $(TESTS_CMO) - $(OCAMLC) $(INCLUDES) -custom -I . -o $@ str.cma unix.cma ivy-ocaml.cma xml-light.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg -I . -dllpath . $^ GTKCFLAGS := `pkg-config --cflags gtk+-2.0` -#GTKCFLAGS := -I/usr/lib/gtk-2.0/include -I/usr/include/gtk-2.0 -I/usr/include/atk-1.0 -I/usr/include/glib-2.0 -I/usr/lib/glib-2.0/include -I/usr/include/pango-1.0 -I/usr/include/cairo -# GTKCFLAGS := $(shell gtk-config --cflags) %.o : %.c @echo OC $< - $(Q)$(OCAMLC) $(FPIC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(FPIC) $(INCLUDES) -package $(PKGCOMMON) -c $< + +$(XCMO) $(XCMX) myGtkInit.cmo : PKGCOMMON=$(XPKGCOMMON) ml_gtk_drag.o : ml_gtk_drag.c @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c -ccopt "$(GTKCFLAGS)" $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< ml_gtkgl_hack.o : ml_gtkgl_hack.c @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c -ccopt "$(GTKCFLAGS)" $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< camltm.o : register_example.cmo - $(OCAMLC) $(INCLUDES) -output-obj -o $@ unix.cma str.cma xml-light.cma ivy-ocaml.cma debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo + $(OCAMLFIND) $(OCAMLC) $(INCLUDES) -output-obj -o $@ unix.cma str.cma xml-light.cma ivy-ocaml.cma debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o $(CC) -o $@ $^ -L$(OCAMLLIBDIR) -lunix -lstr -livy-ocaml -lcamlrun -lm -livy -lcurses %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLOPT) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLC) $(XINCLUDES) $(INCLUDES) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(XINCLUDES) $(INCLUDES) -package $(PKGCOMMON),$(XPKGCOMMON) $< %.cmi : %.ml @echo OC $< - $(Q)$(OCAMLC) $(XINCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(XINCLUDES) -package $(PKGCOMMON) -c $< %.ml : %.mll @echo OCL $< diff --git a/sw/tools/Makefile b/sw/tools/Makefile index bf724257fe..8957d4766c 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -22,16 +22,7 @@ # Quiet compilation Q=@ -OCAML=ocaml -OCAMLFIND=ocamlfind -OCAMLC=ocamlc -OCAMLDEP=ocamldep -LIBPPRZDIR=$(PAPARAZZI_SRC)/sw/lib/ocaml -INCLUDES=-I $(LIBPPRZDIR) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma - -# since the ivy-ocaml lib currently can't be found with ocamlfind, specify the path directly with -dllpath -LIBIVYDIR=/usr/lib/ocaml +include ../Makefile.ocaml all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs @@ -40,15 +31,15 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma $^ gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,netclient -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,netclient,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma $< %.out : %.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light -linkpkg -dllpath $(LIBIVYDIR) ivy-ocaml.cma -dllpath $(LIBPPRZDIR) lib-pprz.cma gen_common.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma gen_common.cmo $< # disable this for now and use the compiled bytecode #@cat ../../pprz_src_test.sh > $@ From b81ae249174199517d1058051a1b01b57f276d8b Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 21 Feb 2013 23:22:42 +0100 Subject: [PATCH 005/109] [makefile] most of the ocaml tools are compiling with shared lib some issues with mixed static/shared lib --- sw/ground_segment/joystick/Makefile | 10 +++++---- sw/lib/ocaml/Makefile | 2 -- sw/logalizer/Makefile | 34 ++++++++++++----------------- sw/simulator/Makefile | 25 ++++++++++++--------- sw/supervision/Makefile | 17 +++++++-------- 5 files changed, 43 insertions(+), 45 deletions(-) diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index f97df266ef..49eea08b76 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -24,11 +24,11 @@ # Quiet compilation Q=@ -OCAMLC = ocamlc -OCAMLDEP = ocamldep -LIBPPRZDIR = ../../lib/ocaml +include ../../Makefile.ocaml TOOLSDIR = ../../tools + OCAMLINCLUDES= -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) -I $(TOOLSDIR) +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want @@ -42,7 +42,9 @@ test_stick: test_sdl_stick.o gcc -g -O2 -Wall -DSTICK_DBG `pkg-config glib-2.0 --cflags` -o $@ $^ sdl_stick.c `pkg-config glib-2.0 --libs` -lglibivy `sdl-config --libs` input2ivy: sdl_stick.o ml_sdl_stick.o input2ivy.cmo - $(OCAMLC) $(OCAMLINCLUDES) -o $@ unix.cma str.cma glibivy-ocaml.cma xml-light.cma lib-pprz.cma lablgtk.cma $(TOOLSDIR)/fp_proc.cmo $^ -custom $(ML_SDL_LFLAGS) + @echo OL $@ + $(Q)$(OCAMLC) -make-runtime -o i2i_run sdl_stick.o ml_sdl_stick.o $(ML_SDL_LFLAGS) + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -use-runtime i2i_run -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo # dependency of input2ivy input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 4297f913b2..723e29e99b 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -48,10 +48,8 @@ else endif INCLUDES= -#$(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netclient) $(shell ocamlfind query -r -i-format ivy) PKGCOMMON=xml-light,netclient,ivy,lablgtk2 XINCLUDES= -#$(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format ivy) XPKGCOMMON=lablgtk2,xml-light,ivy 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 5b719da7df..48198af98a 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -23,15 +23,9 @@ # Quiet compilation Q=@ -OCAMLC = ocamlc -OCAMLDEP = ocamldep -OCAMLOPT = ocamlopt -LIBPPRZDIR = ../lib/ocaml -INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format lablgtk2) -I $(LIBPPRZDIR) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma -LIBPPRZCMXA=$(LIBPPRZCMA:.cma=.cmxa) -XLIBPPRZCMA=$(LIBPPRZDIR)/xlib-pprz.cma -XLIBPPRZCMXA=$(XLIBPPRZCMA:.cma=.cmxa) +include ../Makefile.ocaml +INCLUDES= -I $(LIBPPRZDIR) +PKGCOMMON=unix,str,xml-light,ivy,lablgtk2 # default directory for temporary files TMPDIR ?= /tmp @@ -40,23 +34,23 @@ all: play plotter plot sd2log plotprofile openlog2tlm play : log_file.cmo play_core.cmo play.cmo @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -custom -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma $(shell ocamlfind query -r -i-format lablgtk2) -I ../lib/ocaml lablgtk.cma lib-pprz.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $^ play-nox : play_core.cmo play-nox.cmo @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -custom -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma $(shell ocamlfind query -r -i-format lablgtk2) -I ../lib/ocaml lablgtk.cma lib-pprz.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $^ plotter : plotter.cmo @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -custom -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lablgtk.cma lib-pprz.cma xlib-pprz.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(XLIBPPRZCMA) gtkInit.cmo $^ -plot : log_file.cmx gtk_export.cmx export.cmx plot.cmx - @echo OL $@ - $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ unix.cmxa str.cmxa xml-light.cmxa glibivy-ocaml.cmxa lablgtk.cmxa lib-pprz.cmxa xlib-pprz.cmxa lablglade.cmxa gtkInit.cmx $^ +plot : log_file.cmo gtk_export.cmo export.cmo plot.cmo + @echo OL $@ $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(XLIBPPRZCMA) lablglade.cma gtkInit.cmo $^ sd2log : sd2log.cmo @echo OL $@ - $(Q)$(OCAMLC) $(INCLUDES) -custom -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lib-pprz.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $^ CC = gcc CFLAGS=-g -O2 -Wall @@ -68,7 +62,7 @@ openlog2tlm: openlog2tlm.c # depedency on lib-pprz play play-nox sd2log : $(LIBPPRZCMA) plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) -plot : $(LIBPPRZCMXA) $(XLIBPPRZCMXA) +plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) # Target for bytecode executable (if ocamlopt is not available) # plot : log_file.cmo gtk_export.cmo export.cmo plot.cmo @@ -77,13 +71,13 @@ plot : $(LIBPPRZCMXA) $(XLIBPPRZCMXA) %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index d80a46552d..b797093276 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -42,53 +42,58 @@ SIMSCMX=$(SIMSML:%.ml=%.cmx) OCAMLC = ocamlc -g OCAMLOPT = ocamlopt OCAMLDEP = ocamldep +OCAMLFIND = ocamlfind OCAML=$(shell which ocaml) OCAMLRUN=$(shell which ocamlrun) LIBPPRZDIR=../lib/ocaml -INCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format xml-light) +INCLUDES= -I $(LIBPPRZDIR) LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light AIRBORNE = ../airborne VARINCLUDE=$(PAPARAZZI_HOME)/var/include ACINCLUDE = $(PAPARAZZI_HOME)/var/$(AIRCRAFT) -all : gaia sitl.cma simhitl +all : gaia sitl.cma + +#simhitl simhitl : fg.o $(SIMHCMO) simhitl.cmo @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ str.cma xml-light.cma unix.cma glibivy-ocaml.cma lib-pprz.cma lablgtk.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) -make-runtime -o simhitl_run fg.o + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -use-runtime simhitl_run -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $^ sitl.cma : fg.o $(SIMSCMO) @echo OL $@ $(Q)ocamlmklib -o sitl $^ sitl.cmxa : $(SIMSCMX) - ocamlopt -o $@ -a $^ + $(Q)$(OCAMLOPT) -o $@ -a $^ gaia : gaia.cmo @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lib-pprz.cma lablgtk.cma gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $< diffusion : stdlib.cmo diffusion.cmo @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lib-pprz.cma lablgtk.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $^ %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< %.o : %.c @echo OC $< - $(Q)$(OCAMLC) $(FPIC) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(FPIC) -c -package $(PKGCOMMON) $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLOPT) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -c -package $(PKGCOMMON) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< # dependency on lib-pprz simhitl diffusion gaia: $(LIBPPRZCMA) diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 18c8756e2a..d3467991dd 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -23,12 +23,11 @@ # Launch with "make Q=''" to get full echo Q=@ -OCAMLC = ocamlc -OCAMLOPT = ocamlopt -OCAMLDEP = ocamldep -LIBPPRZDIR = ../lib/ocaml -INCLUDES= -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma +include ../Makefile.ocaml + +INCLUDES= -I $(LIBPPRZDIR) +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light + PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo # default directory for temporary files @@ -38,7 +37,7 @@ all: paparazzicenter paparazzicenter : $(PAPARAZZICENTERCMO) $(LIBPPRZDIR)/lib-pprz.cma @echo OL $@ - $(Q)$(OCAMLC) -custom $(INCLUDES) -o $@ unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma gtkInit.cmo lib-pprz.cma xlib-pprz.cma lablgnomeui.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma gtkInit.cmo lablgnomeui.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) $^ gtk_pc.ml : paparazzicenter.glade grep -v invisible_char $< > $(TMPDIR)/$< @@ -50,11 +49,11 @@ gtk_process.ml : paparazzicenter.glade %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLC) $(INCLUDES) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) $< pc_common.cmo: gtk_process.cmo From 446231949b8cbf0916381c054796e762ca866b4f Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 10:24:41 +0100 Subject: [PATCH 006/109] [makefile] more makefile cleaning and dynamic loading --- Makefile | 6 +- sw/ground_segment/cockpit/Makefile | 5 +- sw/ground_segment/joystick/Makefile | 15 +++-- sw/ground_segment/multimon/Makefile | 93 ++++++++++++++--------------- sw/lib/ocaml/Makefile | 4 +- sw/simulator/Makefile | 26 +++----- 6 files changed, 73 insertions(+), 76 deletions(-) diff --git a/Makefile b/Makefile index 10913d67b6..18183b9dac 100644 --- a/Makefile +++ b/Makefile @@ -57,6 +57,7 @@ MULTIMON=sw/ground_segment/multimon COCKPIT=sw/ground_segment/cockpit TMTC=sw/ground_segment/tmtc TOOLS=$(PAPARAZZI_SRC)/sw/tools +JOYSTICK=sw/ground_segment/joystick EXT=sw/ext # @@ -113,7 +114,7 @@ conf/%.xml :conf/%.xml.example ground_segment: print_build_version update_google_version conf lib subdirs commands static -static: cockpit tmtc tools sim_static static_h +static: cockpit tmtc tools sim_static joystick static_h lib: $(MAKE) -C $(LIB)/ocaml @@ -130,6 +131,9 @@ tmtc: lib cockpit multimon tools: lib $(MAKE) -C $(TOOLS) +joystick: lib + $(MAKE) -C $(JOYSTICK) + sim_static: lib $(MAKE) -C $(SIMULATOR) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 477980b2a7..bcf5b72688 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -36,7 +36,7 @@ FPIC=-fPIC include ../../Makefile.ocaml INCLUDES= -LIBS= lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma +LIBS= lablglade.cma lablgnomecanvas.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) CMXA=$(LIBS:.cma=.cmxa) INCLUDES= -I $(LIBPPRZDIR) -I ../multimon @@ -85,7 +85,8 @@ gtk_save_settings.ml : gcs.glade strip.cmo : gtk_strip.cmo gtk_setting_time.cmo compass : compass.ml - $(OCAMLC) -custom $(OCAMLCFLAGS) $(INCLUDES) unix.cma str.cma xml-light.cma $(LIBS) gtkInit.cmo $^ -o $@ + @echo OL $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS) gtkInit.cmo $^ -o $@ clean: diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 49eea08b76..8c99c3b6b8 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -27,13 +27,14 @@ Q=@ include ../../Makefile.ocaml TOOLSDIR = ../../tools -OCAMLINCLUDES= -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) -I $(TOOLSDIR) +OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) +#OCAMLINCLUDES= -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format ivy) -I $(TOOLSDIR) PKGCOMMON=unix,str,lablgtk2,ivy,xml-light LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want #ML_SDL_LFLAGS = $(foreach u,$(shell sdl-config --libs),-cclib $(u)) -ML_SDL_LFLAGS = $(foreach u,$(shell pkg-config sdl --libs-only-L) -lSDL,-cclib $(u)) +ML_SDL_LFLAGS = $(foreach u,$(shell pkg-config sdl --libs-only-L) -lSDL,-cclib $(u)) libSDL.so INCLUDES += -I `ocamlc -where` all: test_stick input2ivy @@ -41,20 +42,22 @@ all: test_stick input2ivy test_stick: test_sdl_stick.o gcc -g -O2 -Wall -DSTICK_DBG `pkg-config glib-2.0 --cflags` -o $@ $^ sdl_stick.c `pkg-config glib-2.0 --libs` -lglibivy `sdl-config --libs` -input2ivy: sdl_stick.o ml_sdl_stick.o input2ivy.cmo +input2ivy: sdl_stick.so input2ivy.cmo @echo OL $@ - $(Q)$(OCAMLC) -make-runtime -o i2i_run sdl_stick.o ml_sdl_stick.o $(ML_SDL_LFLAGS) - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -use-runtime i2i_run -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) # dependency of input2ivy input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo +sdl_stick.so : sdl_stick.o ml_sdl_stick.o + gcc -shared -o $@ $^ + %.o : %.c gcc -c -O2 -Wall `pkg-config glib-2.0 --cflags` $(INCLUDES) $< %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLC) $(OCAMLINCLUDES) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -c -package $(PKGCOMMON) $< clean: rm -f *~ core *.o *.bak .depend test*stick *.cmo *.cmi input2ivy diff --git a/sw/ground_segment/multimon/Makefile b/sw/ground_segment/multimon/Makefile index 0ac487b1b7..e1dfa6436d 100644 --- a/sw/ground_segment/multimon/Makefile +++ b/sw/ground_segment/multimon/Makefile @@ -23,46 +23,43 @@ # Launch with "make Q=''" to get full command display Q=@ -DEBUG =n -MACHINE := $(shell uname -m) -AS86 =as86 -0 -a -LD86 =ld86 -0 -AS =as -LD =ld -LDFLAGS =-lm -HOSTCC =gcc -CC =gcc -MAKE =make -CPP =$(CC) -E -AR =ar -STRIP =strip -MKDIR =mkdir -OCAMLC =ocamlc +DEBUG=n +MACHINE:=$(shell uname -m) +AS86=as86 -0 -a +LD86=ld86 -0 +AS=as +LD=ld +LDFLAGS=-lm +HOSTCC=gcc +CC=gcc +MAKE=make +CPP=$(CC) -E +AR=ar +STRIP=strip +MKDIR=mkdir -CFLAGS =-Wall -Wstrict-prototypes -I/usr/X11R6/include -I`$(OCAMLC) -where` +include ../../Makefile.ocaml + +CFLAGS=-Wall -Wstrict-prototypes -I/usr/X11R6/include -I`$(OCAMLC) -where` ifeq ($(DEBUG),y) - CFLAGS +=-g -O + CFLAGS += -g -O else - CFLAGS +=-O3 + CFLAGS += -O3 endif LBITS := $(shell getconf LONG_BIT) ifeq ($(LBITS),64) - CFLAGS += -fPIC + CFLAGS += -fPIC else ifeq ($(MACHINE),'i686') - CFLAGS += -march=i486 -falign-loops=2 -falign-jumps=2 -falign-functions=2 -DARCH_I386 + CFLAGS += -march=i486 -falign-loops=2 -falign-jumps=2 -falign-functions=2 -DARCH_I386 endif -LDFLAGSX =-lX11 -L/usr/X11R6/lib +LDFLAGSX = -lX11 -L/usr/X11R6/lib -#BINDIR =bin-$(shell uname -m) -BINDIR =. +#BINDIR = bin-$(shell uname -m) +BINDIR =. UNAME = $(shell uname -s) -ifeq ("$(UNAME)","Linux") - OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo - ALLTARGETS=$(BINDIR)/multimon multimon.cma -endif ifeq ("$(UNAME)","linux") OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo ALLTARGETS=$(BINDIR)/multimon multimon.cma @@ -72,34 +69,34 @@ ifeq ("$(UNAME)","Darwin") ALLTARGETS=multimon.cma endif -all: $(ALLTARGETS) +all: $(ALLTARGETS) -multimon.cma: $(OBJFILES) +multimon.cma: $(OBJFILES) @echo OLD $@ $(Q)ocamlmklib -o multimon $^ $(BINDIR)/%.s: %.c - $(CC) $(CFLAGS) -S -o $@ $< + $(CC) $(CFLAGS) -S -o $@ $< $(BINDIR)/%.o: $(BINDIR)/%.s - $(AS) -c -o $@ $< + $(AS) -c -o $@ $< $(BINDIR)/%.o: %.c @echo CC $< $(Q)$(CC) $(CFLAGS) -c -o $@ $< -SRC_L2 = hdlc.c pprz.c -SRC_L1 = demod_afsk48p.c demod_display.c -SRC_MISC = unixinput.c xdisplay.c +SRC_L2 = hdlc.c pprz.c +SRC_L1 = demod_afsk48p.c demod_display.c +SRC_MISC = unixinput.c xdisplay.c -SRC_GEN =gen.c gen_dtmf.c gen_sin.c gen_zvei.c gen_hdlc.c costabi.c +SRC_GEN = gen.c gen_dtmf.c gen_sin.c gen_zvei.c gen_hdlc.c costabi.c -OBJ_L2 =$(SRC_L2:%.c=$(BINDIR)/%.o) -OBJ_L1 =$(SRC_L1:%.c=$(BINDIR)/%.o) -OBJ_MISC =$(SRC_MISC:%.c=$(BINDIR)/%.o) +OBJ_L2 = $(SRC_L2:%.c=$(BINDIR)/%.o) +OBJ_L1 = $(SRC_L1:%.c=$(BINDIR)/%.o) +OBJ_MISC = $(SRC_MISC:%.c=$(BINDIR)/%.o) -OBJ_GEN =$(SRC_GEN:%.c=$(BINDIR)/%.o) +OBJ_GEN = $(SRC_GEN:%.c=$(BINDIR)/%.o) $(BINDIR): $(MKDIR) $(BINDIR) @@ -108,14 +105,14 @@ $(BINDIR)/multimon: $(OBJ_L2) $(OBJ_L1) $(OBJ_MISC) @echo LD $@ $(Q)$(CC) $^ $(LDFLAGS) $(LDFLAGSX) -o $@ -$(BINDIR)/gen: $(OBJ_GEN) - $(CC) $^ $(LDFLAGS) -o $@ +$(BINDIR)/gen: $(OBJ_GEN) + $(CC) $^ $(LDFLAGS) -o $@ $(BINDIR)/mkcostab: $(BINDIR)/mkcostab.o - $(CC) $^ $(LDFLAGS) -o $@ + $(CC) $^ $(LDFLAGS) -o $@ costabi.c costabf.c: $(BINDIR)/mkcostab - $(BINDIR)/mkcostab + $(BINDIR)/mkcostab libtest: pprzlib.o demodml.c demod.ml test.ml @@ -133,11 +130,11 @@ hdlc.cmo : hdlc.cmi $(OCAMLC) $< clean: - rm -fr *.cm* mkcostab .depend - $(RM) -f core `find . -name '*.[oas]' -print` - $(RM) -f core `find . -name 'core' -print` - $(RM) -f core costabi.c costabf.c *~ - $(RM) $(BINDIR)/multimon + $(Q)rm -fr *.cm* mkcostab .depend + $(Q)$(RM) -f core `find . -name '*.[oas]' -print` + $(Q)$(RM) -f core `find . -name 'core' -print` + $(Q)$(RM) -f core costabi.c costabf.c *~ + $(Q)$(RM) $(BINDIR)/multimon .PHONY: all clean depend dep diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 723e29e99b..4b4b5617a5 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -100,7 +100,7 @@ tests : lib-pprz.cma $(TESTS_CMO) GTKCFLAGS := `pkg-config --cflags gtk+-2.0` -%.o : %.c +%.o : %.c @echo OC $< $(Q)$(OCAMLFIND) $(OCAMLC) $(FPIC) $(INCLUDES) -package $(PKGCOMMON) -c $< @@ -110,7 +110,7 @@ ml_gtk_drag.o : ml_gtk_drag.c @echo OC $< $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< -ml_gtkgl_hack.o : ml_gtkgl_hack.c +ml_gtkgl_hack.o : ml_gtkgl_hack.c @echo OC $< $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index b797093276..3e3ce7929f 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -30,6 +30,10 @@ else endif include ../../conf/Makefile.local +include ../Makefile.ocaml + +OCAMLC += -g +PKGCOMMON=unix,str,lablgtk2,ivy,xml-light SIMML = stdlib.ml data.ml flightModel.ml gps.ml SIMHML = $(SIMML) hitl.ml sim.ml @@ -38,31 +42,19 @@ SIMSML = $(SIMML) sitl.ml sim.ml SIMSCMO=$(SIMSML:%.ml=%.cmo) SIMSCMX=$(SIMSML:%.ml=%.cmx) - -OCAMLC = ocamlc -g -OCAMLOPT = ocamlopt -OCAMLDEP = ocamldep -OCAMLFIND = ocamlfind -OCAML=$(shell which ocaml) -OCAMLRUN=$(shell which ocamlrun) -LIBPPRZDIR=../lib/ocaml -INCLUDES= -I $(LIBPPRZDIR) -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light - AIRBORNE = ../airborne VARINCLUDE=$(PAPARAZZI_HOME)/var/include ACINCLUDE = $(PAPARAZZI_HOME)/var/$(AIRCRAFT) -all : gaia sitl.cma +all : gaia sitl.cma simhitl -#simhitl +fg.so : fg.o + gcc -shared -o $@ $^ -simhitl : fg.o $(SIMHCMO) simhitl.cmo +simhitl : fg.so $(SIMHCMO) simhitl.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) -make-runtime -o simhitl_run fg.o - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -use-runtime simhitl_run -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $< sitl.cma : fg.o $(SIMSCMO) @echo OL $@ From 737d7d3c8b72d2165b23cd275b51750afcb079ef Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 11:07:17 +0100 Subject: [PATCH 007/109] [makefile] silence clean target and add missing Makefile --- conf/Makefile.avr | 2 +- conf/gps/Makefile | 5 ++- data/maps/Makefile | 2 +- doc/ccc07/Makefile | 5 ++- doc/pprz_algebra/Makefile | 7 +++- doc/pprz_geodetic/Makefile | 7 +++- sw/Makefile.ocaml | 37 +++++++++++++++++++ sw/airborne/Makefile | 5 ++- .../arch/lpc21/lpcusb/examples/Makefile | 5 ++- .../arch/lpc21/test/bootloader/Makefile | 9 +++-- sw/airborne/booz/test/Makefile | 5 ++- .../firmwares/non_ap/led_flasher/Makefile | 5 ++- sw/airborne/firmwares/vor/Makefile | 5 ++- sw/airborne/fms/Makefile | 5 ++- sw/airborne/fms/libeknav/Makefile | 5 ++- sw/airborne/math/Makefile | 5 ++- sw/airborne/test/Makefile | 5 ++- sw/ground_segment/cockpit/Makefile | 2 +- sw/ground_segment/joystick/Makefile | 2 +- sw/ground_segment/lpc21iap/Makefile | 5 ++- sw/ground_segment/misc/Makefile | 2 +- sw/ground_segment/tmtc/GSM/Makefile | 5 ++- sw/ground_segment/tmtc/Makefile | 2 +- sw/in_progress/button/Makefile | 2 +- sw/in_progress/fdm/Makefile | 2 +- sw/in_progress/inertial/C/Makefile | 5 ++- sw/in_progress/ir_calibration/Makefile | 5 ++- sw/in_progress/ir_usb_i2c/Makefile | 5 ++- sw/in_progress/log_parser/Makefile | 5 ++- sw/in_progress/motor_bench/Makefile | 5 ++- sw/in_progress/satcom/Makefile | 5 ++- sw/in_progress/turbine/Makefile | 5 ++- sw/in_progress/wind_tunnel/Makefile | 5 ++- sw/lib/ocaml/Makefile | 2 +- sw/logalizer/Makefile | 2 +- sw/logalizer/matlab/Makefile | 5 ++- sw/simulator/Makefile | 2 +- sw/simulator/old_booz/tests/Makefile | 3 ++ sw/simulator/scilab/q3d/Makefile | 5 ++- sw/simulator/scilab/q3d/fonts/Makefile | 5 ++- sw/simulator/scilab/q3d/povray/Makefile | 5 ++- sw/simulator/scilab/q6d/povray/Makefile | 5 ++- sw/supervision/Makefile | 2 +- sw/tools/Makefile | 2 +- sw/tools/wiki_gen/Makefile | 2 +- tests/Makefile | 2 +- 46 files changed, 175 insertions(+), 48 deletions(-) create mode 100644 sw/Makefile.ocaml diff --git a/conf/Makefile.avr b/conf/Makefile.avr index 7f38e698cd..621820347d 100644 --- a/conf/Makefile.avr +++ b/conf/Makefile.avr @@ -171,7 +171,7 @@ check_arch : $(Q)if ($(UISP) $(UISP_FLAGS) 2>&1 | tr '[:upper:]' '[:lower:]' | grep $($(TARGET).MCU)); then : ; else echo "Wrong architecture (mcu0 vs mcu1 ?)"; exit 1; fi avr_clean: - rm -rf $(OBJDIR) + $(Q)rm -rf $(OBJDIR) # diff --git a/conf/gps/Makefile b/conf/gps/Makefile index 9cc7e8a4ec..17a823a983 100644 --- a/conf/gps/Makefile +++ b/conf/gps/Makefile @@ -1,11 +1,14 @@ +# Quiet compilation +Q=@ + CC=gcc MODCFLAGS=-Wall all: ublox_conf clean: - rm -f core *.o ublox_conf + $(Q)rm -f core *.o ublox_conf ublox_conf: ublox_conf.c Makefile $(CC) $(MODCFLAGS) ublox_conf.c -o ublox_conf diff --git a/data/maps/Makefile b/data/maps/Makefile index 9e8dd00a43..a2cd1e6bc1 100644 --- a/data/maps/Makefile +++ b/data/maps/Makefile @@ -9,7 +9,7 @@ TMPDIR ?= /tmp all: $(PAPARAZZI_HOME)/conf/maps.xml clean: - rm -f $(DATADIR)/maps.google.com + $(Q)rm -f $(DATADIR)/maps.google.com $(DATADIR): mkdir $(DATADIR) diff --git a/doc/ccc07/Makefile b/doc/ccc07/Makefile index 51e8d67950..85582a8b98 100644 --- a/doc/ccc07/Makefile +++ b/doc/ccc07/Makefile @@ -1,8 +1,11 @@ +# Quiet compilation +Q=@ + slides : slides.tex $(PDF) $(ANIMS) pdflatex slides clean: - rm -f *~ *.log *.nav *.out *.snm *.toc *.aux slides.pdf + $(Q)rm -f *~ *.log *.nav *.out *.snm *.toc *.aux slides.pdf diff --git a/doc/pprz_algebra/Makefile b/doc/pprz_algebra/Makefile index 47828837b5..fce77e95fa 100644 --- a/doc/pprz_algebra/Makefile +++ b/doc/pprz_algebra/Makefile @@ -1,8 +1,11 @@ +# Quiet compilation +Q=@ + doc_pprz_algebra.pdf: headfile.tex pdflatex $< bib: bibtex headfile clean: - rm -f *~ *.aux *.bbl *.blg *.log *.out *.toc *.dvi *.ps - find . -name '*~' -exec rm -f {} \; + $(Q)rm -f *~ *.aux *.bbl *.blg *.log *.out *.toc *.dvi *.ps + $(Q)find . -name '*~' -exec rm -f {} \; diff --git a/doc/pprz_geodetic/Makefile b/doc/pprz_geodetic/Makefile index 47828837b5..fce77e95fa 100644 --- a/doc/pprz_geodetic/Makefile +++ b/doc/pprz_geodetic/Makefile @@ -1,8 +1,11 @@ +# Quiet compilation +Q=@ + doc_pprz_algebra.pdf: headfile.tex pdflatex $< bib: bibtex headfile clean: - rm -f *~ *.aux *.bbl *.blg *.log *.out *.toc *.dvi *.ps - find . -name '*~' -exec rm -f {} \; + $(Q)rm -f *~ *.aux *.bbl *.blg *.log *.out *.toc *.dvi *.ps + $(Q)find . -name '*~' -exec rm -f {} \; diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml new file mode 100644 index 0000000000..70b8699ce8 --- /dev/null +++ b/sw/Makefile.ocaml @@ -0,0 +1,37 @@ +# Hey Emacs, this is a -*- makefile -*- +# +# Copyright (C) 2013 Gautier Hattenberger +# +# 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. +# + +# General ocaml compiling tools and pprz lib + +OCAML = ocaml +OCAMLC = ocamlc +OCAMLOPT = ocamlopt +OCAMLDEP = ocamldep +OCAMLFIND = ocamlfind +LIBPPRZDIR = $(PAPARAZZI_SRC)/sw/lib/ocaml +INCLUDES = -I $(LIBPPRZDIR) +LIBPPRZCMA = $(LIBPPRZDIR)/lib-pprz.cma +LIBPPRZCMXA=$(LIBPPRZCMA:.cma=.cmxa) +XLIBPPRZCMA=$(LIBPPRZDIR)/xlib-pprz.cma +XLIBPPRZCMXA=$(XLIBPPRZCMA:.cma=.cmxa) +OCAMLDLL = -dllpath $(LIBPPRZDIR) +OCAMLXDLL = -dllpath $(LIBPPRZDIR) diff --git a/sw/airborne/Makefile b/sw/airborne/Makefile index ae60d2915f..6062f64897 100644 --- a/sw/airborne/Makefile +++ b/sw/airborne/Makefile @@ -21,6 +21,9 @@ # Boston, MA 02111-1307, USA. # +# Quiet compilation +Q=@ + OBJDIR = $(PAPARAZZI_HOME)/var/$(AIRCRAFT)/$(TARGET) VARINCLUDE=$(PAPARAZZI_HOME)/var/include @@ -75,5 +78,5 @@ warn_conf : @echo clean : - rm -f *~ a.out *.elf + $(Q)rm -f *~ a.out *.elf .PHONY: clean diff --git a/sw/airborne/arch/lpc21/lpcusb/examples/Makefile b/sw/airborne/arch/lpc21/lpcusb/examples/Makefile index e9073abae5..ed8af37aa3 100644 --- a/sw/airborne/arch/lpc21/lpcusb/examples/Makefile +++ b/sw/airborne/arch/lpc21/lpcusb/examples/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + LIBNAME = ../libusbstack APPNAME = main @@ -41,7 +44,7 @@ crt.o: crt.s $(CC) -c $(AFLAGS) -Wa,-ahlms=crt.lst crt.s -o crt.o clean: - rm -f *.hex *.elf *.o *.lst *.dmp *.map .depend + $(Q)rm -f *.hex *.elf *.o *.lst *.dmp *.map .depend # recompile if the Makefile changes $(OBJS): Makefile diff --git a/sw/airborne/arch/lpc21/test/bootloader/Makefile b/sw/airborne/arch/lpc21/test/bootloader/Makefile index 7f7bc7666b..faec6d79e1 100644 --- a/sw/airborne/arch/lpc21/test/bootloader/Makefile +++ b/sw/airborne/arch/lpc21/test/bootloader/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + #PROC_AP PROC_FBW PROC_TINY PROC_TINYJ #PROC = TINYJ ALLFLAGS = -DPROC_$(PROC) @@ -37,9 +40,9 @@ LIBOBJS = usbhw_lpc.o usbcontrol.o usbstdreq.o usbinit.o usbdescrip.o all: lib app app_ram clean: - $(RM) -f $(LIBNAME).a $(LIBOBJS) - $(RM) -f $(APPNAME).hex $(APPNAME).elf $(OBJS) *.lst $(APPNAME).dmp $(APPNAME).map - $(RM) -f $(APPNAME_RAM).hex $(APPNAME_RAM).elf $(APPNAME_RAM).dmp $(APPNAME_RAM).map + $(Q)$(RM) -f $(LIBNAME).a $(LIBOBJS) + $(Q)$(RM) -f $(APPNAME).hex $(APPNAME).elf $(OBJS) *.lst $(APPNAME).dmp $(APPNAME).map + $(Q)$(RM) -f $(APPNAME_RAM).hex $(APPNAME_RAM).elf $(APPNAME_RAM).dmp $(APPNAME_RAM).map # build lib lib: $(LIBOBJS) diff --git a/sw/airborne/booz/test/Makefile b/sw/airborne/booz/test/Makefile index f218803525..164960f6e7 100644 --- a/sw/airborne/booz/test/Makefile +++ b/sw/airborne/booz/test/Makefile @@ -21,6 +21,9 @@ # Boston, MA 02111-1307, USA. ## +# Quiet compilation +Q=@ + CC = gcc CFLAGS = -std=gnu99 -Wall -I.. -I../.. -I../../test/ -I../../../include -I../../booz_priv LDFLAGS = -lm @@ -51,4 +54,4 @@ test_att_ref: test_att_ref.c ../stabilization/booz_stabilization_attitude_ref_qu clean: - rm -f *~ test_att_ref + $(Q)rm -f *~ test_att_ref diff --git a/sw/airborne/firmwares/non_ap/led_flasher/Makefile b/sw/airborne/firmwares/non_ap/led_flasher/Makefile index 9408d7238f..33305dca62 100644 --- a/sw/airborne/firmwares/non_ap/led_flasher/Makefile +++ b/sw/airborne/firmwares/non_ap/led_flasher/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + MCU = attiny25 PROG = dragon_isp @@ -19,7 +22,7 @@ SOURCES = blitzer.c all: $(APPNAME) clean: - $(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).elf $(APPNAME).hex + $(Q)$(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).elf $(APPNAME).hex app: $(APPNAME) diff --git a/sw/airborne/firmwares/vor/Makefile b/sw/airborne/firmwares/vor/Makefile index 2a8cdd9f0c..d55b7cd51d 100644 --- a/sw/airborne/firmwares/vor/Makefile +++ b/sw/airborne/firmwares/vor/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + all: CFLAGS = -Wall -I.. @@ -25,7 +28,7 @@ play_audio: sndfile-play.c gcc $(CFLAGS) $^ -o $@ $(LDFLAGS) -lsndfile -lasound clean: - rm -f i86_vor_test_float_demod \ + $(Q)rm -f i86_vor_test_float_demod \ i86_vor_test_int_demod \ i86_vor_test_filters \ *~ \#* diff --git a/sw/airborne/fms/Makefile b/sw/airborne/fms/Makefile index 6e568312f7..588e846c28 100644 --- a/sw/airborne/fms/Makefile +++ b/sw/airborne/fms/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + CFLAGS = -Wall $(shell pkg-config --cflags glib-2.0) -g LDFLAGS = $(shell pkg-config --libs glib-2.0) @@ -49,4 +52,4 @@ onboard_logger: onboard_logger.c $(CC) $(CFLAGS) -o $@ $^ -lpcap clean: - rm -f *~ fms test_telemetry + $(Q)rm -f *~ fms test_telemetry diff --git a/sw/airborne/fms/libeknav/Makefile b/sw/airborne/fms/libeknav/Makefile index 5f0c3e111f..b79daa59ba 100644 --- a/sw/airborne/fms/libeknav/Makefile +++ b/sw/airborne/fms/libeknav/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + raw_log_to_ascii: raw_log_to_ascii.c gcc -I../../ -I../../../include -std=gnu99 -Wall raw_log_to_ascii.c -DOVERO_LINK_MSG_UP=AutopilotMessageVIUp -DOVERO_LINK_MSG_DOWN=AutopilotMessageVIDown -o raw_log_to_ascii @@ -26,4 +29,4 @@ run_filter_on_log: ./libeknav_from_log.cpp $(LIBEKNAV_SRCS) ../../math/pprz_geod g++ -I/usr/include/eigen2 -I../.. -I../../../include -I../../../../var/FY $(eknavOnLogFlags) -o $@ $^ clean: - -rm -f *.o *~ *.d + $(Q)rm -f *.o *~ *.d diff --git a/sw/airborne/math/Makefile b/sw/airborne/math/Makefile index 7030d668bf..f9caa61f30 100644 --- a/sw/airborne/math/Makefile +++ b/sw/airborne/math/Makefile @@ -1,6 +1,9 @@ # Build shared pprz math library # +# Quiet compilation +Q=@ + CC= gcc CFLAGS= -fpic INCLUDES= -I$(PAPARAZZI_SRC)/sw/include -I$(PAPARAZZI_SRC)/sw/airborne @@ -43,5 +46,5 @@ $(BUILDDIR)/%.o: %.c $(CC) -c $< $(CFLAGS) $(INCLUDES) -o $@ clean: - rm -f $(BUILDDIR)/*.o $(BUILDDIR)/$(LIBNAME).so + $(Q)rm -f $(BUILDDIR)/*.o $(BUILDDIR)/$(LIBNAME).so diff --git a/sw/airborne/test/Makefile b/sw/airborne/test/Makefile index 13aeae8f7d..f8e05d1151 100644 --- a/sw/airborne/test/Makefile +++ b/sw/airborne/test/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + CC = gcc CFLAGS = -std=c99 -I.. -I../../include -I../booz -I../../booz -Wall @@ -33,4 +36,4 @@ test_fmul: test_fmul.c $(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS) clean: - rm -f *~ test_geodetic test_algebra *.exe + $(Q)rm -f *~ test_geodetic test_algebra *.exe diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index bcf5b72688..64d24ea629 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -90,7 +90,7 @@ compass : compass.ml clean: - rm -f *~* *.cm* *.o *.out *.opt map2d gcs .depend gtk_strip.ml gtk_setting_time.ml gtk_save_settings.ml compass ant_track ant_track_pmm test_enose actuators + $(Q)rm -f *~* *.cm* *.o *.out *.opt map2d gcs .depend gtk_strip.ml gtk_setting_time.ml gtk_save_settings.ml compass ant_track ant_track_pmm test_enose actuators .PHONY: all opt clean diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 8c99c3b6b8..94fb7be2dc 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -60,7 +60,7 @@ sdl_stick.so : sdl_stick.o ml_sdl_stick.o $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -c -package $(PKGCOMMON) $< clean: - rm -f *~ core *.o *.bak .depend test*stick *.cmo *.cmi input2ivy + $(Q)rm -f *~ core *.o *.bak .depend test*stick *.cmo *.cmi input2ivy .PHONY: all clean diff --git a/sw/ground_segment/lpc21iap/Makefile b/sw/ground_segment/lpc21iap/Makefile index aa21d78a0b..d23ffc95b9 100644 --- a/sw/ground_segment/lpc21iap/Makefile +++ b/sw/ground_segment/lpc21iap/Makefile @@ -1,5 +1,8 @@ #MS VC: cl lpc21iap.c elf.c lpcusb.c libusb.lib +# Quiet compilation +Q=@ + LIBNAME = usb APPNAME = lpc21iap @@ -38,7 +41,7 @@ SOURCES = lpc21iap.c elf.c lpcusb.c all: $(APPNAME) clean: - $(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).obj $(APPNAME).exe + $(Q)$(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).obj $(APPNAME).exe app: $(APPNAME) diff --git a/sw/ground_segment/misc/Makefile b/sw/ground_segment/misc/Makefile index b07280b130..b703963916 100644 --- a/sw/ground_segment/misc/Makefile +++ b/sw/ground_segment/misc/Makefile @@ -38,7 +38,7 @@ endif all: davis2ivy kestrel2ivy clean: - rm -f *.o davis2ivy kestrel2ivy + $(Q)rm -f *.o davis2ivy kestrel2ivy davis2ivy: davis2ivy.o $(Q)$(CC) -o davis2ivy davis2ivy.o $(LIBRARYS) -livy diff --git a/sw/ground_segment/tmtc/GSM/Makefile b/sw/ground_segment/tmtc/GSM/Makefile index 697b8399d9..b4a17b6b54 100644 --- a/sw/ground_segment/tmtc/GSM/Makefile +++ b/sw/ground_segment/tmtc/GSM/Makefile @@ -1,7 +1,10 @@ +# Quiet compilation +Q=@ + all: SMS_GS SMS_GS: SMS_Ground_UDtest_final.c gcc -g -O2 -Wall `pkg-config --cflags glib-2.0 gtk+-2.0` -L/usr/lib -lglibivy -o SMS_GS SMS_Ground_UDtest_final.c `pkg-config --libs glib-2.0 gtk+-2.0` -lglibivy clean: - rm -f SMS_GS + $(Q)rm -f SMS_GS diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 735aa4e1a1..c410f21add 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -49,7 +49,7 @@ all: link server messages dia diadec $(VAR)/boa.conf ivy_tcp_aircraft ivy_tcp_co #settings clean: - rm -f link server messages settings dia diadec *.bak *~ core *.o .depend *.opt *.out *.cm* ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge gpsd2ivy c_ivy_client_example_1 c_ivy_client_example_2 c_ivy_client_example_3 + $(Q)rm -f link server messages settings dia diadec *.bak *~ core *.o .depend *.opt *.out *.cm* ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge gpsd2ivy c_ivy_client_example_1 c_ivy_client_example_2 c_ivy_client_example_3 $(VAR)/boa.conf :$(CONF)/boa.conf diff --git a/sw/in_progress/button/Makefile b/sw/in_progress/button/Makefile index 73f653b0d5..f655b57a5d 100644 --- a/sw/in_progress/button/Makefile +++ b/sw/in_progress/button/Makefile @@ -72,7 +72,7 @@ MORE_FLAGS = -I/usr/include/gtk-1.2 -I/usr/include/glib-1.2 -I/usr/lib/glib/incl MORE_CFLAGS = -DHAVE_DLFCN_H=1 -DSTDC_HEADERS=1 -I. -I. -I.. -g -O2 -I/usr/include/gtk-1.2 -I/usr/include/glib-1.2 -I/usr/lib/glib/include clean: - rm -f *.opt *.out *~ core *.o *.bak .depend *.cm* panic + $(Q)rm -f *.opt *.out *~ core *.o *.bak .depend *.cm* panic #FGFS_PREFIX=/home/poine/local FGFS_PREFIX=/home/poine/flightgear diff --git a/sw/in_progress/fdm/Makefile b/sw/in_progress/fdm/Makefile index 1589709003..265f34be4f 100644 --- a/sw/in_progress/fdm/Makefile +++ b/sw/in_progress/fdm/Makefile @@ -35,4 +35,4 @@ fms_steps_attitude: fms_steps_attitude.c clean: - rm -f *~ core *.o *.bak .depend fdm_step fms_steps_attitude + $(Q)rm -f *~ core *.o *.bak .depend fdm_step fms_steps_attitude diff --git a/sw/in_progress/inertial/C/Makefile b/sw/in_progress/inertial/C/Makefile index 2c893ed041..c0e8483ea6 100644 --- a/sw/in_progress/inertial/C/Makefile +++ b/sw/in_progress/inertial/C/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + CFLAGS = -g -Wall `pkg-config glib-2.0 --cflags` LDFLAGS = `pkg-config glib-2.0 --libs` -lm @@ -127,4 +130,4 @@ test_ukf: $(OBJS_TEST_UKF) clean: - rm -f *~ *.o tilt_ukf tilt_ekf tilt_fast_ekf ahrs_euler_ekf ahrs_quat_ukf ahrs_quat_ekf ahrs_quat_fast_ekf test_matrix test_ukf \ No newline at end of file + $(Q)rm -f *~ *.o tilt_ukf tilt_ekf tilt_fast_ekf ahrs_euler_ekf ahrs_quat_ukf ahrs_quat_ekf ahrs_quat_fast_ekf test_matrix test_ukf diff --git a/sw/in_progress/ir_calibration/Makefile b/sw/in_progress/ir_calibration/Makefile index 6924422e1d..662e015cf3 100644 --- a/sw/in_progress/ir_calibration/Makefile +++ b/sw/in_progress/ir_calibration/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + CC = gcc CFLAGS=-g -O2 -Wall `pkg-config gtk+-2.0 --cflags` @@ -8,4 +11,4 @@ ir_calib : main.c calibrator.c gui.c $(CC) $(CFLAGS) -g -o $@ $^ $(LDFLAGS) clean: - rm -f *~ ir_calib + $(Q)rm -f *~ ir_calib diff --git a/sw/in_progress/ir_usb_i2c/Makefile b/sw/in_progress/ir_usb_i2c/Makefile index ea917551d1..0de9eb6d92 100644 --- a/sw/in_progress/ir_usb_i2c/Makefile +++ b/sw/in_progress/ir_usb_i2c/Makefile @@ -2,12 +2,15 @@ # Makefile # +# Quiet compilation +Q=@ + APP = i2c_usb all: $(APP) clean: - rm -f $(APP) + $(Q)rm -f $(APP) $(APP): $(APP).c $(CC) -Wall -o $@ $(APP).c -lusb diff --git a/sw/in_progress/log_parser/Makefile b/sw/in_progress/log_parser/Makefile index 7461a91191..6c5e307a65 100644 --- a/sw/in_progress/log_parser/Makefile +++ b/sw/in_progress/log_parser/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + #LIBNAME = efsl APPNAME = linuxtest @@ -24,7 +27,7 @@ SOURCES = linuxtest.c all: $(APPNAME) clean: - $(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).obj $(APPNAME).exe + $(Q)$(RM) -f core $(APPNAME).o $(APPNAME) $(APPNAME).obj $(APPNAME).exe app: $(APPNAME) diff --git a/sw/in_progress/motor_bench/Makefile b/sw/in_progress/motor_bench/Makefile index b08228faec..f103caabec 100644 --- a/sw/in_progress/motor_bench/Makefile +++ b/sw/in_progress/motor_bench/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + CC = gcc CFLAGS=-g -O2 -Wall `pkg-config gtk+-2.0 --cflags` -I../../../var/MB LDFLAGS=`pkg-config gtk+-2.0 --libs` -s -lglibivy @@ -13,5 +16,5 @@ plot_test: scilab -f test.sce -args $(LOG) clean: - rm -f *~ motor_bench + $(Q)rm -f *~ motor_bench diff --git a/sw/in_progress/satcom/Makefile b/sw/in_progress/satcom/Makefile index 0c780f676d..a45c21e257 100644 --- a/sw/in_progress/satcom/Makefile +++ b/sw/in_progress/satcom/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + all: email2udp udp2tcp tcp2ivy email2udp: email2udp.c @@ -10,4 +13,4 @@ tcp2ivy_generic: tcp2ivy_generic.c gcc -g -O2 -Wall `pkg-config glib-2.0 --cflags` -I../../../var/${AIRCRAFT} -o $@ $^ `pkg-config glib-2.0 --libs` -lglibivy -lm clean: - rm -f email2udp udp2tcp tcp2ivy + $(Q)rm -f email2udp udp2tcp tcp2ivy diff --git a/sw/in_progress/turbine/Makefile b/sw/in_progress/turbine/Makefile index 08d8029d5d..05f36c7856 100644 --- a/sw/in_progress/turbine/Makefile +++ b/sw/in_progress/turbine/Makefile @@ -1,11 +1,14 @@ +# Quiet compilation +Q=@ + CC=gcc MODCFLAGS=-Wall all: turb_simu clean: - rm -f core *.o turb_simu + $(Q)rm -f core *.o turb_simu ublox_conf: ublox_conf.c Makefile $(CC) $(MODCFLAGS) turb_simu.c -o turb_simu diff --git a/sw/in_progress/wind_tunnel/Makefile b/sw/in_progress/wind_tunnel/Makefile index 00d292d5b9..b96cb01933 100644 --- a/sw/in_progress/wind_tunnel/Makefile +++ b/sw/in_progress/wind_tunnel/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + CC = gcc GLIB_CFLAGS = -Wall `pkg-config glib-2.0 --cflags` GLIB_LDFLAGS = `pkg-config glib-2.0 --libs` -lglibivy -lpcre @@ -8,4 +11,4 @@ main: main.c serial_port.c clean: - rm -f main \ No newline at end of file + $(Q)rm -f main diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 4b4b5617a5..21c926fac6 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -173,7 +173,7 @@ gtk_papget_led_editor.ml : widgets.glade @rm $(TMPDIR)/$@_$< clean : - rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli + $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli .PHONY: all opt clean diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 48198af98a..6a16b23398 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -182,7 +182,7 @@ ctrlstick: ctrlstick.c $(CC) -g -O2 -Wall `pkg-config glib-2.0 --cflags` -o $@ $^ `pkg-config glib-2.0 --libs` -lglibivy clean: - rm -f *.opt *.out *~ core *.o *.bak .depend *.cm* play ahrsview imuview ahrs2fg plot plotter gtk_export.ml openlog2tlm disp3d plotprofile test1 test3 test_samere ivy_example tmclient ffjoystick ctrlstick sd2log motor_bench + $(Q)rm -f *.opt *.out *~ core *.o *.bak .depend *.cm* play ahrsview imuview ahrs2fg plot plotter gtk_export.ml openlog2tlm disp3d plotprofile test1 test3 test_samere ivy_example tmclient ffjoystick ctrlstick sd2log motor_bench .PHONY: all clean pt run_fg diff --git a/sw/logalizer/matlab/Makefile b/sw/logalizer/matlab/Makefile index 8d25b837bc..209d0dac42 100644 --- a/sw/logalizer/matlab/Makefile +++ b/sw/logalizer/matlab/Makefile @@ -1,2 +1,5 @@ +# Quiet compilation +Q=@ + clean: - rm -f *~ + $(Q)rm -f *~ diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index 3e3ce7929f..83f6f22f58 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -91,7 +91,7 @@ diffusion : stdlib.cmo diffusion.cmo simhitl diffusion gaia: $(LIBPPRZCMA) clean : - rm -f *.cm* *~ *.out .depend *.o *.a *.so gaia simhitl diffusion + $(Q)rm -f *.cm* *~ *.out .depend *.o *.a *.so gaia simhitl diffusion .PHONY: all clean diff --git a/sw/simulator/old_booz/tests/Makefile b/sw/simulator/old_booz/tests/Makefile index eb7ed64047..4fbd86e779 100644 --- a/sw/simulator/old_booz/tests/Makefile +++ b/sw/simulator/old_booz/tests/Makefile @@ -3,6 +3,8 @@ # #JSBSIM = /usr/local +Q=@ + #CC = g++ #CFLAGS = -Wall -I$(JSBSIM)/include/JSBSim -I../include #LDFLAGS = -L$(JSBSIM)/lib -lJSBSim @@ -70,4 +72,5 @@ test_sensors : $(TEST_SENSORS_SRCS) gcc $(CFLAGS) -o $@ $^ $(LDFLAGS) clean: + $(Q)rm -f *.o diff --git a/sw/simulator/scilab/q3d/Makefile b/sw/simulator/scilab/q3d/Makefile index 0fcfc631b1..006ed84ac5 100644 --- a/sw/simulator/scilab/q3d/Makefile +++ b/sw/simulator/scilab/q3d/Makefile @@ -1,4 +1,7 @@ +# Quiet compilation +Q=@ + @@ -7,4 +10,4 @@ out.mpg: ffmpeg -f image2 -i images/frame_%04d.ppm out.mpg clean: - rm -f *~ \#*\# \ No newline at end of file + $(Q)rm -f *~ \#*\# diff --git a/sw/simulator/scilab/q3d/fonts/Makefile b/sw/simulator/scilab/q3d/fonts/Makefile index f99fbddd80..366ca57185 100644 --- a/sw/simulator/scilab/q3d/fonts/Makefile +++ b/sw/simulator/scilab/q3d/fonts/Makefile @@ -1,3 +1,6 @@ +# Quiet compilation +Q=@ + CC = gcc GLIB_CFLAGS = -Wall `pkg-config glib-2.0 --cflags` GLIB_LDFLAGS = `pkg-config glib-2.0 --libs` -lglibivy -lpcre @@ -6,5 +9,5 @@ ttx2scilab: ttx2scilab.c $(CC) -Wall $(GLIB_CFLAGS) -o $@ $< $(GLIB_LDFLAGS) clean: - rm -f ttx2scilab + $(Q)rm -f ttx2scilab diff --git a/sw/simulator/scilab/q3d/povray/Makefile b/sw/simulator/scilab/q3d/povray/Makefile index 2d511221a7..96349617b7 100644 --- a/sw/simulator/scilab/q3d/povray/Makefile +++ b/sw/simulator/scilab/q3d/povray/Makefile @@ -1,2 +1,5 @@ +# Quiet compilation +Q=@ + clean: - rm -f *~ foo*.png test.avi q3d.pov \ No newline at end of file + $(Q)rm -f *~ foo*.png test.avi q3d.pov diff --git a/sw/simulator/scilab/q6d/povray/Makefile b/sw/simulator/scilab/q6d/povray/Makefile index f799787b8a..2e0f53adbc 100644 --- a/sw/simulator/scilab/q6d/povray/Makefile +++ b/sw/simulator/scilab/q6d/povray/Makefile @@ -1,5 +1,8 @@ +# Quiet compilation +Q=@ + test: povray test.pov +Oimg001.png Display=false +W800 +H600 +Q9 +A0.3 +R5 clean: - rm -f *~ img*.png test.avi q3d.pov + $(Q)rm -f *~ img*.png test.avi q3d.pov diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index d3467991dd..d6e7279a6c 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -60,7 +60,7 @@ pc_common.cmo: gtk_process.cmo paparazzicenter.cmo : gtk_pc.cmo clean: - \rm -f *.cm* gtk_pc.ml gtk_process.ml .depend paparazzicenter + $(Q)rm -f *.cm* gtk_pc.ml gtk_process.ml .depend paparazzicenter .PHONY: all clean diff --git a/sw/tools/Makefile b/sw/tools/Makefile index 8957d4766c..cb959ef880 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -61,7 +61,7 @@ mergelogs: mergelogs.c gcc mergelogs.c -o mergelogs clean: - rm -f *.cm* *.out *~ .depend fp_parser.ml fp_parser.mli mergelogs + $(Q)rm -f *.cm* *.out *~ .depend fp_parser.ml fp_parser.mli mergelogs .PHONY: all clean diff --git a/sw/tools/wiki_gen/Makefile b/sw/tools/wiki_gen/Makefile index 766bb4b561..3bae53e3d4 100644 --- a/sw/tools/wiki_gen/Makefile +++ b/sw/tools/wiki_gen/Makefile @@ -46,4 +46,4 @@ OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(Q)$(OCAMLYACC) $< clean: - rm -f *.cm* *.out *~ + $(Q)rm -f *.cm* *.out *~ diff --git a/tests/Makefile b/tests/Makefile index bdbbfa35c6..a06af1922a 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -28,5 +28,5 @@ test: $(Q)$(PERLENV) $(PERL) "-e" "$(RUNTESTS)" clean: - rm -rf results/* + $(Q)rm -rf results/* From bea674efd3d2dc762dee0954af0bad70af115ebd Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 11:16:12 +0100 Subject: [PATCH 008/109] [makefile] fix multimon makefile --- sw/ground_segment/multimon/Makefile | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/sw/ground_segment/multimon/Makefile b/sw/ground_segment/multimon/Makefile index e1dfa6436d..af354b9d47 100644 --- a/sw/ground_segment/multimon/Makefile +++ b/sw/ground_segment/multimon/Makefile @@ -60,6 +60,10 @@ LDFLAGSX = -lX11 -L/usr/X11R6/lib BINDIR =. UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Linux") + OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo + ALLTARGETS=$(BINDIR)/multimon multimon.cma +endif ifeq ("$(UNAME)","linux") OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo ALLTARGETS=$(BINDIR)/multimon multimon.cma @@ -131,7 +135,7 @@ hdlc.cmo : hdlc.cmi clean: $(Q)rm -fr *.cm* mkcostab .depend - $(Q)$(RM) -f core `find . -name '*.[oas]' -print` + $(Q)$(RM) -f core `find . -name '*.[oas]' -print` *.so $(Q)$(RM) -f core `find . -name 'core' -print` $(Q)$(RM) -f core costabi.c costabf.c *~ $(Q)$(RM) $(BINDIR)/multimon From d1bae05ca0bd082ecdc1dc41d4fa8e8c19f2aed7 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 11:27:33 +0100 Subject: [PATCH 009/109] [makefile] multimon dll path --- sw/ground_segment/tmtc/Makefile | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index c410f21add..e7ec0474ff 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -40,6 +40,7 @@ INCLUDES= -I $(LIBPPRZDIR) -I ../multimon PKGCOMMON=unix,str,lablgtk2,ivy,xml-light,netstring,netclient LIBMULTIMONCMA=../multimon/multimon.cma +LIBMULTIMONDLL= multimon.cma -dllpath $(PAPARAZZI_SRC)/sw/ground_segment/multimon SERVERCMO = server_globals.cmo aircraft.cmo wind.cmo airprox.cmo kml.cmo fw_server.ml rotorcraft_server.ml server.cmo SERVERCMX = $(SERVERCMO:.cmo=.cmx) @@ -77,22 +78,22 @@ server.opt : $(SERVERCMX) $(LIBPPRZCMXA) link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) @@ -102,12 +103,12 @@ ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) dia : dia.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< diadec : diadec.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) multimon.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< 150m : 150m.cmo $(LIBPPRZCMA) From 00018d3297a8a60d59d9fa1b04426d8b52f4d1eb Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 14:16:49 +0100 Subject: [PATCH 010/109] [makefile] seems to work fine now --- conf/Makefile.sim | 14 ++++++++++---- sw/Makefile.ocaml | 8 ++++---- sw/airborne/Makefile | 4 ---- sw/ground_segment/cockpit/Makefile | 2 +- sw/ground_segment/joystick/Makefile | 4 +--- sw/ground_segment/tmtc/Makefile | 2 +- sw/lib/ocaml/Makefile | 2 +- sw/simulator/Makefile | 3 ++- sw/tools/Makefile | 13 ++++++++----- 9 files changed, 28 insertions(+), 24 deletions(-) diff --git a/conf/Makefile.sim b/conf/Makefile.sim index d494e44845..7f95aad73d 100644 --- a/conf/Makefile.sim +++ b/conf/Makefile.sim @@ -27,10 +27,12 @@ # this should not be needed SRC_ARCH = arch/sim +include $(PAPARAZZI_SRC)/sw/Makefile.ocaml + CC = gcc -OCAMLC = ocamlc SIMDIR = $(PAPARAZZI_SRC)/sw/simulator -CAMLINCLUDES = $(shell ocamlfind query -r -i-format lablgtk2) -I $(PAPARAZZI_SRC)/sw/lib/ocaml -I $(SIMDIR) $(shell ocamlfind query -r -i-format xml-light) +CAMLINCLUDES = -I $(LIBPPRZDIR) -I $(SIMDIR) -I $(OBJDIR) +PKGCOMMON = unix,str,xml-light,glibivy,lablgtk2 SIMSITLML = $(OBJDIR)/simsitl.ml MYGTKINITCMO = myGtkInit.cmo SITLCMA = $(SIMDIR)/sitl.cma @@ -65,10 +67,14 @@ $(TARGET).objs = $($(TARGET).objso:%.S=$(OBJDIR)/%.o) all compile: $(OBJDIR)/simsitl +# shared library of the C autopilot part +autopilot.so : $($(TARGET).objs) + @echo BUILD $@ + $(Q)$(CC) -shared -o $(OBJDIR)/$@ $^ -$(OBJDIR)/simsitl : $($(TARGET).objs) $(SITLCMA) $(SIMSITLML) +$(OBJDIR)/simsitl : autopilot.so $(SITLCMA) $(SIMSITLML) @echo LD $@ - $(Q)$(OCAMLC) -g -custom $(CAMLINCLUDES) -o $@ unix.cma str.cma xml-light.cma glibivy-ocaml.cma lib-pprz.cma lablgtk.cma $($(TARGET).objs) $(MYGTKINITCMO) $(SITLCMA) $(SIMSITLML) + $(Q)$(OCAMLFIND) $(OCAMLC) -g $(CAMLINCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) # The id of the A/C is hardcoded in the code (to be improved with dynlink ?) diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml index 70b8699ce8..3073724ed4 100644 --- a/sw/Makefile.ocaml +++ b/sw/Makefile.ocaml @@ -28,10 +28,10 @@ OCAMLOPT = ocamlopt OCAMLDEP = ocamldep OCAMLFIND = ocamlfind LIBPPRZDIR = $(PAPARAZZI_SRC)/sw/lib/ocaml -INCLUDES = -I $(LIBPPRZDIR) LIBPPRZCMA = $(LIBPPRZDIR)/lib-pprz.cma -LIBPPRZCMXA=$(LIBPPRZCMA:.cma=.cmxa) -XLIBPPRZCMA=$(LIBPPRZDIR)/xlib-pprz.cma -XLIBPPRZCMXA=$(XLIBPPRZCMA:.cma=.cmxa) +LIBPPRZCMXA = $(LIBPPRZCMA:.cma=.cmxa) +XLIBPPRZCMA = $(LIBPPRZDIR)/xlib-pprz.cma +XLIBPPRZCMXA = $(XLIBPPRZCMA:.cma=.cmxa) OCAMLDLL = -dllpath $(LIBPPRZDIR) OCAMLXDLL = -dllpath $(LIBPPRZDIR) + diff --git a/sw/airborne/Makefile b/sw/airborne/Makefile index 6062f64897..258ae943c8 100644 --- a/sw/airborne/Makefile +++ b/sw/airborne/Makefile @@ -50,10 +50,6 @@ ifneq ($(MAKECMDGOALS),clean) # sort cflags and sources to throw out duplicates # - #$(info CFLAGS_orig = $($(TARGET).CFLAGS)) - #$(info CFLAGS_sort = $(sort $($(TARGET).CFLAGS))) - #$(info srcs_orig = $($(TARGET).srcs)) - #$(info srcs_sort = $(sort $($(TARGET).srcs))) $(TARGET).CFLAGS := $(sort $($(TARGET).CFLAGS)) $(TARGET).srcs := $(sort $($(TARGET).srcs)) endif diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 64d24ea629..5330cf4154 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -40,7 +40,7 @@ LIBS= lablglade.cma lablgnomecanvas.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $ CMXA=$(LIBS:.cma=.cmxa) INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light,netstring,netclient,threads +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring,netclient,threads ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml particules.ml papgets.ml gcs.ml MAIN=gcs diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 94fb7be2dc..11eeb322b1 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -28,12 +28,10 @@ include ../../Makefile.ocaml TOOLSDIR = ../../tools OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) -#OCAMLINCLUDES= -I $(LIBPPRZDIR) $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format ivy) -I $(TOOLSDIR) -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want -#ML_SDL_LFLAGS = $(foreach u,$(shell sdl-config --libs),-cclib $(u)) ML_SDL_LFLAGS = $(foreach u,$(shell pkg-config sdl --libs-only-L) -lSDL,-cclib $(u)) libSDL.so INCLUDES += -I `ocamlc -where` diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index e7ec0474ff..3969976304 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -37,7 +37,7 @@ CONF = ../../../conf VAR = ../../../var INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light,netstring,netclient +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring,netclient LIBMULTIMONCMA=../multimon/multimon.cma LIBMULTIMONDLL= multimon.cma -dllpath $(PAPARAZZI_SRC)/sw/ground_segment/multimon diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 21c926fac6..540a64a151 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -50,7 +50,7 @@ endif INCLUDES= PKGCOMMON=xml-light,netclient,ivy,lablgtk2 XINCLUDES= -XPKGCOMMON=lablgtk2,xml-light,ivy +XPKGCOMMON=lablgtk2,xml-light,glibivy 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index 83f6f22f58..a61d583aae 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -33,7 +33,8 @@ include ../../conf/Makefile.local include ../Makefile.ocaml OCAMLC += -g -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light +INCLUDES = -I $(LIBPPRZDIR) +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light SIMML = stdlib.ml data.ml flightModel.ml gps.ml SIMHML = $(SIMML) hitl.ml sim.ml diff --git a/sw/tools/Makefile b/sw/tools/Makefile index cb959ef880..ab2a8df10f 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -24,6 +24,9 @@ Q=@ include ../Makefile.ocaml +INCLUDES = -I $(LIBPPRZDIR) +PKGCOMMON=unix,str,xml-light,ivy + all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs FP_CMO = fp_proc.cmo gen_flight_plan.cmo @@ -31,15 +34,15 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lib-pprz.cma $^ gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,netclient,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON),netclient -linkpkg $(OCAMLDLL) lib-pprz.cma $< %.out : %.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg $(OCAMLDLL) lib-pprz.cma gen_common.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lib-pprz.cma gen_common.cmo $< # disable this for now and use the compiled bytecode #@cat ../../pprz_src_test.sh > $@ @@ -48,11 +51,11 @@ gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package xml-light -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) lib-pprz.cma -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package xml-light -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) lib-pprz.cma -c $< # dependency on lib-pprz gen_flight_plan.out gen_srtm.out : $(LIBPPRZCMA) From 8c7429e5559d1992f068225803d0938f16d70677 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 22 Feb 2013 13:54:19 +0100 Subject: [PATCH 011/109] [makefile] deduplication in mutimon makefile --- sw/ground_segment/multimon/Makefile | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/sw/ground_segment/multimon/Makefile b/sw/ground_segment/multimon/Makefile index af354b9d47..7ba8d002fd 100644 --- a/sw/ground_segment/multimon/Makefile +++ b/sw/ground_segment/multimon/Makefile @@ -60,15 +60,11 @@ LDFLAGSX = -lX11 -L/usr/X11R6/lib BINDIR =. UNAME = $(shell uname -s) -ifeq ("$(UNAME)","Linux") +ifneq (,$(findstring $(UNAME),linux Linux)) OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo ALLTARGETS=$(BINDIR)/multimon multimon.cma endif -ifeq ("$(UNAME)","linux") - OBJFILES=pprzlib.o hdlc.o demod_afsk12.o demodml.o costabi.o gen_hdlc.o ml_hdlc.o demod.cmo hdlc.cmo - ALLTARGETS=$(BINDIR)/multimon multimon.cma -endif -ifeq ("$(UNAME)","Darwin") +ifeq ($(UNAME),Darwin) OBJFILES=demodml.o ml_hdlc.o demod.cmo hdlc.cmo ALLTARGETS=multimon.cma endif From 1811919fac75467e4e1ea1c93cb578d168b0acf0 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 22 Feb 2013 14:18:04 +0100 Subject: [PATCH 012/109] [makefile] make joystick compile on 64bit --- sw/ground_segment/joystick/Makefile | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 11eeb322b1..1e66333fef 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -35,6 +35,13 @@ LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma ML_SDL_LFLAGS = $(foreach u,$(shell pkg-config sdl --libs-only-L) -lSDL,-cclib $(u)) libSDL.so INCLUDES += -I `ocamlc -where` +LBITS := $(shell getconf LONG_BIT) +ifeq ($(LBITS),64) + FPIC = -fpic +else + FPIC = +endif + all: test_stick input2ivy test_stick: test_sdl_stick.o @@ -51,7 +58,7 @@ sdl_stick.so : sdl_stick.o ml_sdl_stick.o gcc -shared -o $@ $^ %.o : %.c - gcc -c -O2 -Wall `pkg-config glib-2.0 --cflags` $(INCLUDES) $< + gcc -c -O2 -Wall `pkg-config glib-2.0 --cflags` $(FPIC) $(INCLUDES) $< %.cmo : %.ml @echo OC $< From 388a72a079fe218f6e0202966a22922b47a82712 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 22 Feb 2013 14:58:49 +0100 Subject: [PATCH 013/109] [makefile] minor fixes/cleanup for joystick --- sw/ground_segment/joystick/Makefile | 34 ++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 1e66333fef..51bdb19982 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -27,25 +27,37 @@ Q=@ include ../../Makefile.ocaml TOOLSDIR = ../../tools +CC = gcc + +LBITS := $(shell getconf LONG_BIT) +ifeq ($(LBITS),64) + FPIC=-fpic +else + FPIC= +endif + OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma +GLIB_CFLAGS = -Wall $(shell pkg-config glib-2.0 --cflags) $(FPIC) +GLIB_LDFLAGS = $(shell pkg-config glib-2.0 --libs) -lglibivy + # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want -ML_SDL_LFLAGS = $(foreach u,$(shell pkg-config sdl --libs-only-L) -lSDL,-cclib $(u)) libSDL.so +SDL_LDIRS = $(shell pkg-config sdl --libs-only-L) +SDL_LIBS = -lSDL +SDL_LDFLAGS = $(SDL_LDIRS) $(SDL_LIBS) + +# apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want +ML_SDL_LFLAGS = $(foreach u,$(SDL_LDIRS),-ccopt $(u)) $(foreach u,$(SDL_LIBS),-cclib $(u)) libSDL.so INCLUDES += -I `ocamlc -where` -LBITS := $(shell getconf LONG_BIT) -ifeq ($(LBITS),64) - FPIC = -fpic -else - FPIC = -endif all: test_stick input2ivy test_stick: test_sdl_stick.o - gcc -g -O2 -Wall -DSTICK_DBG `pkg-config glib-2.0 --cflags` -o $@ $^ sdl_stick.c `pkg-config glib-2.0 --libs` -lglibivy `sdl-config --libs` + @echo BUILD $@ + $(Q)$(CC) -g -O2 -DSTICK_DBG $(GLIB_CFLAGS) -o $@ $^ sdl_stick.c $(GLIB_LDFLAGS) $(SDL_LDFLAGS) input2ivy: sdl_stick.so input2ivy.cmo @echo OL $@ @@ -55,10 +67,12 @@ input2ivy: sdl_stick.so input2ivy.cmo input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo sdl_stick.so : sdl_stick.o ml_sdl_stick.o - gcc -shared -o $@ $^ + @echo BUILD $@ + $(Q)$(CC) -shared -o $@ $^ %.o : %.c - gcc -c -O2 -Wall `pkg-config glib-2.0 --cflags` $(FPIC) $(INCLUDES) $< + @echo CC $@ + $(Q)$(CC) -c -O2 $(GLIB_CFLAGS) $(INCLUDES) $< %.cmo : %.ml @echo OC $< From 847468e6ad09d9644f31e34d8dd109d21e2dae88 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Fri, 22 Feb 2013 22:58:28 +0100 Subject: [PATCH 014/109] [makefile] finaly make tools independant of ivy package --- sw/ground_segment/tmtc/Makefile | 7 ++----- sw/lib/ocaml/Makefile | 8 ++++---- sw/tools/Makefile | 2 +- 3 files changed, 7 insertions(+), 10 deletions(-) diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 3969976304..879cd498f3 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -46,8 +46,7 @@ SERVERCMO = server_globals.cmo aircraft.cmo wind.cmo airprox.cmo kml.cmo fw_serv SERVERCMX = $(SERVERCMO:.cmo=.cmx) -all: link server messages dia diadec $(VAR)/boa.conf ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge -#settings +all: link server messages settings dia diadec $(VAR)/boa.conf ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge clean: $(Q)rm -f link server messages settings dia diadec *.bak *~ core *.o .depend *.opt *.out *.cm* ivy_tcp_aircraft ivy_tcp_controller broadcaster ivy2udp ivy_serial_bridge gpsd2ivy c_ivy_client_example_1 c_ivy_client_example_2 c_ivy_client_example_3 @@ -62,11 +61,9 @@ messages : messages.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $< - settings : settings.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) ../cockpit/page_settings.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma lablgnomecanvas.cma gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) $< - + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma lablgnomecanvas.cma gtkInit.cmo $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< server : $(SERVERCMO) $(LIBPPRZCMA) @echo OL $@ diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 540a64a151..4d458c7910 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -56,7 +56,7 @@ SRC = fig.ml debug.ml base64.ml serial.ml ocaml_tools.ml expr_syntax.ml expr_par CMO = $(SRC:.ml=.cmo) CMX = $(SRC:.ml=.cmx) -XSRC = gtk_tools.ml platform.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 xmlEdit.ml mapFP.ml +XSRC = gtk_tools.ml platform.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 XCMO = $(XSRC:.ml=.cmo) XCMX = $(XSRC:.ml=.cmx) @@ -71,17 +71,17 @@ opt : lib-pprz.cmxa xlib-pprz.cmxa lib-pprz.cma liblib-pprz.a: $(CMO) @echo OL $@ - $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $(shell ocamlfind query -predicates byte -a-format ivy) $(shell ocamlfind query -predicates -l-format byte ivy) $^ lib-pprz.cmxa dlllib-pprz.so: $(CMX) @echo OOL $@ $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ -xlib-pprz.cma libxlib-pprz.a: $(XCMO) ml_gtk_drag.o +xlib-pprz.cma libxlib-pprz.a: $(XCMO) @echo OL $@ $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ -xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX) ml_gtk_drag.o +xlib-pprz.cmxa dllxlib-pprz.so: $(XCMX) @echo OOL $@ $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(XINCLUDES) -o xlib-pprz $^ diff --git a/sw/tools/Makefile b/sw/tools/Makefile index ab2a8df10f..eb88bf9b88 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -25,7 +25,7 @@ Q=@ include ../Makefile.ocaml INCLUDES = -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,xml-light,ivy +PKGCOMMON=unix,str,xml-light all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs From bdb608c3aed20424e19bda64f2ff9726870fe05a Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 22 Feb 2013 23:14:16 +0100 Subject: [PATCH 015/109] [makefile] fPIC for sim... --- conf/Makefile.sim | 8 ++++++++ sw/Makefile.ocaml | 1 + sw/simulator/Makefile | 12 +++++++----- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/conf/Makefile.sim b/conf/Makefile.sim index 7f95aad73d..c4ae1941f5 100644 --- a/conf/Makefile.sim +++ b/conf/Makefile.sim @@ -44,12 +44,20 @@ Q=@ # End of configuration part. # +LBITS := $(shell getconf LONG_BIT) +ifeq ($(LBITS),64) + FPIC = -fPIC +else + FPIC = +endif + INCLUDES += -I `ocamlc -where` CFLAGS = -W -Wall CFLAGS += $(INCLUDES) CFLAGS += $($(TARGET).CFLAGS) CFLAGS += $(LOCAL_CFLAGS) +CFLAGS += $(FPIC) CFLAGS += -O2 CFLAGS += -g CFLAGS += -std=gnu99 diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml index 3073724ed4..c3535f48d4 100644 --- a/sw/Makefile.ocaml +++ b/sw/Makefile.ocaml @@ -27,6 +27,7 @@ OCAMLC = ocamlc OCAMLOPT = ocamlopt OCAMLDEP = ocamldep OCAMLFIND = ocamlfind +OCAMLMKLIB = ocamlmklib LIBPPRZDIR = $(PAPARAZZI_SRC)/sw/lib/ocaml LIBPPRZCMA = $(LIBPPRZDIR)/lib-pprz.cma LIBPPRZCMXA = $(LIBPPRZCMA:.cma=.cmxa) diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index a61d583aae..74ac46830e 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -24,7 +24,7 @@ Q=@ LBITS := $(shell getconf LONG_BIT) ifeq ($(LBITS),64) - FPIC = -ccopt -fPIC + FPIC = -fPIC else FPIC = endif @@ -51,7 +51,8 @@ ACINCLUDE = $(PAPARAZZI_HOME)/var/$(AIRCRAFT) all : gaia sitl.cma simhitl fg.so : fg.o - gcc -shared -o $@ $^ + @echo BUILD $@ + $(Q)$(CC) -shared -o $@ $^ simhitl : fg.so $(SIMHCMO) simhitl.cmo @echo OL $@ @@ -59,9 +60,10 @@ simhitl : fg.so $(SIMHCMO) simhitl.cmo sitl.cma : fg.o $(SIMSCMO) @echo OL $@ - $(Q)ocamlmklib -o sitl $^ + $(Q)$(OCAMLMKLIB) -o sitl $^ sitl.cmxa : $(SIMSCMX) + @echo OC $@ $(Q)$(OCAMLOPT) -o $@ -a $^ gaia : gaia.cmo @@ -77,8 +79,8 @@ diffusion : stdlib.cmo diffusion.cmo $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< %.o : %.c - @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(FPIC) -c -package $(PKGCOMMON) $< + @echo CC $< + $(Q)$(CC) $(FPIC) -c $< %.cmx : %.ml @echo OOC $< From 09126005491c2f83b5e7bc977281967dc4d0f31c Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 23 Feb 2013 02:48:34 +0100 Subject: [PATCH 016/109] [makefile] improvements to ocaml lib building - quiet building of glade stuff - remove some temporary glade files --- sw/ground_segment/cockpit/Makefile | 11 +++++--- sw/ground_segment/joystick/Makefile | 3 +- sw/ground_segment/tmtc/Makefile | 2 +- sw/lib/ocaml/Makefile | 43 +++++++++++++++++------------ sw/logalizer/Makefile | 37 ++++++++++++------------- sw/supervision/Makefile | 16 +++++++---- sw/tools/Makefile | 5 ---- 7 files changed, 62 insertions(+), 55 deletions(-) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 5330cf4154..4119d62857 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -40,7 +40,7 @@ LIBS= lablglade.cma lablgnomecanvas.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $ CMXA=$(LIBS:.cma=.cmxa) INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring,netclient,threads +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netclient,threads ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml particules.ml papgets.ml gcs.ml MAIN=gcs @@ -74,13 +74,16 @@ saveSettings.cmo : gtk_save_settings.cmo saveSettings.cmx: gtk_save_settings.cmx gtk_strip.ml : gcs.glade - lablgladecc2 -root eventbox_strip -hide-default $< | grep -B 1000000 " end" > $@ + @echo GLADE $@ + $(Q)lablgladecc2 -root eventbox_strip -hide-default $< | grep -B 1000000 " end" > $@ gtk_setting_time.ml : gcs.glade - lablgladecc2 -root setting_time -hide-default $< | grep -B 1000000 " end" > $@ + @echo GLADE $@ + $(Q)lablgladecc2 -root setting_time -hide-default $< | grep -B 1000000 " end" > $@ gtk_save_settings.ml : gcs.glade - lablgladecc2 -root save_settings -hide-default $< | grep -B 1000000 " end" > $@ + @echo GLADE $@ + $(Q)lablgladecc2 -root save_settings -hide-default $< | grep -B 1000000 " end" > $@ strip.cmo : gtk_strip.cmo gtk_setting_time.cmo diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 51bdb19982..362e5f15d5 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -38,7 +38,6 @@ endif OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light -LIBPPRZCMA=$(LIBPPRZDIR)/lib-pprz.cma GLIB_CFLAGS = -Wall $(shell pkg-config glib-2.0 --cflags) $(FPIC) GLIB_LDFLAGS = $(shell pkg-config glib-2.0 --libs) -lglibivy @@ -59,7 +58,7 @@ test_stick: test_sdl_stick.o @echo BUILD $@ $(Q)$(CC) -g -O2 -DSTICK_DBG $(GLIB_CFLAGS) -o $@ $^ sdl_stick.c $(GLIB_LDFLAGS) $(SDL_LDFLAGS) -input2ivy: sdl_stick.so input2ivy.cmo +input2ivy: sdl_stick.so input2ivy.cmo $(LIBPPRZCMA) @echo OL $@ $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 879cd498f3..f39c010e6c 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -37,7 +37,7 @@ CONF = ../../../conf VAR = ../../../var INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring,netclient +PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring LIBMULTIMONCMA=../multimon/multimon.cma LIBMULTIMONDLL= multimon.cma -dllpath $(PAPARAZZI_SRC)/sw/ground_segment/multimon diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 4d458c7910..6eab3009ac 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -37,8 +37,8 @@ OCAMLLIBDIR=$(shell $(OCAMLC) -where) TMPDIR ?= /tmp # verbose ocamlmklib: Print commands before executing them -VERBOSITY = -verbose -#VERBOSITY = +#VERBOSITY = -verbose +VERBOSITY = LBITS := $(shell getconf LONG_BIT) ifeq ($(LBITS),64) @@ -50,7 +50,7 @@ endif INCLUDES= PKGCOMMON=xml-light,netclient,ivy,lablgtk2 XINCLUDES= -XPKGCOMMON=lablgtk2,xml-light,glibivy +XPKGCOMMON=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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) @@ -63,7 +63,12 @@ XCMX = $(XSRC:.ml=.cmx) TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) -OCAMLDLL = -dllpath $(shell ocamlfind query ivy) +comma := , +null := +space := $(null) $(null) +PKG_COMMON = $(subst $(comma),$(space),$(PKGCOMMON)) +CMACOMMON = $(shell ocamlfind query -predicates byte -a-format $(PKG_COMMON)) +CMACOMMON_INC = $(shell ocamlfind query -predicates byte -i-format $(PKG_COMMON)) all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt opt : lib-pprz.cmxa xlib-pprz.cmxa @@ -71,7 +76,7 @@ opt : lib-pprz.cmxa xlib-pprz.cmxa lib-pprz.cma liblib-pprz.a: $(CMO) @echo OL $@ - $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $(shell ocamlfind query -predicates byte -a-format ivy) $(shell ocamlfind query -predicates -l-format byte ivy) $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $(CMACOMMON) $(CMACOMMON_INC) $^ lib-pprz.cmxa dlllib-pprz.so: $(CMX) @echo OOL $@ @@ -153,24 +158,28 @@ expr_syntax.cmo : expr_syntax.cmi gtk_papget_editor.ml : widgets.glade - grep -v invisible_char $< > $(TMPDIR)/$@_$< - lablgladecc2 -root papget_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - @rm $(TMPDIR)/$@_$< + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< + $(Q)lablgladecc2 -root papget_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$@_$< gtk_papget_text_editor.ml : widgets.glade - grep -v invisible_char $< > $(TMPDIR)/$@_$< - lablgladecc2 -root table_text_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - @rm $(TMPDIR)/$@_$< + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< + $(Q)lablgladecc2 -root table_text_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$@_$< gtk_papget_gauge_editor.ml : widgets.glade - grep -v invisible_char $< > $(TMPDIR)/$@_$< - lablgladecc2 -root table_gauge_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - @rm $(TMPDIR)/$@_$< + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< + $(Q)lablgladecc2 -root table_gauge_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$@_$< gtk_papget_led_editor.ml : widgets.glade - grep -v invisible_char $< > $(TMPDIR)/$@_$< - lablgladecc2 -root table_led_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - @rm $(TMPDIR)/$@_$< + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< + $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$@_$< clean : $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 6a16b23398..2f51b65c56 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -32,37 +32,33 @@ TMPDIR ?= /tmp all: play plotter plot sd2log plotprofile openlog2tlm -play : log_file.cmo play_core.cmo play.cmo +play : $(LIBPPRZCMA) log_file.cmo play_core.cmo play.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) gtkInit.cmo $^ -play-nox : play_core.cmo play-nox.cmo +play-nox : $(LIBPPRZCMA) play_core.cmo play-nox.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $^ -plotter : plotter.cmo +plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) plotter.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(XLIBPPRZCMA) gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) gtkInit.cmo $^ -plot : log_file.cmo gtk_export.cmo export.cmo plot.cmo +plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) log_file.cmo gtk_export.cmo export.cmo plot.cmo @echo OL $@ $^ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(XLIBPPRZCMA) lablglade.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lablglade.cma gtkInit.cmo $^ -sd2log : sd2log.cmo +sd2log : $(LIBPPRZCMA) sd2log.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $^ CC = gcc CFLAGS=-g -O2 -Wall LDFLAGS= openlog2tlm: openlog2tlm.c - $(CC) $(CFLAGS) -g -o $@ $^ - -# depedency on lib-pprz -play play-nox sd2log : $(LIBPPRZCMA) -plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) -plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) + @echo CC $@ + $(Q)$(CC) $(CFLAGS) -g -o $@ $^ # Target for bytecode executable (if ocamlopt is not available) # plot : log_file.cmo gtk_export.cmo export.cmo plot.cmo @@ -83,9 +79,10 @@ export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx gtk_export.ml : export.glade - grep -v invisible_char $< > $(TMPDIR)/$< - lablgladecc2 -root export -hide-default $(TMPDIR)/$< | grep -B 1000000 " end" > $@ - + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$< + $(Q)lablgladecc2 -root export -hide-default $(TMPDIR)/$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$< pt : ahrsview imuview ahrs2fg @@ -191,7 +188,7 @@ clean: # .depend: Makefile - ocamldep -I $(LIBPPRZDIR) *.ml* > .depend + $(OCAMLDEP) -I $(LIBPPRZDIR) *.ml* > .depend ifneq ($(MAKECMDGOALS),clean) -include .depend diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index d6e7279a6c..5d1edee2ea 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -35,17 +35,21 @@ TMPDIR ?= /tmp all: paparazzicenter -paparazzicenter : $(PAPARAZZICENTERCMO) $(LIBPPRZDIR)/lib-pprz.cma +paparazzicenter : $(LIBPPRZCMA) $(XLIBPPRZCMA) $(PAPARAZZICENTERCMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma gtkInit.cmo lablgnomeui.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma gtkInit.cmo lablgnomeui.cma $(OCAMLDLL) $(OCAMLXDLL) $^ gtk_pc.ml : paparazzicenter.glade - grep -v invisible_char $< > $(TMPDIR)/$< - lablgladecc2 -hide-default -root window $(TMPDIR)/$< > $@ + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$< + $(Q)lablgladecc2 -hide-default -root window $(TMPDIR)/$< > $@ + $(Q)rm $(TMPDIR)/$< gtk_process.ml : paparazzicenter.glade - grep -v invisible_char $< > $(TMPDIR)/$< - lablgladecc2 -hide-default -root hbox_program $(TMPDIR)/$< | grep -B 1000000 " end" > $@ + @echo GLADE $@ + $(Q)grep -v invisible_char $< > $(TMPDIR)/$< + $(Q)lablgladecc2 -hide-default -root hbox_program $(TMPDIR)/$< | grep -B 1000000 " end" > $@ + $(Q)rm $(TMPDIR)/$< %.cmo : %.ml @echo OC $< diff --git a/sw/tools/Makefile b/sw/tools/Makefile index eb88bf9b88..f4903dfb47 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -44,11 +44,6 @@ gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) @echo OC $< $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lib-pprz.cma gen_common.cmo $< -# disable this for now and use the compiled bytecode -#@cat ../../pprz_src_test.sh > $@ -#@echo '$(OCAML) -I $$PAPARAZZI_SRC/sw/tools $(OCAMLNETINCLUDES) -I $$PAPARAZZI_SRC/sw/lib/ocaml unix.cma str.cma ivy-ocaml.cma xml-light.cma $(OCAMLNETCMA) lib-pprz.cma gen_common.cmo $$PAPARAZZI_BIN/$< $$*' >> $@ -#@chmod a+x $@ - %.cmo : %.ml @echo OC $< $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) lib-pprz.cma -c $< From e838519192c6364b90400731f4bd9722ca437beb Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 24 Feb 2013 00:52:40 +0100 Subject: [PATCH 017/109] [makefile] fix realtime plotter: link glibivy instead of ivy in logalizer --- sw/logalizer/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 2f51b65c56..83ff141158 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -25,7 +25,7 @@ Q=@ include ../Makefile.ocaml INCLUDES= -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,xml-light,ivy,lablgtk2 +PKGCOMMON=unix,str,xml-light,glibivy,lablgtk2 # default directory for temporary files TMPDIR ?= /tmp From 390d02ab49666b43a7e96a291f5f2089a8013666 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Mon, 25 Feb 2013 09:47:44 +0100 Subject: [PATCH 018/109] [makefile] use pprzlib has a proper ocaml package --- conf/Makefile.sim | 5 ++-- sw/Makefile.ocaml | 1 + sw/ground_segment/cockpit/Makefile | 21 ++++++++-------- sw/ground_segment/joystick/Makefile | 8 ++++--- sw/ground_segment/tmtc/Makefile | 37 ++++++++++++++++------------- sw/lib/ocaml/META.pprz | 14 +++++++++++ sw/lib/ocaml/Makefile | 15 ++++-------- sw/logalizer/Makefile | 35 ++++++++++++++++----------- sw/simulator/Makefile | 17 ++++++------- sw/supervision/Makefile | 14 ++++++----- sw/tools/Makefile | 25 +++++++++---------- 11 files changed, 109 insertions(+), 83 deletions(-) create mode 100644 sw/lib/ocaml/META.pprz diff --git a/conf/Makefile.sim b/conf/Makefile.sim index c4ae1941f5..d063602448 100644 --- a/conf/Makefile.sim +++ b/conf/Makefile.sim @@ -32,7 +32,8 @@ include $(PAPARAZZI_SRC)/sw/Makefile.ocaml CC = gcc SIMDIR = $(PAPARAZZI_SRC)/sw/simulator CAMLINCLUDES = -I $(LIBPPRZDIR) -I $(SIMDIR) -I $(OBJDIR) -PKGCOMMON = unix,str,xml-light,glibivy,lablgtk2 +PKG = -package glibivy,pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz SIMSITLML = $(OBJDIR)/simsitl.ml MYGTKINITCMO = myGtkInit.cmo SITLCMA = $(SIMDIR)/sitl.cma @@ -82,7 +83,7 @@ autopilot.so : $($(TARGET).objs) $(OBJDIR)/simsitl : autopilot.so $(SITLCMA) $(SIMSITLML) @echo LD $@ - $(Q)$(OCAMLFIND) $(OCAMLC) -g $(CAMLINCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) + $(Q)$(OCAMLFIND) $(OCAMLC) -g $(CAMLINCLUDES) -o $@ $(LINKPKG) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) # The id of the A/C is hardcoded in the code (to be improved with dynlink ?) diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml index c3535f48d4..85059795cf 100644 --- a/sw/Makefile.ocaml +++ b/sw/Makefile.ocaml @@ -36,3 +36,4 @@ XLIBPPRZCMXA = $(XLIBPPRZCMA:.cma=.cmxa) OCAMLDLL = -dllpath $(LIBPPRZDIR) OCAMLXDLL = -dllpath $(LIBPPRZDIR) +export OCAMLPATH=$(LIBPPRZDIR) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 4119d62857..05515114b8 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -36,11 +36,12 @@ FPIC=-fPIC include ../../Makefile.ocaml INCLUDES= -LIBS= lablglade.cma lablgnomecanvas.cma $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) -CMXA=$(LIBS:.cma=.cmxa) +LIBS= +LIBSX=$(LIBS:.cma=.cmxa) -INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netclient,threads +INCLUDES= -I ../multimon +PKG = -package pprz.xlib,threads +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz.xlib ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml particules.ml papgets.ml gcs.ml MAIN=gcs @@ -53,22 +54,22 @@ opt : $(MAIN).opt $(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS) gtkThread.cmo myGtkInit.cmo $(CMO) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) gtkThread.cmo myGtkInit.cmo $(CMO) -o $@ $(MAIN).opt : $(CMX) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS:.cma=.cmxa) gtkThread.cmx gtkInit.cmx $(CMX) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) $(LINKPKG) gtkThread.cmx gtkInit.cmx $(CMX) -o $@ %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< saveSettings.cmo : gtk_save_settings.cmo saveSettings.cmx: gtk_save_settings.cmx @@ -89,7 +90,7 @@ strip.cmo : gtk_strip.cmo gtk_setting_time.cmo compass : compass.ml @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -package $(PKGCOMMON) -linkpkg $(LIBS) gtkInit.cmo $^ -o $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LINKPKG) gtkInit.cmo $^ -o $@ clean: diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 362e5f15d5..ccf20bbd57 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -37,7 +37,8 @@ else endif OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light +PKG = -package pprz,glibivy +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz GLIB_CFLAGS = -Wall $(shell pkg-config glib-2.0 --cflags) $(FPIC) GLIB_LDFLAGS = $(shell pkg-config glib-2.0 --libs) -lglibivy @@ -49,6 +50,7 @@ SDL_LDFLAGS = $(SDL_LDIRS) $(SDL_LIBS) # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want ML_SDL_LFLAGS = $(foreach u,$(SDL_LDIRS),-ccopt $(u)) $(foreach u,$(SDL_LIBS),-cclib $(u)) libSDL.so +ML_SDL_LFLAGS += -dllpath ${PAPARAZZI_SRC}/sw/ground_segment/joystick INCLUDES += -I `ocamlc -where` @@ -60,7 +62,7 @@ test_stick: test_sdl_stick.o input2ivy: sdl_stick.so input2ivy.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) # dependency of input2ivy input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo @@ -75,7 +77,7 @@ sdl_stick.so : sdl_stick.o ml_sdl_stick.o %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -c $(PKG) $< clean: $(Q)rm -f *~ core *.o *.bak .depend test*stick *.cmo *.cmi input2ivy diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index f39c010e6c..6922ee277e 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -36,8 +36,11 @@ include ../../Makefile.ocaml CONF = ../../../conf VAR = ../../../var -INCLUDES= -I $(LIBPPRZDIR) -I ../multimon -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light,netstring +INCLUDES= -I ../multimon +PKG = -package glibivy,pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz +XPKG = -package pprz.xlib +XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib LIBMULTIMONCMA=../multimon/multimon.cma LIBMULTIMONDLL= multimon.cma -dllpath $(PAPARAZZI_SRC)/sw/ground_segment/multimon @@ -59,73 +62,73 @@ $(VAR)/boa.conf :$(CONF)/boa.conf messages : messages.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< settings : settings.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) ../cockpit/page_settings.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma lablgnomecanvas.cma gtkInit.cmo $(OCAMLDLL) $(LIBPPRZCMA) $(OCAMLXDLL) $(XLIBPPRZCMA) -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< server : $(SERVERCMO) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(SERVERCMO) + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMO) server.opt : $(SERVERCMX) $(LIBPPRZCMXA) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMXA) $(SERVERCMX) + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMX) link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< dia : dia.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< diadec : diadec.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< 150m : 150m.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $(LIBPPRZCMA) gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< settings.cmo : INCLUDES += -I ../cockpit settings.cmo : ../cockpit/page_settings.cmi %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) $(PKG) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) $< CC = gcc diff --git a/sw/lib/ocaml/META.pprz b/sw/lib/ocaml/META.pprz new file mode 100644 index 0000000000..766505fe9b --- /dev/null +++ b/sw/lib/ocaml/META.pprz @@ -0,0 +1,14 @@ +description = "Paparazzi UAS package" +requires = "unix,str,xml-light,lablgtk2,glibivy,netclient" +version = "1.0" +directory = "" + +archive(byte) = "lib-pprz.cma" +archive(native) = "lib-pprz.cmxa" + +package "xlib" ( + requires = "pprz,lablgtk2-gnome.gnomecanvas,lablgtk2.glade" + version = "1.0" + archive(byte) = "xlib-pprz.cma" + archive(native) = "xlib-pprz.cmxa" +) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 6eab3009ac..b4387f791c 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -48,9 +48,9 @@ else endif INCLUDES= -PKGCOMMON=xml-light,netclient,ivy,lablgtk2 +PKGCOMMON=xml-light,netclient,glibivy,lablgtk2 XINCLUDES= -XPKGCOMMON=xml-light,glibivy,lablgtk2 +XPKGCOMMON=xml-light,glibivy,lablgtk2-gnome.gnomecanvas,lablgtk2.glade 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) @@ -63,20 +63,13 @@ XCMX = $(XSRC:.ml=.cmx) TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) -comma := , -null := -space := $(null) $(null) -PKG_COMMON = $(subst $(comma),$(space),$(PKGCOMMON)) -CMACOMMON = $(shell ocamlfind query -predicates byte -a-format $(PKG_COMMON)) -CMACOMMON_INC = $(shell ocamlfind query -predicates byte -i-format $(PKG_COMMON)) - all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt opt : lib-pprz.cmxa xlib-pprz.cmxa lib-pprz.cma liblib-pprz.a: $(CMO) @echo OL $@ - $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $(CMACOMMON) $(CMACOMMON_INC) $^ + $(Q)$(OCAMLMKLIB) $(VERBOSITY) $(INCLUDES) -o lib-pprz $^ lib-pprz.cmxa dlllib-pprz.so: $(CMX) @echo OOL $@ @@ -120,7 +113,7 @@ ml_gtkgl_hack.o : ml_gtkgl_hack.c $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< camltm.o : register_example.cmo - $(OCAMLFIND) $(OCAMLC) $(INCLUDES) -output-obj -o $@ unix.cma str.cma xml-light.cma ivy-ocaml.cma debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo + $(OCAMLFIND) $(OCAMLC) $(INCLUDES) -output-obj -o $@ -package unix,str,xml-light,ivy debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o $(CC) -o $@ $^ -L$(OCAMLLIBDIR) -lunix -lstr -livy-ocaml -lcamlrun -lm -livy -lcurses diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 83ff141158..56b4a16d11 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -25,7 +25,10 @@ Q=@ include ../Makefile.ocaml INCLUDES= -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,xml-light,glibivy,lablgtk2 +PKG = -package glibivy,pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz +XPKG = -package pprz.xlib +XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib # default directory for temporary files TMPDIR ?= /tmp @@ -34,23 +37,23 @@ all: play plotter plot sd2log plotprofile openlog2tlm play : $(LIBPPRZCMA) log_file.cmo play_core.cmo play.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ play-nox : $(LIBPPRZCMA) play_core.cmo play-nox.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) plotter.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) log_file.cmo gtk_export.cmo export.cmo plot.cmo - @echo OL $@ $^ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lablglade.cma gtkInit.cmo $^ + @echo OL $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ sd2log : $(LIBPPRZCMA) sd2log.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ CC = gcc CFLAGS=-g -O2 -Wall @@ -67,13 +70,13 @@ openlog2tlm: openlog2tlm.c %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx @@ -119,16 +122,20 @@ MORE_FLAGS = -I/usr/include/gtk-1.2 -I/usr/include/glib-1.2 -I/usr/lib/glib/incl MORE_CFLAGS = -DHAVE_DLFCN_H=1 -DSTDC_HEADERS=1 -I. -I. -I.. -g -O2 -I/usr/include/gtk-1.2 -I/usr/include/glib-1.2 -I/usr/lib/glib/include disp3d: disp3d.c - $(CC) $(MORE_CFLAGS) -g -o $@ $^ $(MORE_FLAGS) + @echo CC $@ + $(Q)$(CC) $(MORE_CFLAGS) -g -o $@ $^ $(MORE_FLAGS) plotprofile: plotprofile.c - $(CC) $(IVY_C_LIBRARYS) $(IVY_C_INCLUDES) -g -O2 -Wall `pkg-config glib-2.0 --cflags` -o $@ $^ `pkg-config glib-2.0 --libs` -lglibivy + @echo CC $@ + $(Q)$(CC) $(IVY_C_LIBRARYS) $(IVY_C_INCLUDES) -g -O2 -Wall `pkg-config glib-2.0 --cflags` -o $@ $^ `pkg-config glib-2.0 --libs` -lglibivy test1: test1.c - $(CC) $(MORE_CFLAGS) -g -o $@ $^ $(MORE_FLAGS) -lglut + @echo CC $@ + $(Q)$(CC) $(MORE_CFLAGS) -g -o $@ $^ $(MORE_FLAGS) -lglut test3: test3.c sliding_plot.c - $(CC) $(CFLAGS) -g -o $@ $^ $(LDFLAGS) + @echo CC $@ + $(Q)$(CC) $(CFLAGS) -g -o $@ $^ $(LDFLAGS) #FGFS_PREFIX=/home/poine/local diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index 74ac46830e..ca97704435 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -33,8 +33,9 @@ include ../../conf/Makefile.local include ../Makefile.ocaml OCAMLC += -g -INCLUDES = -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,lablgtk2,glibivy,xml-light +INCLUDES = +PKG = -package glibivy,pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz SIMML = stdlib.ml data.ml flightModel.ml gps.ml SIMHML = $(SIMML) hitl.ml sim.ml @@ -56,7 +57,7 @@ fg.so : fg.o simhitl : fg.so $(SIMHCMO) simhitl.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< sitl.cma : fg.o $(SIMSCMO) @echo OL $@ @@ -68,15 +69,15 @@ sitl.cmxa : $(SIMSCMX) gaia : gaia.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< diffusion : stdlib.cmo diffusion.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lib-pprz.cma gtkInit.cmo $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(PKG) $< %.o : %.c @echo CC $< @@ -84,11 +85,11 @@ diffusion : stdlib.cmo diffusion.cmo %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -c $(PKG) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(PKG) $< # dependency on lib-pprz simhitl diffusion gaia: $(LIBPPRZCMA) diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 5d1edee2ea..b9a5f39262 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -25,8 +25,9 @@ Q=@ include ../Makefile.ocaml -INCLUDES= -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,lablgtk2,ivy,xml-light +INCLUDES = +XPKG = -package pprz.xlib,lablgtk2-gnome.gnomeui +XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo @@ -35,9 +36,9 @@ TMPDIR ?= /tmp all: paparazzicenter -paparazzicenter : $(LIBPPRZCMA) $(XLIBPPRZCMA) $(PAPARAZZICENTERCMO) +paparazzicenter : $(PAPARAZZICENTERCMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg lablglade.cma gtkInit.cmo lablgnomeui.cma $(OCAMLDLL) $(OCAMLXDLL) $^ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ gtk_pc.ml : paparazzicenter.glade @echo GLADE $@ @@ -53,14 +54,15 @@ gtk_process.ml : paparazzicenter.glade %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(XPKG) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(XPKG) $< pc_common.cmo: gtk_process.cmo +paparazzicenter : $(LIBPPRZCMA) $(XLIBPPRZCMA) paparazzicenter.cmo : gtk_pc.cmo clean: diff --git a/sw/tools/Makefile b/sw/tools/Makefile index f4903dfb47..92b7798e89 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -24,8 +24,9 @@ Q=@ include ../Makefile.ocaml -INCLUDES = -I $(LIBPPRZDIR) -PKGCOMMON=unix,str,xml-light +INCLUDES = +PKG = -package pprz +LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz all: gen_common.cmo gen_aircraft.out gen_airframe.out gen_messages2.out gen_messages.out gen_ubx.out gen_mtk.out gen_flight_plan.out gen_radio.out gen_periodic.out gen_settings.out gen_xsens.out gen_modules.out gen_autopilot.out gen_abi.out find_free_msg_id.out gen_srtm.out mergelogs @@ -34,26 +35,26 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lib-pprz.cma $^ - -gen_srtm.out : gen_srtm.ml gen_common.cmo $(LIBPPRZCMA) - @echo OC $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON),netclient -linkpkg $(OCAMLDLL) lib-pprz.cma $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ + +gen_srtm.out : gen_srtm.ml $(LIBPPRZCMA) + @echo OL $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< %.out : %.ml gen_common.cmo $(LIBPPRZCMA) - @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package $(PKGCOMMON) -linkpkg $(OCAMLDLL) lib-pprz.cma gen_common.cmo $< + @echo OL $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gen_common.cmo $< %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) lib-pprz.cma -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) lib-pprz.cma -c $< + $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< # dependency on lib-pprz -gen_flight_plan.out gen_srtm.out : $(LIBPPRZCMA) +gen_flight_plan.out : $(LIBPPRZCMA) mergelogs: mergelogs.c gcc mergelogs.c -o mergelogs From bf64bd6dec518bf8fee7b7a1590cf4087902e8b4 Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Tue, 5 Mar 2013 20:35:23 +0100 Subject: [PATCH 019/109] [yai][booz] YAI and BOOZ IMU now work on tiny1.1 etc... --- sw/airborne/boards/tiny_0.99.h | 12 ++++++++++++ sw/airborne/boards/tiny_1.1.h | 12 ++++++++++++ sw/airborne/boards/tiny_2.0.h | 9 +++++++++ 3 files changed, 33 insertions(+) diff --git a/sw/airborne/boards/tiny_0.99.h b/sw/airborne/boards/tiny_0.99.h index 6aed88d605..7a30d21cea 100644 --- a/sw/airborne/boards/tiny_0.99.h +++ b/sw/airborne/boards/tiny_0.99.h @@ -141,5 +141,17 @@ #define SPI_SELECT_SLAVE0_PORT 0 #define SPI_SELECT_SLAVE0_PIN 20 +#define SPI_SELECT_SLAVE0_PINSEL PINSEL1 +#define SPI_SELECT_SLAVE0_PINSEL_BIT 8 +#define SPI_SELECT_SLAVE0_PINSEL_VAL 0 + +/* MAX1168 EOC pin (e.g. booz2 imu) */ +#define MAX1168_EOC_PIN 16 +#define MAX1168_EOC_PINSEL PINSEL1 +#define MAX1168_EOC_PINSEL_BIT 0 +#define MAX1168_EOC_PINSEL_VAL 1 +#define MAX1168_EOC_EINT 0 +#define MAX1168_EOC_VIC_IT VIC_EINT0 + #endif /* CONFIG_TINY_H */ diff --git a/sw/airborne/boards/tiny_1.1.h b/sw/airborne/boards/tiny_1.1.h index a589957443..cb59bf81ba 100644 --- a/sw/airborne/boards/tiny_1.1.h +++ b/sw/airborne/boards/tiny_1.1.h @@ -152,6 +152,9 @@ #define SPI_SELECT_SLAVE0_PORT 0 #define SPI_SELECT_SLAVE0_PIN 20 +#define SPI_SELECT_SLAVE0_PINSEL PINSEL1 +#define SPI_SELECT_SLAVE0_PINSEL_BIT 8 +#define SPI_SELECT_SLAVE0_PINSEL_VAL 0 #define SPI1_DRDY_PINSEL PINSEL0 #define SPI1_DRDY_PINSEL_BIT 14 @@ -159,4 +162,13 @@ #define SPI1_DRDY_EINT 2 #define SPI1_DRDY_VIC_IT VIC_EINT2 +/* MAX1168 EOC pin (e.g. booz2 imu) */ +#define MAX1168_EOC_PIN 16 +#define MAX1168_EOC_PINSEL PINSEL1 +#define MAX1168_EOC_PINSEL_BIT 0 +#define MAX1168_EOC_PINSEL_VAL 1 +#define MAX1168_EOC_EINT 0 +#define MAX1168_EOC_VIC_IT VIC_EINT0 + + #endif /* CONFIG_TINY_H */ diff --git a/sw/airborne/boards/tiny_2.0.h b/sw/airborne/boards/tiny_2.0.h index ef6399ddf2..5f9e7f4609 100644 --- a/sw/airborne/boards/tiny_2.0.h +++ b/sw/airborne/boards/tiny_2.0.h @@ -158,4 +158,13 @@ #define SPI_SELECT_SLAVE0_PINSEL_BIT 8 #define SPI_SELECT_SLAVE0_PINSEL_VAL 0 +/* MAX1168 EOC pin (e.g. booz2 imu) */ +#define MAX1168_EOC_PIN 16 +#define MAX1168_EOC_PINSEL PINSEL1 +#define MAX1168_EOC_PINSEL_BIT 0 +#define MAX1168_EOC_PINSEL_VAL 1 +#define MAX1168_EOC_EINT 0 +#define MAX1168_EOC_VIC_IT VIC_EINT0 + + #endif /* CONFIG_TINY_H */ From d5293baf59fe8931ef62b01d694028c8116b5313 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 5 Mar 2013 22:20:32 +0100 Subject: [PATCH 020/109] [conf] minor comment update for actuators_mkk_v2 --- conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile b/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile index d41b51e140..69198138e9 100644 --- a/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile +++ b/conf/firmwares/subsystems/shared/actuators_mkk_v2.makefile @@ -4,8 +4,8 @@ # enable the subsystem for your firmware: # # ... -# -# +# +# # # # From 87f704ccd6a90bdf84d27b622d060ff1c28c7bf6 Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Tue, 5 Mar 2013 21:42:10 +0100 Subject: [PATCH 021/109] [module] High-Pass filter added --- .../modules/benchmark/imu_quality_assessment.c | 18 +++++++++++++++--- .../modules/benchmark/imu_quality_assessment.h | 2 ++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/sw/airborne/modules/benchmark/imu_quality_assessment.c b/sw/airborne/modules/benchmark/imu_quality_assessment.c index a5bc9923c5..1208d7b29a 100644 --- a/sw/airborne/modules/benchmark/imu_quality_assessment.c +++ b/sw/airborne/modules/benchmark/imu_quality_assessment.c @@ -34,9 +34,10 @@ void imu_quality_assessment_init(void) { void imu_quality_assessment_periodic(void) { - //static int32_t q_a[3][IMU_QUALITY_ASSESSMENT_ORDER]; - //static const int32_t A[3] = {}; - //static const int32_t B[3] = {}; + static int32_t lx[3]; + static int32_t fx[3]; + const int32_t A[3] = {16384, -25576, 10508}; + const int32_t B[3] = {13117, -26234, 13117}; // Peak tracking if (imu.accel.x > imu_quality_assessment_data.q_ax) @@ -57,6 +58,17 @@ void imu_quality_assessment_periodic(void) // High frequency high-pass filter // Medium frequency bandpass + lx[2] = lx[1]; + lx[1] = lx[0]; + lx[0] = imu.accel_unscaled.x; + + fx[2] = fx[1]; + fx[1] = fx[0]; + fx[0] = B[0] * lx[0] + B[1] * lx[1] + B[2] * lx[2] - A[1] * fx[1] - A[2] * fx[2]; + fx[0] == fx[0] >> 14; + + imu_quality_assessment_data.q = fx[0]; + } diff --git a/sw/airborne/modules/benchmark/imu_quality_assessment.h b/sw/airborne/modules/benchmark/imu_quality_assessment.h index f1631680c2..a14aa9aeb5 100644 --- a/sw/airborne/modules/benchmark/imu_quality_assessment.h +++ b/sw/airborne/modules/benchmark/imu_quality_assessment.h @@ -34,6 +34,8 @@ struct imu_quality_assessment_data_struct { int q_az; int q_m; + + int q; }; extern struct imu_quality_assessment_data_struct imu_quality_assessment_data; From b2e56ff1bec074a1495f1b3dbb569a99536f96c5 Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Tue, 5 Mar 2013 22:52:18 +0100 Subject: [PATCH 022/109] [module] High-Pass Filter --- .../modules/imu_quality_assessment.xml | 1 + .../benchmark/imu_quality_assessment.c | 75 ++++++++++--------- 2 files changed, 40 insertions(+), 36 deletions(-) diff --git a/conf/settings/modules/imu_quality_assessment.xml b/conf/settings/modules/imu_quality_assessment.xml index c2c8afef3f..3b15def65f 100644 --- a/conf/settings/modules/imu_quality_assessment.xml +++ b/conf/settings/modules/imu_quality_assessment.xml @@ -5,6 +5,7 @@ + diff --git a/sw/airborne/modules/benchmark/imu_quality_assessment.c b/sw/airborne/modules/benchmark/imu_quality_assessment.c index 1208d7b29a..cedda0e530 100644 --- a/sw/airborne/modules/benchmark/imu_quality_assessment.c +++ b/sw/airborne/modules/benchmark/imu_quality_assessment.c @@ -23,6 +23,7 @@ #include "imu_quality_assessment.h" #include "subsystems/imu.h" +#include "generated/airframe.h" struct imu_quality_assessment_data_struct imu_quality_assessment_data; @@ -32,43 +33,45 @@ void imu_quality_assessment_init(void) { #define IMU_QUALITY_ASSESSMENT_FILTER_ORDER 2 -void imu_quality_assessment_periodic(void) -{ - static int32_t lx[3]; - static int32_t fx[3]; - const int32_t A[3] = {16384, -25576, 10508}; - const int32_t B[3] = {13117, -26234, 13117}; - - // Peak tracking - if (imu.accel.x > imu_quality_assessment_data.q_ax) - imu_quality_assessment_data.q_ax = imu.accel.x; - if (-imu.accel.x > imu_quality_assessment_data.q_ax) - imu_quality_assessment_data.q_ax = -imu.accel.x; - - if (imu.accel.y > imu_quality_assessment_data.q_ay) - imu_quality_assessment_data.q_ay = imu.accel.y; - if (-imu.accel.y > imu_quality_assessment_data.q_ay) - imu_quality_assessment_data.q_ay = -imu.accel.y; - - if (imu.accel.z > imu_quality_assessment_data.q_az) - imu_quality_assessment_data.q_az = imu.accel.z; - if (-imu.accel.z > imu_quality_assessment_data.q_az) - imu_quality_assessment_data.q_az = -imu.accel.z; - - // High frequency high-pass filter - // Medium frequency bandpass - - lx[2] = lx[1]; - lx[1] = lx[0]; - lx[0] = imu.accel_unscaled.x; - - fx[2] = fx[1]; - fx[1] = fx[0]; - fx[0] = B[0] * lx[0] + B[1] * lx[1] + B[2] * lx[2] - A[1] * fx[1] - A[2] * fx[2]; - fx[0] == fx[0] >> 14; - - imu_quality_assessment_data.q = fx[0]; +#define PEAK_TRACKER(_Value, _Peak) { \ + if ( (_Value) > (_Peak) ) \ + _Peak = _Value; \ + else if ( -(_Value) > (_Peak) ) \ + _Peak = -(_Value); \ +} + + +void imu_quality_assessment_periodic(void) +{ + static int32_t lx[IMU_QUALITY_ASSESSMENT_FILTER_ORDER+1]; + static int32_t fx[IMU_QUALITY_ASSESSMENT_FILTER_ORDER+1]; + const int32_t A[IMU_QUALITY_ASSESSMENT_FILTER_ORDER+1] = {16384, -25576, 10508}; + const int32_t B[IMU_QUALITY_ASSESSMENT_FILTER_ORDER+1] = {13117, -26234, 13117}; + + // Peak tracking + + PEAK_TRACKER( imu.accel.x, imu_quality_assessment_data.q_ax); + PEAK_TRACKER( imu.accel.y, imu_quality_assessment_data.q_ay); + PEAK_TRACKER( imu.accel.z, imu_quality_assessment_data.q_az); + + // High frequency high-pass filter + + // <= 15 bit raw measurement + // 14 bit multiplication and sum of 5 parameters + + // Buffer of last measurement + lx[2] = lx[1]; + lx[1] = lx[0]; + lx[0] = imu.accel_unscaled.x; + // Buffer of last filter values + fx[2] = fx[1]; + fx[1] = fx[0]; + fx[0] = B[0] * lx[0] + B[1] * lx[1] + B[2] * lx[2] - A[1] * fx[1] - A[2] * fx[2]; + fx[0] = fx[0] >> 14; + + int32_t filt_x = ((fx[0])*IMU_ACCEL_X_SENS_NUM)/IMU_ACCEL_X_SENS_DEN; + PEAK_TRACKER( filt_x, imu_quality_assessment_data.q); } From 5171ca27c11e6b1ec3568402ebb9927793c00259 Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Tue, 5 Mar 2013 22:52:47 +0100 Subject: [PATCH 023/109] [module] High Speed Logger overrun protection --- .../loggers/high_speed_logger_spi_link.c | 29 +++++++++++-------- 1 file changed, 17 insertions(+), 12 deletions(-) diff --git a/sw/airborne/modules/loggers/high_speed_logger_spi_link.c b/sw/airborne/modules/loggers/high_speed_logger_spi_link.c index edc6cb881b..e6b8a4a18c 100644 --- a/sw/airborne/modules/loggers/high_speed_logger_spi_link.c +++ b/sw/airborne/modules/loggers/high_speed_logger_spi_link.c @@ -26,10 +26,10 @@ #include "mcu_periph/spi.h" struct high_speed_logger_spi_link_data high_speed_logger_spi_link_data; -uint16_t testData = 1234; - struct spi_transaction high_speed_logger_spi_link_transaction; +static volatile bool_t high_speed_logger_spi_link_ready = TRUE; + static void high_speed_logger_spi_link_trans_cb( struct spi_transaction *trans ); void high_speed_logger_spi_link_init(void) { @@ -52,22 +52,27 @@ void high_speed_logger_spi_link_init(void) { void high_speed_logger_spi_link_periodic(void) { - high_speed_logger_spi_link_data.gyro_p = imu.gyro_unscaled.p; - high_speed_logger_spi_link_data.gyro_q = imu.gyro_unscaled.q; - high_speed_logger_spi_link_data.gyro_r = imu.gyro_unscaled.r; - high_speed_logger_spi_link_data.acc_x = imu.accel_unscaled.x; - high_speed_logger_spi_link_data.acc_y = imu.accel_unscaled.y; - high_speed_logger_spi_link_data.acc_z = imu.accel_unscaled.z; - high_speed_logger_spi_link_data.mag_x = imu.mag_unscaled.x; - high_speed_logger_spi_link_data.mag_y = imu.mag_unscaled.x; - high_speed_logger_spi_link_data.mag_z = imu.mag_unscaled.x; + if (high_speed_logger_spi_link_ready) + { + high_speed_logger_spi_link_ready = FALSE; + high_speed_logger_spi_link_data.gyro_p = imu.gyro_unscaled.p; + high_speed_logger_spi_link_data.gyro_q = imu.gyro_unscaled.q; + high_speed_logger_spi_link_data.gyro_r = imu.gyro_unscaled.r; + high_speed_logger_spi_link_data.acc_x = imu.accel_unscaled.x; + high_speed_logger_spi_link_data.acc_y = imu.accel_unscaled.y; + high_speed_logger_spi_link_data.acc_z = imu.accel_unscaled.z; + high_speed_logger_spi_link_data.mag_x = imu.mag_unscaled.x; + high_speed_logger_spi_link_data.mag_y = imu.mag_unscaled.x; + high_speed_logger_spi_link_data.mag_z = imu.mag_unscaled.x; - spi_submit(&(HIGH_SPEED_LOGGER_SPI_LINK_DEVICE), &high_speed_logger_spi_link_transaction); + spi_submit(&(HIGH_SPEED_LOGGER_SPI_LINK_DEVICE), &high_speed_logger_spi_link_transaction); + } high_speed_logger_spi_link_data.id++; } static void high_speed_logger_spi_link_trans_cb( struct spi_transaction *trans ) { + high_speed_logger_spi_link_ready = TRUE; } From 4733bc45c0c216b518f82a14d4434b7391439d9c Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Tue, 5 Mar 2013 22:53:13 +0100 Subject: [PATCH 024/109] [asctec_v2] Compile warning --- sw/airborne/subsystems/actuators/actuators_asctec_v2.c | 2 +- sw/airborne/subsystems/actuators/actuators_asctec_v2.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sw/airborne/subsystems/actuators/actuators_asctec_v2.c b/sw/airborne/subsystems/actuators/actuators_asctec_v2.c index aad2b1ccd3..2617a4f857 100644 --- a/sw/airborne/subsystems/actuators/actuators_asctec_v2.c +++ b/sw/airborne/subsystems/actuators/actuators_asctec_v2.c @@ -45,7 +45,7 @@ void actuators_asctec_v2_init(void) { } -void actuators_asctec_v2_set(bool_t motors_on) { +void actuators_asctec_v2_set(void) { #if defined ACTUATORS_START_DELAY && ! defined SITL if (!actuators_delay_done) { if (SysTimeTimer(actuators_delay_time) < USEC_OF_SEC(ACTUATORS_START_DELAY)) { diff --git a/sw/airborne/subsystems/actuators/actuators_asctec_v2.h b/sw/airborne/subsystems/actuators/actuators_asctec_v2.h index 41ec8015ea..e1f3063ac0 100644 --- a/sw/airborne/subsystems/actuators/actuators_asctec_v2.h +++ b/sw/airborne/subsystems/actuators/actuators_asctec_v2.h @@ -65,11 +65,11 @@ extern struct ActuatorsAsctecV2 actuators_asctec_v2; } extern void actuators_asctec_v2_init(void); -extern void actuators_asctec_v2_set(bool_t motors_on); +extern void actuators_asctec_v2_set(void); #define ActuatorAsctec_v2Set(_i, _v) { actuators_asctec_v2.cmds[_i] = _v; } #define ActuatorsAsctec_v2Init() actuators_asctec_v2_init() -#define ActuatorsAsctec_v2Commit() actuators_asctec_v2_set(autopilot_motors_on) +#define ActuatorsAsctec_v2Commit() actuators_asctec_v2_set() #endif /* ACTUATORS_ASCTEC_H */ From 7636a963fc14f24888d70beea84f1f5440d937ae Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Fri, 8 Mar 2013 17:22:56 +0100 Subject: [PATCH 025/109] Care Free mode --- conf/airframes/esden/gain_scheduling_example.xml | 2 -- sw/airborne/firmwares/rotorcraft/autopilot.c | 5 +++++ sw/airborne/firmwares/rotorcraft/autopilot.h | 4 ++-- .../rotorcraft/stabilization/stabilization_attitude.h | 3 +++ .../stabilization/stabilization_attitude_quat_int.c | 2 ++ .../stabilization_attitude_rc_setpoint.h | 11 ++++++++++- sw/airborne/modules/gain_scheduling/gain_scheduling.c | 1 + 7 files changed, 23 insertions(+), 5 deletions(-) diff --git a/conf/airframes/esden/gain_scheduling_example.xml b/conf/airframes/esden/gain_scheduling_example.xml index 378238291a..2fa27fd010 100644 --- a/conf/airframes/esden/gain_scheduling_example.xml +++ b/conf/airframes/esden/gain_scheduling_example.xml @@ -210,8 +210,6 @@ - - diff --git a/sw/airborne/firmwares/rotorcraft/autopilot.c b/sw/airborne/firmwares/rotorcraft/autopilot.c index 0f02929202..6377d135ab 100644 --- a/sw/airborne/firmwares/rotorcraft/autopilot.c +++ b/sw/airborne/firmwares/rotorcraft/autopilot.c @@ -150,6 +150,10 @@ void autopilot_set_mode(uint8_t new_autopilot_mode) { case AP_MODE_RATE_Z_HOLD: guidance_h_mode_changed(GUIDANCE_H_MODE_RATE); break; + case AP_MODE_CARE_FREE: + //Take the current psi as the reference for pitch and roll + care_free_heading = stateGetNedToBodyEulers_f()->psi; + case AP_MODE_ATTITUDE_RC_CLIMB: case AP_MODE_ATTITUDE_DIRECT: case AP_MODE_ATTITUDE_CLIMB: case AP_MODE_ATTITUDE_Z_HOLD: @@ -181,6 +185,7 @@ void autopilot_set_mode(uint8_t new_autopilot_mode) { case AP_MODE_RATE_DIRECT: case AP_MODE_ATTITUDE_DIRECT: case AP_MODE_HOVER_DIRECT: + case AP_MODE_CARE_FREE: guidance_v_mode_changed(GUIDANCE_V_MODE_RC_DIRECT); break; case AP_MODE_RATE_RC_CLIMB: diff --git a/sw/airborne/firmwares/rotorcraft/autopilot.h b/sw/airborne/firmwares/rotorcraft/autopilot.h index b65f56fb3d..a00c003254 100644 --- a/sw/airborne/firmwares/rotorcraft/autopilot.h +++ b/sw/airborne/firmwares/rotorcraft/autopilot.h @@ -49,8 +49,8 @@ #define AP_MODE_HOVER_CLIMB 10 #define AP_MODE_HOVER_Z_HOLD 11 #define AP_MODE_NAV 12 -#define AP_MODE_RC_DIRECT 13 // Safety Pilot Direct Commands for helicopter direct control: appropriately chosen as mode "13" - +#define AP_MODE_RC_DIRECT 13 // Safety Pilot Direct Commands for helicopter direct control: appropriately chosen as mode "13" +#define AP_MODE_CARE_FREE 14 extern uint8_t autopilot_mode; extern uint8_t autopilot_mode_auto2; diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h index 7c5fcb5f6d..0d813cd3aa 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h @@ -24,6 +24,9 @@ #include STABILIZATION_ATTITUDE_TYPE_H + +extern float care_free_heading; + extern void stabilization_attitude_init(void); extern void stabilization_attitude_read_rc(bool_t in_flight); extern void stabilization_attitude_enter(void); diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c index f4c5af2cb1..3e7a309362 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c @@ -58,6 +58,8 @@ struct Int32Eulers stabilization_att_sum_err; int32_t stabilization_att_fb_cmd[COMMANDS_NB]; int32_t stabilization_att_ff_cmd[COMMANDS_NB]; +float care_free_heading = 0; + #define IERROR_SCALE 1024 #define GAIN_PRESCALER_FF 48 #define GAIN_PRESCALER_P 48 diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h index 5712726256..143f1b2a4c 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h @@ -33,6 +33,7 @@ #include "subsystems/radio_control.h" #include "state.h" +#include "firmwares/rotorcraft/autopilot.h" #if defined STABILIZATION_ATTITUDE_TYPE_INT #define SP_MAX_PHI (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_PHI) @@ -187,7 +188,15 @@ static inline void stabilization_attitude_read_rc_setpoint_quat_f(struct FloatQu /* get current heading */ const struct FloatVect3 zaxis = {0., 0., 1.}; struct FloatQuat q_yaw; - FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, stateGetNedToBodyEulers_f()->psi); + + //Care Free mode + if(autopilot_mode == AP_MODE_CARE_FREE) { + //care_free_heading has been set to current psi when entering care free mode. + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, care_free_heading); + } + else { + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, stateGetNedToBodyEulers_f()->psi); + } /* roll/pitch commands applied to to current heading */ struct FloatQuat q_rp_sp; diff --git a/sw/airborne/modules/gain_scheduling/gain_scheduling.c b/sw/airborne/modules/gain_scheduling/gain_scheduling.c index deb68c6fc3..e90663c4ff 100644 --- a/sw/airborne/modules/gain_scheduling/gain_scheduling.c +++ b/sw/airborne/modules/gain_scheduling/gain_scheduling.c @@ -27,6 +27,7 @@ //Include for scheduling on transition_status #include "firmwares/rotorcraft/guidance/guidance_h.h" +#include "firmwares/rotorcraft/stabilization.h" // #include "state.h" #include "math/pprz_algebra_int.h" From 820f6d90114403a163a6d8afcc12ae23f443cf2d Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Sat, 9 Mar 2013 14:50:01 +0100 Subject: [PATCH 026/109] care_free_heading in stabilization.c --- sw/airborne/firmwares/rotorcraft/stabilization.c | 2 ++ .../rotorcraft/stabilization/stabilization_attitude_quat_int.c | 2 -- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/stabilization.c b/sw/airborne/firmwares/rotorcraft/stabilization.c index e2cbfc39ef..96a2e37316 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization.c @@ -27,6 +27,8 @@ int32_t stabilization_cmd[COMMANDS_NB]; +float care_free_heading = 0; + void stabilization_init(void) { #ifndef STABILIZATION_SKIP_RATE stabilization_none_init(); diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c index 3e7a309362..f4c5af2cb1 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_quat_int.c @@ -58,8 +58,6 @@ struct Int32Eulers stabilization_att_sum_err; int32_t stabilization_att_fb_cmd[COMMANDS_NB]; int32_t stabilization_att_ff_cmd[COMMANDS_NB]; -float care_free_heading = 0; - #define IERROR_SCALE 1024 #define GAIN_PRESCALER_FF 48 #define GAIN_PRESCALER_P 48 From 4167134c31298b8fe61aeb105999a7bfe00c58ee Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Sat, 9 Mar 2013 22:30:28 +0000 Subject: [PATCH 027/109] Baro MS5611: add nav.h for ground_alt (although not used), change I2C address to 0xEE for CSB\ low (as in most boards as Aspirin2.1, FreeIMU 0.4.3, ...) --- sw/airborne/modules/sensors/baro_ms5611_i2c.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sw/airborne/modules/sensors/baro_ms5611_i2c.c b/sw/airborne/modules/sensors/baro_ms5611_i2c.c index 6e6d9d01b1..2ba16cc9a4 100644 --- a/sw/airborne/modules/sensors/baro_ms5611_i2c.c +++ b/sw/airborne/modules/sensors/baro_ms5611_i2c.c @@ -33,6 +33,7 @@ #include "mcu_periph/uart.h" #include "messages.h" #include "subsystems/datalink/downlink.h" +#include "subsystems/nav.h" #ifndef DOWNLINK_DEVICE #define DOWNLINK_DEVICE DOWNLINK_AP_DEVICE @@ -42,9 +43,9 @@ #define MS5611_I2C_DEV i2c0 #endif -/* address can be 0xEC or 0xEE (CSB\ high = 0xEC) */ +/* address can be 0xEC or 0xEE (CSB\ low = 0xEE) */ #ifndef MS5611_SLAVE_ADDR -#define MS5611_SLAVE_ADDR 0xEC +#define MS5611_SLAVE_ADDR 0xEE #endif From fad35a2a7129bbaf9a87ae3729a14deb6ae730ce Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 10 Mar 2013 14:59:16 +0100 Subject: [PATCH 028/109] [rotorcraft] add CareFree mode to settings/gcs --- conf/messages.xml | 2 +- conf/settings/rotorcraft_basic.xml | 2 +- sw/ground_segment/tmtc/server_globals.ml | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/conf/messages.xml b/conf/messages.xml index b6ce932e59..157f37ee4c 100644 --- a/conf/messages.xml +++ b/conf/messages.xml @@ -1814,7 +1814,7 @@ - + diff --git a/conf/settings/rotorcraft_basic.xml b/conf/settings/rotorcraft_basic.xml index a053af6a4c..00883dccf2 100644 --- a/conf/settings/rotorcraft_basic.xml +++ b/conf/settings/rotorcraft_basic.xml @@ -4,7 +4,7 @@ - + diff --git a/sw/ground_segment/tmtc/server_globals.ml b/sw/ground_segment/tmtc/server_globals.ml index fb6d60214b..0d81357ce9 100644 --- a/sw/ground_segment/tmtc/server_globals.ml +++ b/sw/ground_segment/tmtc/server_globals.ml @@ -4,7 +4,7 @@ let hostname = ref "localhost" (** FIXME: Should be read from messages.xml *) let fixedwing_ap_modes = [|"MANUAL";"AUTO1";"AUTO2";"HOME";"NOGPS";"FAIL"|] -let rotorcraft_ap_modes = [|"SAFE";"KILL";"RATE";"ATT";"R_RCC";"A_RCC";"ATT_C";"R_ZH";"A_ZH";"HOVER";"HOV_C";"H_ZH";"NAV";"RC_D"|] +let rotorcraft_ap_modes = [|"SAFE";"KILL";"RATE";"ATT";"R_RCC";"A_RCC";"ATT_C";"R_ZH";"A_ZH";"HOVER";"HOV_C";"H_ZH";"NAV";"RC_D";"CF"|] let _AUTO2 = 2 let gaz_modes = [|"MANUAL";"GAZ";"CLIMB";"ALT"|] let lat_modes = [|"MANUAL";"ROLL_RATE";"ROLL";"COURSE"|] From 3a7bba4a6e42e372ce1ff7458d090af7c19bbe2a Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 10 Mar 2013 16:26:04 +0100 Subject: [PATCH 029/109] [rotorcraft] care free mode - still not implemented for stabilization_euler - move read_rc_setpoint_* functions to c file - add GUIDANCE_H_MODE_CARE_FREE mode - add stabilization float_euler subsystem - use normal stabilization subsystem in NPS instead of hardcoded euler --- .../subsystems/rotorcraft/fdm_jsbsim.makefile | 33 --- .../rotorcraft/stabilization_euler.makefile | 17 +- .../stabilization_float_euler.makefile | 12 + .../stabilization_float_quat.makefile | 19 +- .../stabilization_int_quat.makefile | 19 +- conf/messages.xml | 2 +- sw/airborne/firmwares/rotorcraft/autopilot.c | 138 ++++++------ sw/airborne/firmwares/rotorcraft/autopilot.h | 2 +- .../rotorcraft/guidance/guidance_h.c | 140 ++++++------ .../rotorcraft/guidance/guidance_h.h | 1 + .../firmwares/rotorcraft/stabilization.c | 2 - .../stabilization/stabilization_attitude.h | 2 - .../stabilization_attitude_rc_setpoint.c | 213 ++++++++++++++++++ .../stabilization_attitude_rc_setpoint.h | 173 +------------- 14 files changed, 412 insertions(+), 361 deletions(-) create mode 100644 conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile create mode 100644 sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c diff --git a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile index 985f80a937..0272f455b0 100644 --- a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile +++ b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile @@ -111,39 +111,6 @@ nps.srcs += $(SRC_FIRMWARE)/stabilization.c nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_none.c - -NUM_TYPE=integer -#NUM_TYPE=float - -STAB_TYPE=euler -#STAB_TYPE=quaternion - -ifeq ($(NUM_TYPE), integer) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" - ifeq ($(STAB_TYPE), euler) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c - else ifeq ($(STAB_TYPE), quaternion) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c - endif -else ifeq ($(NUM_TYPE), float) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_FLOAT - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" - ifeq ($(STAB_TYPE), euler) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_float.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_float.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_float.c - else ifeq ($(STAB_TYPE), quaternion) - nps.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c - nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c - endif -endif - nps.CFLAGS += -DUSE_NAVIGATION nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile index 3fc38bf53e..e62c41b687 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_euler.makefile @@ -1,5 +1,12 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_INT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_int.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile new file mode 100644 index 0000000000..4f3b11e76d --- /dev/null +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_float_euler.makefile @@ -0,0 +1,12 @@ +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_FLOAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_euler_float.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_euler_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_euler_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile index 770097569d..ba005a992d 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_float_quat.makefile @@ -1,6 +1,13 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_FLOAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_FLOAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_float.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_float.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_float.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile b/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile index 775dc7ce34..10e015f4a2 100644 --- a/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile +++ b/conf/firmwares/subsystems/rotorcraft/stabilization_int_quat.makefile @@ -1,6 +1,13 @@ -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_INT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" -ap.CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c -ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c +STAB_ATT_CFLAGS = -DSTABILIZATION_ATTITUDE_TYPE_INT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_QUAT +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_TYPE_H=\"stabilization/stabilization_attitude_int.h\" +STAB_ATT_CFLAGS += -DSTABILIZATION_ATTITUDE_REF_TYPE_H=\"stabilization/stabilization_attitude_ref_quat_int.h\" +STAB_ATT_SRCS = $(SRC_FIRMWARE)/stabilization/stabilization_attitude_ref_quat_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_quat_int.c +STAB_ATT_SRCS += $(SRC_FIRMWARE)/stabilization/stabilization_attitude_rc_setpoint.c + +ap.CFLAGS += $(STAB_ATT_CFLAGS) +ap.srcs += $(STAB_ATT_SRCS) + +nps.CFLAGS += $(STAB_ATT_CFLAGS) +nps.srcs += $(STAB_ATT_SRCS) diff --git a/conf/messages.xml b/conf/messages.xml index 157f37ee4c..a4e65b965b 100644 --- a/conf/messages.xml +++ b/conf/messages.xml @@ -1817,7 +1817,7 @@ - + diff --git a/sw/airborne/firmwares/rotorcraft/autopilot.c b/sw/airborne/firmwares/rotorcraft/autopilot.c index 6377d135ab..c2a07cdf0f 100644 --- a/sw/airborne/firmwares/rotorcraft/autopilot.c +++ b/sw/airborne/firmwares/rotorcraft/autopilot.c @@ -130,82 +130,82 @@ void autopilot_set_mode(uint8_t new_autopilot_mode) { if (new_autopilot_mode != autopilot_mode) { /* horizontal mode */ switch (new_autopilot_mode) { - case AP_MODE_FAILSAFE: + case AP_MODE_FAILSAFE: #ifndef KILL_AS_FAILSAFE - stab_att_sp_euler.phi = 0; - stab_att_sp_euler.theta = 0; - guidance_h_mode_changed(GUIDANCE_H_MODE_ATTITUDE); - break; + stab_att_sp_euler.phi = 0; + stab_att_sp_euler.theta = 0; + guidance_h_mode_changed(GUIDANCE_H_MODE_ATTITUDE); + break; #endif - case AP_MODE_KILL: - autopilot_set_motors_on(FALSE); - autopilot_in_flight = FALSE; - autopilot_in_flight_counter = 0; - guidance_h_mode_changed(GUIDANCE_H_MODE_KILL); - break; - case AP_MODE_RC_DIRECT: - guidance_h_mode_changed(GUIDANCE_H_MODE_RC_DIRECT); - break; - case AP_MODE_RATE_DIRECT: - case AP_MODE_RATE_Z_HOLD: - guidance_h_mode_changed(GUIDANCE_H_MODE_RATE); - break; - case AP_MODE_CARE_FREE: - //Take the current psi as the reference for pitch and roll - care_free_heading = stateGetNedToBodyEulers_f()->psi; - case AP_MODE_ATTITUDE_RC_CLIMB: - case AP_MODE_ATTITUDE_DIRECT: - case AP_MODE_ATTITUDE_CLIMB: - case AP_MODE_ATTITUDE_Z_HOLD: - guidance_h_mode_changed(GUIDANCE_H_MODE_ATTITUDE); - break; - case AP_MODE_HOVER_DIRECT: - case AP_MODE_HOVER_CLIMB: - case AP_MODE_HOVER_Z_HOLD: - guidance_h_mode_changed(GUIDANCE_H_MODE_HOVER); - break; - case AP_MODE_NAV: - guidance_h_mode_changed(GUIDANCE_H_MODE_NAV); - break; - default: - break; + case AP_MODE_KILL: + autopilot_set_motors_on(FALSE); + autopilot_in_flight = FALSE; + autopilot_in_flight_counter = 0; + guidance_h_mode_changed(GUIDANCE_H_MODE_KILL); + break; + case AP_MODE_RC_DIRECT: + guidance_h_mode_changed(GUIDANCE_H_MODE_RC_DIRECT); + break; + case AP_MODE_RATE_DIRECT: + case AP_MODE_RATE_Z_HOLD: + guidance_h_mode_changed(GUIDANCE_H_MODE_RATE); + break; + case AP_MODE_ATTITUDE_RC_CLIMB: + case AP_MODE_ATTITUDE_DIRECT: + case AP_MODE_ATTITUDE_CLIMB: + case AP_MODE_ATTITUDE_Z_HOLD: + guidance_h_mode_changed(GUIDANCE_H_MODE_ATTITUDE); + break; + case AP_MODE_CARE_FREE_DIRECT: + guidance_h_mode_changed(GUIDANCE_H_MODE_CARE_FREE); + break; + case AP_MODE_HOVER_DIRECT: + case AP_MODE_HOVER_CLIMB: + case AP_MODE_HOVER_Z_HOLD: + guidance_h_mode_changed(GUIDANCE_H_MODE_HOVER); + break; + case AP_MODE_NAV: + guidance_h_mode_changed(GUIDANCE_H_MODE_NAV); + break; + default: + break; } /* vertical mode */ switch (new_autopilot_mode) { - case AP_MODE_FAILSAFE: + case AP_MODE_FAILSAFE: #ifndef KILL_AS_FAILSAFE - guidance_v_zd_sp = SPEED_BFP_OF_REAL(0.5); - guidance_v_mode_changed(GUIDANCE_V_MODE_CLIMB); - break; + guidance_v_zd_sp = SPEED_BFP_OF_REAL(0.5); + guidance_v_mode_changed(GUIDANCE_V_MODE_CLIMB); + break; #endif - case AP_MODE_KILL: - guidance_v_mode_changed(GUIDANCE_V_MODE_KILL); - break; - case AP_MODE_RC_DIRECT: - case AP_MODE_RATE_DIRECT: - case AP_MODE_ATTITUDE_DIRECT: - case AP_MODE_HOVER_DIRECT: - case AP_MODE_CARE_FREE: - guidance_v_mode_changed(GUIDANCE_V_MODE_RC_DIRECT); - break; - case AP_MODE_RATE_RC_CLIMB: - case AP_MODE_ATTITUDE_RC_CLIMB: - guidance_v_mode_changed(GUIDANCE_V_MODE_RC_CLIMB); - break; - case AP_MODE_ATTITUDE_CLIMB: - case AP_MODE_HOVER_CLIMB: - guidance_v_mode_changed(GUIDANCE_V_MODE_CLIMB); - break; - case AP_MODE_RATE_Z_HOLD: - case AP_MODE_ATTITUDE_Z_HOLD: - case AP_MODE_HOVER_Z_HOLD: - guidance_v_mode_changed(GUIDANCE_V_MODE_HOVER); - break; - case AP_MODE_NAV: - guidance_v_mode_changed(GUIDANCE_V_MODE_NAV); - break; - default: - break; + case AP_MODE_KILL: + guidance_v_mode_changed(GUIDANCE_V_MODE_KILL); + break; + case AP_MODE_RC_DIRECT: + case AP_MODE_RATE_DIRECT: + case AP_MODE_ATTITUDE_DIRECT: + case AP_MODE_HOVER_DIRECT: + case AP_MODE_CARE_FREE_DIRECT: + guidance_v_mode_changed(GUIDANCE_V_MODE_RC_DIRECT); + break; + case AP_MODE_RATE_RC_CLIMB: + case AP_MODE_ATTITUDE_RC_CLIMB: + guidance_v_mode_changed(GUIDANCE_V_MODE_RC_CLIMB); + break; + case AP_MODE_ATTITUDE_CLIMB: + case AP_MODE_HOVER_CLIMB: + guidance_v_mode_changed(GUIDANCE_V_MODE_CLIMB); + break; + case AP_MODE_RATE_Z_HOLD: + case AP_MODE_ATTITUDE_Z_HOLD: + case AP_MODE_HOVER_Z_HOLD: + guidance_v_mode_changed(GUIDANCE_V_MODE_HOVER); + break; + case AP_MODE_NAV: + guidance_v_mode_changed(GUIDANCE_V_MODE_NAV); + break; + default: + break; } autopilot_mode = new_autopilot_mode; } diff --git a/sw/airborne/firmwares/rotorcraft/autopilot.h b/sw/airborne/firmwares/rotorcraft/autopilot.h index a00c003254..78d9cf310a 100644 --- a/sw/airborne/firmwares/rotorcraft/autopilot.h +++ b/sw/airborne/firmwares/rotorcraft/autopilot.h @@ -50,7 +50,7 @@ #define AP_MODE_HOVER_Z_HOLD 11 #define AP_MODE_NAV 12 #define AP_MODE_RC_DIRECT 13 // Safety Pilot Direct Commands for helicopter direct control: appropriately chosen as mode "13" -#define AP_MODE_CARE_FREE 14 +#define AP_MODE_CARE_FREE_DIRECT 14 extern uint8_t autopilot_mode; extern uint8_t autopilot_mode_auto2; diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c index 0c2ebc0ac7..75c60529a6 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c @@ -59,8 +59,8 @@ int32_t guidance_h_igain; int32_t guidance_h_again; /* warn if some gains are still negative */ -#if (GUIDANCE_H_PGAIN < 0) || \ - (GUIDANCE_H_DGAIN < 0) || \ +#if (GUIDANCE_H_PGAIN < 0) || \ + (GUIDANCE_H_DGAIN < 0) || \ (GUIDANCE_H_IGAIN < 0) #warning "ALL control gains are now positive!!!" #endif @@ -84,10 +84,10 @@ static inline void guidance_h_hover_enter(void); static inline void guidance_h_nav_enter(void); #define GuidanceHSetRef(_pos, _speed, _accel) { \ - b2_gh_set_ref(_pos, _speed, _accel); \ - VECT2_COPY(guidance_h_pos_ref, _pos); \ - VECT2_COPY(guidance_h_speed_ref, _speed); \ - VECT2_COPY(guidance_h_accel_ref, _accel); \ + b2_gh_set_ref(_pos, _speed, _accel); \ + VECT2_COPY(guidance_h_pos_ref, _pos); \ + VECT2_COPY(guidance_h_speed_ref, _speed); \ + VECT2_COPY(guidance_h_accel_ref, _accel); \ } @@ -111,28 +111,29 @@ void guidance_h_mode_changed(uint8_t new_mode) { return; switch (new_mode) { + case GUIDANCE_H_MODE_RC_DIRECT: + stabilization_none_enter(); + break; - case GUIDANCE_H_MODE_RC_DIRECT: - stabilization_none_enter(); - break; + case GUIDANCE_H_MODE_RATE: + stabilization_rate_enter(); + break; - case GUIDANCE_H_MODE_RATE: - stabilization_rate_enter(); - break; + case GUIDANCE_H_MODE_CARE_FREE: + stabilization_attitude_reset_care_free_heading(); + case GUIDANCE_H_MODE_ATTITUDE: + stabilization_attitude_enter(); + break; - case GUIDANCE_H_MODE_ATTITUDE: - stabilization_attitude_enter(); - break; + case GUIDANCE_H_MODE_HOVER: + guidance_h_hover_enter(); + break; - case GUIDANCE_H_MODE_HOVER: - guidance_h_hover_enter(); - break; - - case GUIDANCE_H_MODE_NAV: - guidance_h_nav_enter(); - break; - default: - break; + case GUIDANCE_H_MODE_NAV: + guidance_h_nav_enter(); + break; + default: + break; } guidance_h_mode = new_mode; @@ -144,32 +145,33 @@ void guidance_h_read_rc(bool_t in_flight) { switch ( guidance_h_mode ) { - case GUIDANCE_H_MODE_RC_DIRECT: - stabilization_none_read_rc(); - break; + case GUIDANCE_H_MODE_RC_DIRECT: + stabilization_none_read_rc(); + break; - case GUIDANCE_H_MODE_RATE: - stabilization_rate_read_rc(); - break; + case GUIDANCE_H_MODE_RATE: + stabilization_rate_read_rc(); + break; - case GUIDANCE_H_MODE_ATTITUDE: - stabilization_attitude_read_rc(in_flight); - break; + case GUIDANCE_H_MODE_CARE_FREE: + case GUIDANCE_H_MODE_ATTITUDE: + stabilization_attitude_read_rc(in_flight); + break; - case GUIDANCE_H_MODE_HOVER: - stabilization_attitude_read_rc_setpoint_eulers(&guidance_h_rc_sp, in_flight); - break; - - case GUIDANCE_H_MODE_NAV: - if (radio_control.status == RC_OK) { + case GUIDANCE_H_MODE_HOVER: stabilization_attitude_read_rc_setpoint_eulers(&guidance_h_rc_sp, in_flight); - } - else { - INT_EULERS_ZERO(guidance_h_rc_sp); - } - break; - default: - break; + break; + + case GUIDANCE_H_MODE_NAV: + if (radio_control.status == RC_OK) { + stabilization_attitude_read_rc_setpoint_eulers(&guidance_h_rc_sp, in_flight); + } + else { + INT_EULERS_ZERO(guidance_h_rc_sp); + } + break; + default: + break; } } @@ -178,31 +180,31 @@ void guidance_h_read_rc(bool_t in_flight) { void guidance_h_run(bool_t in_flight) { switch ( guidance_h_mode ) { - case GUIDANCE_H_MODE_RC_DIRECT: - stabilization_none_run(in_flight); - break; + case GUIDANCE_H_MODE_RC_DIRECT: + stabilization_none_run(in_flight); + break; - case GUIDANCE_H_MODE_RATE: - stabilization_rate_run(in_flight); - break; + case GUIDANCE_H_MODE_RATE: + stabilization_rate_run(in_flight); + break; - case GUIDANCE_H_MODE_ATTITUDE: - stabilization_attitude_run(in_flight); - break; + case GUIDANCE_H_MODE_CARE_FREE: + case GUIDANCE_H_MODE_ATTITUDE: + stabilization_attitude_run(in_flight); + break; - case GUIDANCE_H_MODE_HOVER: - guidance_h_update_reference(FALSE); + case GUIDANCE_H_MODE_HOVER: + guidance_h_update_reference(FALSE); - /* set psi command */ - guidance_h_command_body.psi = guidance_h_rc_sp.psi; - /* compute roll and pitch commands and set final attitude setpoint */ - guidance_h_traj_run(in_flight); + /* set psi command */ + guidance_h_command_body.psi = guidance_h_rc_sp.psi; + /* compute roll and pitch commands and set final attitude setpoint */ + guidance_h_traj_run(in_flight); - stabilization_attitude_run(in_flight); - break; + stabilization_attitude_run(in_flight); + break; - case GUIDANCE_H_MODE_NAV: - { + case GUIDANCE_H_MODE_NAV: if (!in_flight) guidance_h_nav_enter(); if (horizontal_mode == HORIZONTAL_MODE_ATTITUDE) { @@ -230,9 +232,9 @@ void guidance_h_run(bool_t in_flight) { } stabilization_attitude_run(in_flight); break; - } - default: - break; + + default: + break; } } @@ -306,7 +308,7 @@ static inline void guidance_h_traj_run(bool_t in_flight) { // Restore angle ref resolution after rotation guidance_h_command_body.phi = - ( - s_psi * guidance_h_command_earth.x + c_psi * guidance_h_command_earth.y) >> INT32_TRIG_FRAC; + ( - s_psi * guidance_h_command_earth.x + c_psi * guidance_h_command_earth.y) >> INT32_TRIG_FRAC; guidance_h_command_body.theta = - ( c_psi * guidance_h_command_earth.x + s_psi * guidance_h_command_earth.y) >> INT32_TRIG_FRAC; diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h index f24ea8c350..aec9bcf361 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h @@ -38,6 +38,7 @@ #define GUIDANCE_H_MODE_HOVER 3 #define GUIDANCE_H_MODE_NAV 4 #define GUIDANCE_H_MODE_RC_DIRECT 5 +#define GUIDANCE_H_MODE_CARE_FREE 6 extern uint8_t guidance_h_mode; diff --git a/sw/airborne/firmwares/rotorcraft/stabilization.c b/sw/airborne/firmwares/rotorcraft/stabilization.c index 96a2e37316..e2cbfc39ef 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization.c @@ -27,8 +27,6 @@ int32_t stabilization_cmd[COMMANDS_NB]; -float care_free_heading = 0; - void stabilization_init(void) { #ifndef STABILIZATION_SKIP_RATE stabilization_none_init(); diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h index 0d813cd3aa..9ee532725f 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude.h @@ -25,8 +25,6 @@ #include STABILIZATION_ATTITUDE_TYPE_H -extern float care_free_heading; - extern void stabilization_attitude_init(void); extern void stabilization_attitude_read_rc(bool_t in_flight); extern void stabilization_attitude_enter(void); diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c new file mode 100644 index 0000000000..72da8041e6 --- /dev/null +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c @@ -0,0 +1,213 @@ +/* + * Copyright (C) 2012-2013 Felix Ruess + * + * 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. + */ + +/** @file stabilization_attitude_rc_setpoint.c + * Read an attitude setpoint from the RC. + */ + +#include "firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h" + +#include "subsystems/radio_control.h" +#include "state.h" +#include "firmwares/rotorcraft/guidance/guidance_h.h" +#include "firmwares/rotorcraft/stabilization/stabilization_attitude_ref.h" + +#if defined STABILIZATION_ATTITUDE_TYPE_INT +#define SP_MAX_PHI (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_PHI) +#define SP_MAX_THETA (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_THETA) +#define SP_MAX_R (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_R) +#elif defined STABILIZATION_ATTITUDE_TYPE_FLOAT +#define SP_MAX_PHI STABILIZATION_ATTITUDE_SP_MAX_PHI +#define SP_MAX_THETA STABILIZATION_ATTITUDE_SP_MAX_THETA +#define SP_MAX_R STABILIZATION_ATTITUDE_SP_MAX_R +#else +#error "STABILIZATION_ATTITUDE_TYPE not defined" +#endif + +#ifndef RC_UPDATE_FREQ +#define RC_UPDATE_FREQ 40 +#endif + +float care_free_heading = 0; + +/// reset the heading for care-free mode to current heading +void stabilization_attitude_reset_care_free_heading(void) { + care_free_heading = stateGetNedToBodyEulers_f()->psi; +} + +/** Read attitude setpoint from RC as euler angles. + * @todo implement care_free_heading as in quaternion setpoint... + * @param[in] in_flight true if in flight + * @param[out] sp attitude setpoint as euler angles + */ +void stabilization_attitude_read_rc_setpoint_eulers(struct Int32Eulers *sp, bool_t in_flight) { + + sp->phi = ((int32_t) radio_control.values[RADIO_ROLL] * SP_MAX_PHI / MAX_PPRZ); + sp->theta = ((int32_t) radio_control.values[RADIO_PITCH] * SP_MAX_THETA / MAX_PPRZ); + + if (in_flight) { + if (YAW_DEADBAND_EXCEEDED()) { + sp->psi += ((int32_t) radio_control.values[RADIO_YAW] * SP_MAX_R / MAX_PPRZ / RC_UPDATE_FREQ); + INT32_ANGLE_NORMALIZE(sp->psi); + } +#ifdef STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT + // Make sure the yaw setpoint does not differ too much from the real yaw + // to prevent a sudden switch at 180 deg + int32_t delta_psi = sp->psi - stateGetNedToBodyEulers_i()->psi; + int32_t delta_limit = ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT); + INT32_ANGLE_NORMALIZE(delta_psi); + if (delta_psi > delta_limit){ + sp->psi = stateGetNedToBodyEulers_i()->psi + delta_limit; + } + else if (delta_psi < -delta_limit){ + sp->psi = stateGetNedToBodyEulers_i()->psi - delta_limit; + } + INT32_ANGLE_NORMALIZE(sp->psi); +#endif + } + else { /* if not flying, use current yaw as setpoint */ + sp->psi = stateGetNedToBodyEulers_i()->psi; + } +} + + +void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bool_t in_flight) { + sp->phi = (radio_control.values[RADIO_ROLL] * SP_MAX_PHI / MAX_PPRZ); + sp->theta = (radio_control.values[RADIO_PITCH] * SP_MAX_THETA / MAX_PPRZ); + + if (in_flight) { + if (YAW_DEADBAND_EXCEEDED()) { + sp->psi += (radio_control.values[RADIO_YAW] * SP_MAX_R / MAX_PPRZ / RC_UPDATE_FREQ); + FLOAT_ANGLE_NORMALIZE(sp->psi); + } +#ifdef STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT + // Make sure the yaw setpoint does not differ too much from the real yaw + // to prevent a sudden switch at 180 deg + float delta_psi = sp->psi - stateGetNedToBodyEulers_f()->psi; + FLOAT_ANGLE_NORMALIZE(delta_psi); + if (delta_psi > STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT){ + sp->psi = stateGetNedToBodyEulers_f()->psi + STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT; + } + else if (delta_psi < -STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT){ + sp->psi = stateGetNedToBodyEulers_f()->psi - STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT; + } + FLOAT_ANGLE_NORMALIZE(sp->psi); +#endif + } + else { /* if not flying, use current yaw as setpoint */ + sp->psi = stateGetNedToBodyEulers_f()->psi; + } +} + + +/** Read roll/pitch command from RC as quaternion. + * Interprets the stick positions as axes. + * @param[out] q quaternion representing the RC roll/pitch input + */ +void stabilization_attitude_read_rc_roll_pitch_quat_f(struct FloatQuat* q) { + q->qx = radio_control.values[RADIO_ROLL] * STABILIZATION_ATTITUDE_SP_MAX_PHI / MAX_PPRZ / 2; + q->qy = radio_control.values[RADIO_PITCH] * STABILIZATION_ATTITUDE_SP_MAX_THETA / MAX_PPRZ / 2; + q->qz = 0.0; + + /* normalize */ + float norm = sqrtf(1.0 + SQUARE(q->qx)+ SQUARE(q->qy)); + q->qi = 1.0 / norm; + q->qx /= norm; + q->qy /= norm; +} + +/** Read roll/pitch command from RC as quaternion. + * Both angles are are interpreted relative to to the horizontal plane (earth bound). + * @param[out] q quaternion representing the RC roll/pitch input + */ +void stabilization_attitude_read_rc_roll_pitch_earth_quat_f(struct FloatQuat* q) { + /* only non-zero entries for roll quaternion */ + float roll2 = radio_control.values[RADIO_ROLL] * STABILIZATION_ATTITUDE_SP_MAX_PHI / MAX_PPRZ / 2; + float qx_roll = sinf(roll2); + float qi_roll = cosf(roll2); + + /* only non-zero entries for pitch quaternion */ + float pitch2 = radio_control.values[RADIO_PITCH] * STABILIZATION_ATTITUDE_SP_MAX_THETA / MAX_PPRZ / 2; + float qy_pitch = sinf(pitch2); + float qi_pitch = cosf(pitch2); + + /* only multiply non-zero entries of FLOAT_QUAT_COMP(*q, q_roll, q_pitch) */ + q->qi = qi_roll * qi_pitch; + q->qx = qx_roll * qi_pitch; + q->qy = qi_roll * qy_pitch; + q->qz = qx_roll * qy_pitch; +} + +void stabilization_attitude_read_rc_setpoint_quat_f(struct FloatQuat* q_sp, bool_t in_flight) { + + // FIXME: remove me, do in quaternion directly + // is currently still needed, since the yaw setpoint integration is done in eulers +#if defined STABILIZATION_ATTITUDE_TYPE_INT + stabilization_attitude_read_rc_setpoint_eulers(&stab_att_sp_euler, in_flight); +#else + stabilization_attitude_read_rc_setpoint_eulers_f(&stab_att_sp_euler, in_flight); +#endif + + struct FloatQuat q_rp_cmd; +#if USE_EARTH_BOUND_RC_SETPOINT + stabilization_attitude_read_rc_roll_pitch_earth_quat_f(&q_rp_cmd); +#else + stabilization_attitude_read_rc_roll_pitch_quat_f(&q_rp_cmd); +#endif + + /* get current heading */ + const struct FloatVect3 zaxis = {0., 0., 1.}; + struct FloatQuat q_yaw; + + //Care Free mode + if (guidance_h_mode == GUIDANCE_H_MODE_CARE_FREE) { + //care_free_heading has been set to current psi when entering care free mode. + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, care_free_heading); + } + else { + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, stateGetNedToBodyEulers_f()->psi); + } + + /* roll/pitch commands applied to to current heading */ + struct FloatQuat q_rp_sp; + FLOAT_QUAT_COMP(q_rp_sp, q_yaw, q_rp_cmd); + FLOAT_QUAT_NORMALIZE(q_rp_sp); + + if (in_flight) + { + /* get current heading setpoint */ + struct FloatQuat q_yaw_sp; +#if defined STABILIZATION_ATTITUDE_TYPE_INT + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw_sp, zaxis, ANGLE_FLOAT_OF_BFP(stab_att_sp_euler.psi)); +#else + FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw_sp, zaxis, stab_att_sp_euler.psi); +#endif + + /* rotation between current yaw and yaw setpoint */ + struct FloatQuat q_yaw_diff; + FLOAT_QUAT_COMP_INV(q_yaw_diff, q_yaw_sp, q_yaw); + + /* compute final setpoint with yaw */ + FLOAT_QUAT_COMP_NORM_SHORTEST(*q_sp, q_rp_sp, q_yaw_diff); + } else { + QUAT_COPY(*q_sp, q_rp_sp); + } +} diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h index 143f1b2a4c..f9df2a76f8 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.h @@ -33,23 +33,7 @@ #include "subsystems/radio_control.h" #include "state.h" -#include "firmwares/rotorcraft/autopilot.h" -#if defined STABILIZATION_ATTITUDE_TYPE_INT -#define SP_MAX_PHI (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_PHI) -#define SP_MAX_THETA (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_THETA) -#define SP_MAX_R (int32_t)ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_MAX_R) -#elif defined STABILIZATION_ATTITUDE_TYPE_FLOAT -#define SP_MAX_PHI STABILIZATION_ATTITUDE_SP_MAX_PHI -#define SP_MAX_THETA STABILIZATION_ATTITUDE_SP_MAX_THETA -#define SP_MAX_R STABILIZATION_ATTITUDE_SP_MAX_R -#else -#error "STABILIZATION_ATTITUDE_TYPE not defined" -#endif - -#ifndef RC_UPDATE_FREQ -#define RC_UPDATE_FREQ 40 -#endif #ifdef STABILIZATION_ATTITUDE_DEADBAND_A #define ROLL_DEADBAND_EXCEEDED() \ @@ -71,156 +55,11 @@ (radio_control.values[RADIO_YAW] > STABILIZATION_ATTITUDE_DEADBAND_R || \ radio_control.values[RADIO_YAW] < -STABILIZATION_ATTITUDE_DEADBAND_R) +extern void stabilization_attitude_reset_care_free_heading(void); +extern void stabilization_attitude_read_rc_setpoint_eulers(struct Int32Eulers *sp, bool_t in_flight); +extern void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bool_t in_flight); +extern void stabilization_attitude_read_rc_roll_pitch_quat_f(struct FloatQuat* q); +extern void stabilization_attitude_read_rc_roll_pitch_earth_quat_f(struct FloatQuat* q); +extern void stabilization_attitude_read_rc_setpoint_quat_f(struct FloatQuat* q_sp, bool_t in_flight); -static inline void stabilization_attitude_read_rc_setpoint_eulers(struct Int32Eulers *sp, bool_t in_flight) { - - sp->phi = ((int32_t) radio_control.values[RADIO_ROLL] * SP_MAX_PHI / MAX_PPRZ); - sp->theta = ((int32_t) radio_control.values[RADIO_PITCH] * SP_MAX_THETA / MAX_PPRZ); - - if (in_flight) { - if (YAW_DEADBAND_EXCEEDED()) { - sp->psi += ((int32_t) radio_control.values[RADIO_YAW] * SP_MAX_R / MAX_PPRZ / RC_UPDATE_FREQ); - INT32_ANGLE_NORMALIZE(sp->psi); - } -#ifdef STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT - // Make sure the yaw setpoint does not differ too much from the real yaw to prevent a sudden switch at 180 deg - int32_t delta_psi = sp->psi - stateGetNedToBodyEulers_i()->psi; - int32_t delta_limit = ANGLE_BFP_OF_REAL(STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT); - INT32_ANGLE_NORMALIZE(delta_psi); - if (delta_psi > delta_limit){ - sp->psi = stateGetNedToBodyEulers_i()->psi + delta_limit; - } - else if (delta_psi < -delta_limit){ - sp->psi = stateGetNedToBodyEulers_i()->psi - delta_limit; - } - INT32_ANGLE_NORMALIZE(sp->psi); -#endif - } - else { /* if not flying, use current yaw as setpoint */ - sp->psi = stateGetNedToBodyEulers_i()->psi; - } -} - - -static inline void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bool_t in_flight) { - sp->phi = (radio_control.values[RADIO_ROLL] * SP_MAX_PHI / MAX_PPRZ); - sp->theta = (radio_control.values[RADIO_PITCH] * SP_MAX_THETA / MAX_PPRZ); - - if (in_flight) { - if (YAW_DEADBAND_EXCEEDED()) { - sp->psi += (radio_control.values[RADIO_YAW] * SP_MAX_R / MAX_PPRZ / RC_UPDATE_FREQ); - FLOAT_ANGLE_NORMALIZE(sp->psi); - } -#ifdef STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT - // Make sure the yaw setpoint does not differ too much from the real yaw to prevent a sudden switch at 180 deg - float delta_psi = sp->psi - stateGetNedToBodyEulers_f()->psi; - FLOAT_ANGLE_NORMALIZE(delta_psi); - if (delta_psi > STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT){ - sp->psi = stateGetNedToBodyEulers_f()->psi + STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT; - } - else if (delta_psi < -STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT){ - sp->psi = stateGetNedToBodyEulers_f()->psi - STABILIZATION_ATTITUDE_SP_PSI_DELTA_LIMIT; - } - FLOAT_ANGLE_NORMALIZE(sp->psi); -#endif - } - else { /* if not flying, use current yaw as setpoint */ - sp->psi = stateGetNedToBodyEulers_f()->psi; - } -} - - -/** Read roll/pitch command from RC as quaternion. - * Interprets the stick positions as axes. - * @param[out] q quaternion representing the RC roll/pitch input - */ -static inline void stabilization_attitude_read_rc_roll_pitch_quat_f(struct FloatQuat* q) { - q->qx = radio_control.values[RADIO_ROLL] * STABILIZATION_ATTITUDE_SP_MAX_PHI / MAX_PPRZ / 2; - q->qy = radio_control.values[RADIO_PITCH] * STABILIZATION_ATTITUDE_SP_MAX_THETA / MAX_PPRZ / 2; - q->qz = 0.0; - - /* normalize */ - float norm = sqrtf(1.0 + SQUARE(q->qx)+ SQUARE(q->qy)); - q->qi = 1.0 / norm; - q->qx /= norm; - q->qy /= norm; -} - -/** Read roll/pitch command from RC as quaternion. - * Both angles are are interpreted relative to to the horizontal plane (earth bound). - * @param[out] q quaternion representing the RC roll/pitch input - */ -static inline void stabilization_attitude_read_rc_roll_pitch_earth_quat_f(struct FloatQuat* q) { - /* only non-zero entries for roll quaternion */ - float roll2 = radio_control.values[RADIO_ROLL] * STABILIZATION_ATTITUDE_SP_MAX_PHI / MAX_PPRZ / 2; - float qx_roll = sinf(roll2); - float qi_roll = cosf(roll2); - - /* only non-zero entries for pitch quaternion */ - float pitch2 = radio_control.values[RADIO_PITCH] * STABILIZATION_ATTITUDE_SP_MAX_THETA / MAX_PPRZ / 2; - float qy_pitch = sinf(pitch2); - float qi_pitch = cosf(pitch2); - - /* only multiply non-zero entries of FLOAT_QUAT_COMP(*q, q_roll, q_pitch) */ - q->qi = qi_roll * qi_pitch; - q->qx = qx_roll * qi_pitch; - q->qy = qi_roll * qy_pitch; - q->qz = qx_roll * qy_pitch; -} - -static inline void stabilization_attitude_read_rc_setpoint_quat_f(struct FloatQuat* q_sp, bool_t in_flight) { - - // FIXME: remove me, do in quaternion directly - // is currently still needed, since the yaw setpoint integration is done in eulers -#if defined STABILIZATION_ATTITUDE_TYPE_INT - stabilization_attitude_read_rc_setpoint_eulers(&stab_att_sp_euler, in_flight); -#else - stabilization_attitude_read_rc_setpoint_eulers_f(&stab_att_sp_euler, in_flight); -#endif - - struct FloatQuat q_rp_cmd; -#if USE_EARTH_BOUND_RC_SETPOINT - stabilization_attitude_read_rc_roll_pitch_earth_quat_f(&q_rp_cmd); -#else - stabilization_attitude_read_rc_roll_pitch_quat_f(&q_rp_cmd); -#endif - - /* get current heading */ - const struct FloatVect3 zaxis = {0., 0., 1.}; - struct FloatQuat q_yaw; - - //Care Free mode - if(autopilot_mode == AP_MODE_CARE_FREE) { - //care_free_heading has been set to current psi when entering care free mode. - FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, care_free_heading); - } - else { - FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw, zaxis, stateGetNedToBodyEulers_f()->psi); - } - - /* roll/pitch commands applied to to current heading */ - struct FloatQuat q_rp_sp; - FLOAT_QUAT_COMP(q_rp_sp, q_yaw, q_rp_cmd); - FLOAT_QUAT_NORMALIZE(q_rp_sp); - - if (in_flight) - { - /* get current heading setpoint */ - struct FloatQuat q_yaw_sp; -#if defined STABILIZATION_ATTITUDE_TYPE_INT - FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw_sp, zaxis, ANGLE_FLOAT_OF_BFP(stab_att_sp_euler.psi)); -#else - FLOAT_QUAT_OF_AXIS_ANGLE(q_yaw_sp, zaxis, stab_att_sp_euler.psi); -#endif - - /* rotation between current yaw and yaw setpoint */ - struct FloatQuat q_yaw_diff; - FLOAT_QUAT_COMP_INV(q_yaw_diff, q_yaw_sp, q_yaw); - - /* compute final setpoint with yaw */ - FLOAT_QUAT_COMP_NORM_SHORTEST(*q_sp, q_rp_sp, q_yaw_diff); - } else { - QUAT_COPY(*q_sp, q_rp_sp); - } -} #endif /* STABILIZATION_ATTITUDE_RC_SETPOINT_H */ From 2cabd0a0db5977477ff3e4688b727632338c02a3 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 10 Mar 2013 17:23:40 +0100 Subject: [PATCH 030/109] [imu] aspirin2: suppress unused arg warning --- sw/airborne/subsystems/imu/imu_aspirin2.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/airborne/subsystems/imu/imu_aspirin2.c b/sw/airborne/subsystems/imu/imu_aspirin2.c index 9a2d0896c4..6ed8b6096f 100644 --- a/sw/airborne/subsystems/imu/imu_aspirin2.c +++ b/sw/airborne/subsystems/imu/imu_aspirin2.c @@ -99,7 +99,7 @@ void imu_periodic(void) } } -static void trans_cb( struct spi_transaction *trans ) { +static void trans_cb(struct spi_transaction *trans __attribute__ ((unused))) { if ( imu_aspirin2.status != Aspirin2StatusUninit ) { imu_aspirin2.imu_available = TRUE; } From bd2d80103a7d626d63cc423056f172d627bd501f Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 10 Mar 2013 17:27:42 +0100 Subject: [PATCH 031/109] [stm32] convert SpektrumParser from macro to static inline function --- .../subsystems/radio_control/spektrum_arch.c | 232 +++++++++--------- 1 file changed, 116 insertions(+), 116 deletions(-) diff --git a/sw/airborne/arch/stm32/subsystems/radio_control/spektrum_arch.c b/sw/airborne/arch/stm32/subsystems/radio_control/spektrum_arch.c index f0b13e0a35..874e4c02a2 100644 --- a/sw/airborne/arch/stm32/subsystems/radio_control/spektrum_arch.c +++ b/sw/airborne/arch/stm32/subsystems/radio_control/spektrum_arch.c @@ -245,115 +245,115 @@ void radio_control_impl_init(void) { * *****************************************************************************/ -#define SpektrumParser(_c, _SpektrumState, _receiver) { \ - \ - uint16_t ChannelData; \ - uint8_t TimedOut; \ - static uint8_t TmpEncType = 0; /* 0 = 10bit, 1 = 11 bit */ \ - static uint8_t TmpExpFrames = 0; /* # of frames for channel data */ \ - \ - TimedOut = (!_SpektrumState.SpektrumTimer) ? 1 : 0; \ - \ - /* If we have just started the resync process or */ \ - /* if we have recieved a character before our */ \ - /* 7ms wait has finished */ \ - if ((_SpektrumState.ReSync == 1) || \ - ((_SpektrumState.Sync == 0) && (!TimedOut))) { \ - \ - _SpektrumState.ReSync = 0; \ - _SpektrumState.SpektrumTimer = MIN_FRAME_SPACE; \ - _SpektrumState.Sync = 0; \ - _SpektrumState.ChannelCnt = 0; \ - _SpektrumState.FrameCnt = 0; \ - _SpektrumState.SecondFrame = 0; \ - return; \ - } \ - \ - /* the first byte of a new frame. It was received */ \ - /* more than 7ms after the last received byte. */ \ - /* It represents the number of lost frames so far.*/ \ - if (_SpektrumState.Sync == 0) { \ - _SpektrumState.LostFrameCnt = _c; \ - if(_receiver) /* secondary receiver */ \ - _SpektrumState.LostFrameCnt = _SpektrumState.LostFrameCnt << 8; \ - _SpektrumState.Sync = 1; \ - _SpektrumState.SpektrumTimer = MAX_BYTE_SPACE; \ - return; \ - } \ - \ - /* all other bytes should be recieved within */ \ - /* MAX_BYTE_SPACE time of the last byte received */ \ - /* otherwise something went wrong resynchronise */ \ - if(TimedOut) { \ - _SpektrumState.ReSync = 1; \ - /* next frame not expected sooner than 7ms */ \ - _SpektrumState.SpektrumTimer = MIN_FRAME_SPACE; \ - return; \ - } \ - \ - /* second character determines resolution and frame rate for main */ \ - /* receiver or low byte of LostFrameCount for secondary receiver */ \ - if(_SpektrumState.Sync == 1) { \ - if(_receiver) { \ - _SpektrumState.LostFrameCnt +=_c; \ - TmpExpFrames = ExpectedFrames; \ - } else { \ - /** @todo collect more data. I suspect that there is a low res */ \ - /* protocol that is still 10 bit but without using the full range. */\ - TmpEncType =(_c & 0x10)>>4; /* 0 = 10bit, 1 = 11 bit */\ - TmpExpFrames = _c & 0x03; /* 1 = 1 frame contains all channels */\ - /* 2 = 2 channel data in 2 frames */\ - } \ - _SpektrumState.Sync = 2; \ - _SpektrumState.SpektrumTimer = MAX_BYTE_SPACE; \ - return; \ - } \ - \ - /* high byte of channel data if this is the first byte */ \ - /* of channel data and the most significant bit is set */ \ - /* then this is the second frame of channel data. */ \ - if(_SpektrumState.Sync == 2) { \ - _SpektrumState.HighByte = _c; \ - if (_SpektrumState.ChannelCnt == 0) { \ - _SpektrumState.SecondFrame = (_SpektrumState.HighByte & 0x80) ? 1 : 0; \ - } \ - _SpektrumState.Sync = 3; \ - _SpektrumState.SpektrumTimer = MAX_BYTE_SPACE; \ - return; \ - } \ - \ - /* low byte of channel data */ \ - if(_SpektrumState.Sync == 3) { \ - _SpektrumState.Sync = 2; \ - _SpektrumState.SpektrumTimer = MAX_BYTE_SPACE; \ - /* we overwrite the buffer now so rc data is not available now */ \ - _SpektrumState.RcAvailable = 0; \ - ChannelData = ((uint16_t)_SpektrumState.HighByte << 8) | _c; \ - _SpektrumState.values[_SpektrumState.ChannelCnt \ - + (_SpektrumState.SecondFrame * 7)] = ChannelData; \ - _SpektrumState.ChannelCnt ++; \ - } \ - \ - /* If we have a whole frame */ \ - if(_SpektrumState.ChannelCnt >= SPEKTRUM_CHANNELS_PER_FRAME) { \ - /* how many frames did we expect ? */ \ - ++_SpektrumState.FrameCnt; \ - if (_SpektrumState.FrameCnt == TmpExpFrames) \ - { \ - /* set the rc_available_flag */ \ - _SpektrumState.RcAvailable = 1; \ - _SpektrumState.FrameCnt = 0; \ - } \ - if(!_receiver) { /* main receiver */ \ - EncodingType = TmpEncType; /* only update on a good */ \ - ExpectedFrames = TmpExpFrames; /* main receiver frame */ \ - } \ - _SpektrumState.Sync = 0; \ - _SpektrumState.ChannelCnt = 0; \ - _SpektrumState.SecondFrame = 0; \ - _SpektrumState.SpektrumTimer = MIN_FRAME_SPACE; \ - } \ -} \ +static inline void SpektrumParser(uint8_t _c, SpektrumStateType* spektrum_state, bool_t secondary_receiver) { + + uint16_t ChannelData; + uint8_t TimedOut; + static uint8_t TmpEncType = 0; /* 0 = 10bit, 1 = 11 bit */ + static uint8_t TmpExpFrames = 0; /* # of frames for channel data */ + + TimedOut = (!spektrum_state->SpektrumTimer) ? 1 : 0; + + /* If we have just started the resync process or */ + /* if we have recieved a character before our */ + /* 7ms wait has finished */ + if ((spektrum_state->ReSync == 1) || + ((spektrum_state->Sync == 0) && (!TimedOut))) { + + spektrum_state->ReSync = 0; + spektrum_state->SpektrumTimer = MIN_FRAME_SPACE; + spektrum_state->Sync = 0; + spektrum_state->ChannelCnt = 0; + spektrum_state->FrameCnt = 0; + spektrum_state->SecondFrame = 0; + return; + } + + /* the first byte of a new frame. It was received */ + /* more than 7ms after the last received byte. */ + /* It represents the number of lost frames so far.*/ + if (spektrum_state->Sync == 0) { + spektrum_state->LostFrameCnt = _c; + if(secondary_receiver) /* secondary receiver */ + spektrum_state->LostFrameCnt = spektrum_state->LostFrameCnt << 8; + spektrum_state->Sync = 1; + spektrum_state->SpektrumTimer = MAX_BYTE_SPACE; + return; + } + + /* all other bytes should be recieved within */ + /* MAX_BYTE_SPACE time of the last byte received */ + /* otherwise something went wrong resynchronise */ + if(TimedOut) { + spektrum_state->ReSync = 1; + /* next frame not expected sooner than 7ms */ + spektrum_state->SpektrumTimer = MIN_FRAME_SPACE; + return; + } + + /* second character determines resolution and frame rate for main */ + /* receiver or low byte of LostFrameCount for secondary receiver */ + if(spektrum_state->Sync == 1) { + if(secondary_receiver) { + spektrum_state->LostFrameCnt +=_c; + TmpExpFrames = ExpectedFrames; + } else { + /** @todo collect more data. I suspect that there is a low res */ + /* protocol that is still 10 bit but without using the full range. */ + TmpEncType =(_c & 0x10)>>4; /* 0 = 10bit, 1 = 11 bit */ + TmpExpFrames = _c & 0x03; /* 1 = 1 frame contains all channels */ + /* 2 = 2 channel data in 2 frames */ + } + spektrum_state->Sync = 2; + spektrum_state->SpektrumTimer = MAX_BYTE_SPACE; + return; + } + + /* high byte of channel data if this is the first byte */ + /* of channel data and the most significant bit is set */ + /* then this is the second frame of channel data. */ + if(spektrum_state->Sync == 2) { + spektrum_state->HighByte = _c; + if (spektrum_state->ChannelCnt == 0) { + spektrum_state->SecondFrame = (spektrum_state->HighByte & 0x80) ? 1 : 0; + } + spektrum_state->Sync = 3; + spektrum_state->SpektrumTimer = MAX_BYTE_SPACE; + return; + } + + /* low byte of channel data */ + if(spektrum_state->Sync == 3) { + spektrum_state->Sync = 2; + spektrum_state->SpektrumTimer = MAX_BYTE_SPACE; + /* we overwrite the buffer now so rc data is not available now */ + spektrum_state->RcAvailable = 0; + ChannelData = ((uint16_t)spektrum_state->HighByte << 8) | _c; + spektrum_state->values[spektrum_state->ChannelCnt + + (spektrum_state->SecondFrame * 7)] = ChannelData; + spektrum_state->ChannelCnt ++; + } + + /* If we have a whole frame */ + if(spektrum_state->ChannelCnt >= SPEKTRUM_CHANNELS_PER_FRAME) { + /* how many frames did we expect ? */ + ++spektrum_state->FrameCnt; + if (spektrum_state->FrameCnt == TmpExpFrames) + { + /* set the rc_available_flag */ + spektrum_state->RcAvailable = 1; + spektrum_state->FrameCnt = 0; + } + if(!secondary_receiver) { /* main receiver */ + EncodingType = TmpEncType; /* only update on a good */ + ExpectedFrames = TmpExpFrames; /* main receiver frame */ + } + spektrum_state->Sync = 0; + spektrum_state->ChannelCnt = 0; + spektrum_state->SecondFrame = 0; + spektrum_state->SpektrumTimer = MIN_FRAME_SPACE; + } +} /***************************************************************************** * @@ -467,7 +467,7 @@ void SpektrumTimerInit( void ) { /* TIM6 configuration */ timer_set_mode(TIM6, TIM_CR1_CKD_CK_INT, - TIM_CR1_CMS_EDGE, TIM_CR1_DIR_DOWN); + TIM_CR1_CMS_EDGE, TIM_CR1_DIR_DOWN); /* 100 microseconds ie 0.1 millisecond */ timer_set_period(TIM6, TIM_TICS_FOR_100us-1); timer_set_prescaler(TIM6, ((AHB_CLK / TIM_FREQ_1000000) - 1)); @@ -518,7 +518,7 @@ void SpektrumUartInit(void) { /* Init GPIOS */ /* Primary UART Rx pin as floating input */ gpio_set_mode(PrimaryUart(_BANK), GPIO_MODE_INPUT, - GPIO_CNF_INPUT_FLOAT, PrimaryUart(_PIN)); + GPIO_CNF_INPUT_FLOAT, PrimaryUart(_PIN)); PrimaryUart(_REMAP); @@ -583,7 +583,7 @@ void PrimaryUart(_ISR)(void) { if (((USART_CR1(PrimaryUart(_DEV)) & USART_CR1_RXNEIE) != 0) && ((USART_SR(PrimaryUart(_DEV)) & USART_SR_RXNE) != 0)) { uint8_t b = usart_recv(PrimaryUart(_DEV)); - SpektrumParser(b, PrimarySpektrumState, 0); + SpektrumParser(b, &PrimarySpektrumState, FALSE); } } @@ -605,7 +605,7 @@ void uart5_isr(void) { if (((USART_CR1(UART5) & USART_CR1_RXNEIE) != 0) && ((USART_SR(UART5) & USART_SR_RXNE) != 0)) { uint8_t b = usart_recv(UART5); - SpektrumParser(b, SecondarySpektrumState, 1); + SpektrumParser(b, &SecondarySpektrumState, TRUE); } } @@ -621,7 +621,7 @@ void DebugInit(void) { rcc_peripheral_enable_clock(&RCC_APB2ENR, RCC_APB2ENR_IOPCEN); gpio_set_mode(GPIOC, GPIO_MODE_OUTPUT_50_MHZ, - GPIO_CNF_OUTPUT_PUSHPULL, GPIO5); + GPIO_CNF_OUTPUT_PUSHPULL, GPIO5); gpio_clear(GPIOC, GPIO5); } @@ -648,7 +648,7 @@ void radio_control_spektrum_try_bind(void) { /* Init GPIO for the bind pin */ gpio_set(GPIOC, GPIO3); gpio_set_mode(GPIOC, GPIO_MODE_INPUT, - GPIO_CNF_INPUT_PULL_UPDOWN, GPIO3); + GPIO_CNF_INPUT_PULL_UPDOWN, GPIO3); /* exit if the BIND_PIN is high, it needs to be pulled low at startup to initiate bind */ if (gpio_get(GPIOC, GPIO3) != 0) @@ -662,7 +662,7 @@ void radio_control_spektrum_try_bind(void) { /* Master receiver Rx push-pull */ gpio_set_mode(PrimaryUart(_BANK), GPIO_MODE_OUTPUT_50_MHZ, - GPIO_CNF_OUTPUT_PUSHPULL, PrimaryUart(_PIN)); + GPIO_CNF_OUTPUT_PUSHPULL, PrimaryUart(_PIN)); /* Master receiver RX line, drive high */ gpio_set(PrimaryUart(_BANK), PrimaryUart(_PIN)); From 5a301aab32dabd434b7c997ca298f0455808ebbd Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 18 Feb 2013 19:42:26 +0000 Subject: [PATCH 032/109] Add centidegrees --- conf/units.xml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/conf/units.xml b/conf/units.xml index b15a514505..acfd74dff6 100644 --- a/conf/units.xml +++ b/conf/units.xml @@ -11,6 +11,8 @@ + + From b6e2d66d20da4eaf3f7d4dfa5519d41534d668e7 Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 18 Feb 2013 19:44:24 +0000 Subject: [PATCH 033/109] Add Aeroprobe On-The-Fly! air data computer interface --- conf/messages.xml | 9 +- conf/modules/airspeed_otf.xml | 20 +++ sw/airborne/modules/sensors/airspeed_otf.c | 162 +++++++++++++++++++++ sw/airborne/modules/sensors/airspeed_otf.h | 11 ++ sw/airborne/modules/sensors/met_module.h | 70 +++++++++ 5 files changed, 271 insertions(+), 1 deletion(-) create mode 100644 conf/modules/airspeed_otf.xml create mode 100644 sw/airborne/modules/sensors/airspeed_otf.c create mode 100644 sw/airborne/modules/sensors/airspeed_otf.h create mode 100644 sw/airborne/modules/sensors/met_module.h diff --git a/conf/messages.xml b/conf/messages.xml index b6ce932e59..fa4252a470 100644 --- a/conf/messages.xml +++ b/conf/messages.xml @@ -1495,7 +1495,14 @@ - + + + + + + + + diff --git a/conf/modules/airspeed_otf.xml b/conf/modules/airspeed_otf.xml new file mode 100644 index 0000000000..87e0d5ec0f --- /dev/null +++ b/conf/modules/airspeed_otf.xml @@ -0,0 +1,20 @@ + + + + + + +
+ + +
+ + + + + + + + + + diff --git a/sw/airborne/modules/sensors/airspeed_otf.c b/sw/airborne/modules/sensors/airspeed_otf.c new file mode 100644 index 0000000000..8a2048161d --- /dev/null +++ b/sw/airborne/modules/sensors/airspeed_otf.c @@ -0,0 +1,162 @@ +/* + * Copyright (C) 2013 Martin Mueller + * + * 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. + * + */ + +/** \file met_ap_otf.c + * \brief UART interface for Aeroprobe On-The-Fly! air data computer + * + */ + +#include +#include +#include +#include +#include +#include "mcu_periph/uart.h" +#include "messages.h" +#include "subsystems/datalink/downlink.h" + +#include "met_module.h" +#include "airspeed_otf.h" + +#ifndef DOWNLINK_DEVICE +#define DOWNLINK_DEVICE DOWNLINK_AP_DEVICE +#endif + +#define OTF_UNINIT 0x00 +#define OTF_WAIT_START OTF_UNINIT +#define OTF_WAIT_COUNTER 0x01 +#define OTF_WAIT_ANGLES 0x02 +#define OTF_WAIT_ALTITUDE 0x03 +#define OTF_WAIT_CHECKSUM 0x04 + +#define OTF_START 0x0A +#define OTF_LIMITER ',' +#define OTF_END 0x0D + +/* workaround for newlib */ +void* _sbrk(int); +void* _sbrk(int a) {return 0;} + +/* airspeed_otf_parse */ +void airspeed_otf_parse(char c) +{ + static unsigned char otf_status = OTF_UNINIT, otf_idx = 0, otf_crs_idx; + static char otf_inp[64]; + static unsigned int counter; + static short course[3]; + static unsigned int altitude; + static unsigned char checksum; + + switch (otf_status) { + + case OTF_WAIT_START: + if (c == OTF_START) { + otf_status++; + otf_idx = 0; + } else { + otf_status = OTF_UNINIT; + } + break; + + case OTF_WAIT_COUNTER: + if (isdigit((int)c)) { + if (otf_idx == 0) { +//FIXME otf_timestamp = getclock(); + } + otf_inp[otf_idx++] = c; + } else { + if ((otf_idx == 5) && (c == OTF_LIMITER)) { + otf_inp[otf_idx] = 0; + counter = atoi(otf_inp); + otf_idx = 0; + otf_crs_idx = 0; + otf_status++; + } else { + otf_status = OTF_UNINIT; + } + } + break; + + case OTF_WAIT_ANGLES: + if (isdigit((int)c) || (c == '-') || (c == '.')) { + otf_inp[otf_idx++] = c; + } else { + if ((otf_idx > 1) && (otf_idx < 9) && (c == OTF_LIMITER)) { + otf_inp[otf_idx] = 0; + course[otf_crs_idx] = (int16_t) (100. * atof(otf_inp)); + otf_idx = 0; + if (otf_crs_idx++ == 2) { + otf_status++; + } + } else { + otf_status = OTF_UNINIT; + } + } + break; + + case OTF_WAIT_ALTITUDE: + if (isdigit((int)c) || (c == '-') || (c == '.')) { + otf_inp[otf_idx++] = c; + } else { + if ((otf_idx > 1) && (otf_idx < 9) && (c == OTF_LIMITER)) { + otf_inp[otf_idx] = 0; + altitude = (int32_t) (100. * atof(otf_inp)); + otf_idx = 0; + otf_status++; + } else { + otf_status = OTF_UNINIT; + } + } + break; + + case OTF_WAIT_CHECKSUM: + if (isxdigit((int)c)) { + otf_inp[otf_idx++] = c; + } else { + if ((otf_idx == 2) && (c == OTF_END)) { + otf_inp[otf_idx] = 0; + checksum = strtol(otf_inp, NULL, 16); + otf_idx = 0; + DOWNLINK_SEND_FLOW_AP_OTF(DefaultChannel, DefaultDevice, &counter, &course[0], &course[1], &course[2], &altitude, &checksum); + } + otf_status = OTF_UNINIT; + } + break; + + default: + otf_status = OTF_UNINIT; + break; + } +} + +void airspeed_otf_init(void) { +} + +void airspeed_otf_event(void) { + while (MetLink(ChAvailable())) { + uint8_t ch = MetLink(Getch()); + airspeed_otf_parse(ch); + } +} + +void airspeed_otf_periodic(void) { +} diff --git a/sw/airborne/modules/sensors/airspeed_otf.h b/sw/airborne/modules/sensors/airspeed_otf.h new file mode 100644 index 0000000000..faec8eb92a --- /dev/null +++ b/sw/airborne/modules/sensors/airspeed_otf.h @@ -0,0 +1,11 @@ +#ifndef AIRSPEED_OTF_H +#define AIRSPEED_OTF_H + +#include "std.h" + +void airspeed_otf_parse(char c); +void airspeed_otf_init(void); +void airspeed_otf_event(void); +void airspeed_otf_periodic(void); + +#endif diff --git a/sw/airborne/modules/sensors/met_module.h b/sw/airborne/modules/sensors/met_module.h new file mode 100644 index 0000000000..c91f97b11b --- /dev/null +++ b/sw/airborne/modules/sensors/met_module.h @@ -0,0 +1,70 @@ +/* + * $Id$ + * + * Copyright (C) 2003 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. + * + */ + +/** \file met_module.h + * \brief Device independent serial meteo code + * +*/ + + +#ifndef MET_H +#define MET_H + +#include "std.h" +#include "led.h" + +extern volatile uint8_t ins_msg_received; +extern volatile uint8_t new_ins_attitude; + +#ifndef SITL +#include "mcu_periph/uart.h" + +#define __MetLink(dev, _x) dev##_x +#define _MetLink(dev, _x) __MetLink(dev, _x) +#define MetLink(_x) _MetLink(MET_LINK, _x) + +#define MetBuffer() MetLink(ChAvailable()) +#define ReadMetBuffer() { while (MetLink(ChAvailable())&&!met_msg_received) parse_met_buffer(MetLink(Getch())); } +#define MetSend1(c) MetLink(Transmit(c)) +#define MetUartSend1(c) MetSend1(c) +#define MetSend(_dat,_len) { for (uint8_t i = 0; i< (_len); i++) MetSend1(_dat[i]); }; +#define MetUartSetBaudrate(_b) MetLink(SetBaudrate(_b)) +#define MetUartRunning MetLink(TxRunning) + +#endif /** !SITL */ + +#define InsEventCheckAndHandle(handler) { \ + if (InsBuffer()) { \ + ReadInsBuffer(); \ + } \ + if (ins_msg_received) { \ + LED_TOGGLE(2); \ + parse_ins_msg(); \ + handler; \ + ins_msg_received = FALSE; \ + } \ + } + + +#endif /* MET_H */ From 051fa744abfe738d44fa4cea722658a6d7cd4ac4 Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 11 Mar 2013 22:26:23 +0000 Subject: [PATCH 034/109] naming foo --- conf/modules/airspeed_otf.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/conf/modules/airspeed_otf.xml b/conf/modules/airspeed_otf.xml index 87e0d5ec0f..7ee2919574 100644 --- a/conf/modules/airspeed_otf.xml +++ b/conf/modules/airspeed_otf.xml @@ -14,7 +14,7 @@ - + From 04a901c4a15132202ad521cb648db2534315b86e Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 12 Mar 2013 12:22:09 +0100 Subject: [PATCH 035/109] [modules] minor prettify --- conf/modules/imu_quality_assessment.xml | 11 ++++++----- conf/modules/mag_hmc5843.xml | 10 +++++----- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/conf/modules/imu_quality_assessment.xml b/conf/modules/imu_quality_assessment.xml index 20c0757b8c..0fc188f789 100644 --- a/conf/modules/imu_quality_assessment.xml +++ b/conf/modules/imu_quality_assessment.xml @@ -2,11 +2,12 @@ - Give comparable with IMU Health information: --saturation information --vibration level --magnetic field hard iron offset - + + Give comparable with IMU Health information. + - saturation information + - vibration level + - magnetic field hard iron offset +
diff --git a/conf/modules/mag_hmc5843.xml b/conf/modules/mag_hmc5843.xml index 9d7ac1b160..329c9257a2 100644 --- a/conf/modules/mag_hmc5843.xml +++ b/conf/modules/mag_hmc5843.xml @@ -12,11 +12,11 @@ - + - - - - + + + + From e6e0f64a696a542c5b19eba646ac531aac6a8dff Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Tue, 12 Mar 2013 12:52:45 +0100 Subject: [PATCH 036/109] care free mode for euler --- .../stabilization_attitude_rc_setpoint.c | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c index 72da8041e6..9acdde40ee 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c @@ -82,6 +82,24 @@ void stabilization_attitude_read_rc_setpoint_eulers(struct Int32Eulers *sp, bool } INT32_ANGLE_NORMALIZE(sp->psi); #endif + //Care Free mode + if (guidance_h_mode == GUIDANCE_H_MODE_CARE_FREE) { + //care_free_heading has been set to current psi when entering care free mode. + int32_t cos_psi; + int32_t sin_psi; + int32_t care_free_heading_i; + int32_t temp_theta; + + care_free_heading_i = ANGLE_BFP_OF_REAL(care_free_heading); + + PPRZ_ITRIG_SIN(sin_psi, sp->psi - care_free_heading_i); + PPRZ_ITRIG_COS(cos_psi, sp->psi - care_free_heading_i); + + temp_theta = INT_MULT_RSHIFT(cos_psi, sp->theta, INT32_ANGLE_FRAC) - INT_MULT_RSHIFT(sin_psi, sp->phi, INT32_ANGLE_FRAC); + sp->phi = INT_MULT_RSHIFT(cos_psi, sp->phi, INT32_ANGLE_FRAC) - INT_MULT_RSHIFT(sin_psi, sp->theta, INT32_ANGLE_FRAC); + + sp->theta = temp_theta; + } } else { /* if not flying, use current yaw as setpoint */ sp->psi = stateGetNedToBodyEulers_i()->psi; @@ -112,6 +130,21 @@ void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bo FLOAT_ANGLE_NORMALIZE(sp->psi); #endif } + //Care Free mode + if (guidance_h_mode == GUIDANCE_H_MODE_CARE_FREE) { + //care_free_heading has been set to current psi when entering care free mode. + float cos_psi; + float sin_psi; + float temp_theta; + + sin_psi = sin(sp->psi - care_free_heading); + cos_psi = cos(sp->psi - care_free_heading); + + temp_theta = cos_psi*sp->theta - sin_psi*sp->phi; + sp->phi = cos_psi*sp->phi - sin_psi*sp->theta; + + sp->theta = temp_theta; + } else { /* if not flying, use current yaw as setpoint */ sp->psi = stateGetNedToBodyEulers_f()->psi; } From 42ed97ffaa6ab59bc5210b11d82eca559cb6efab Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Tue, 12 Mar 2013 13:13:47 +0100 Subject: [PATCH 037/109] removed todo euler care free --- .../stabilization/stabilization_attitude_rc_setpoint.c | 1 - 1 file changed, 1 deletion(-) diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c index 9acdde40ee..4350c9a424 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c @@ -54,7 +54,6 @@ void stabilization_attitude_reset_care_free_heading(void) { } /** Read attitude setpoint from RC as euler angles. - * @todo implement care_free_heading as in quaternion setpoint... * @param[in] in_flight true if in flight * @param[out] sp attitude setpoint as euler angles */ From c5db1ddbb5d94edefd3ed79de3b1933517087f6a Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Tue, 12 Mar 2013 13:35:48 +0100 Subject: [PATCH 038/109] improved care free euler --- .../stabilization_attitude_rc_setpoint.c | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c index 4350c9a424..31a7f0921e 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c @@ -86,13 +86,15 @@ void stabilization_attitude_read_rc_setpoint_eulers(struct Int32Eulers *sp, bool //care_free_heading has been set to current psi when entering care free mode. int32_t cos_psi; int32_t sin_psi; - int32_t care_free_heading_i; int32_t temp_theta; + int32_t care_free_delta_psi_i; - care_free_heading_i = ANGLE_BFP_OF_REAL(care_free_heading); + care_free_delta_psi_i = sp->psi - ANGLE_BFP_OF_REAL(care_free_heading); - PPRZ_ITRIG_SIN(sin_psi, sp->psi - care_free_heading_i); - PPRZ_ITRIG_COS(cos_psi, sp->psi - care_free_heading_i); + INT32_ANGLE_NORMALIZE(care_free_delta_psi_i); + + PPRZ_ITRIG_SIN(sin_psi, care_free_delta_psi_i); + PPRZ_ITRIG_COS(cos_psi, care_free_delta_psi_i); temp_theta = INT_MULT_RSHIFT(cos_psi, sp->theta, INT32_ANGLE_FRAC) - INT_MULT_RSHIFT(sin_psi, sp->phi, INT32_ANGLE_FRAC); sp->phi = INT_MULT_RSHIFT(cos_psi, sp->phi, INT32_ANGLE_FRAC) - INT_MULT_RSHIFT(sin_psi, sp->theta, INT32_ANGLE_FRAC); @@ -136,8 +138,12 @@ void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bo float sin_psi; float temp_theta; - sin_psi = sin(sp->psi - care_free_heading); - cos_psi = cos(sp->psi - care_free_heading); + float care_free_delta_psi_f = sp->psi - care_free_heading; + + FLOAT_ANGLE_NORMALIZE(care_free_delta_psi_f); + + sin_psi = sin(care_free_delta_psi_f); + cos_psi = cos(care_free_delta_psi_f); temp_theta = cos_psi*sp->theta - sin_psi*sp->phi; sp->phi = cos_psi*sp->phi - sin_psi*sp->theta; From b4ff04270619c5ec55e782a43603b09d31d4b9f8 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 12 Mar 2013 14:09:17 +0100 Subject: [PATCH 039/109] [settings/gcs] save and display settings as integer if step is integer close #381 --- sw/ground_segment/cockpit/page_settings.ml | 3 ++- sw/ground_segment/cockpit/saveSettings.ml | 9 +++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml index 9c5bcf8517..47f10c35ec 100644 --- a/sw/ground_segment/cockpit/page_settings.ml +++ b/sw/ground_segment/cockpit/page_settings.ml @@ -73,6 +73,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin fprintf stderr "Warning: 'step' attribute missing in '%s' setting. Default to 1\n%!" (Xml.to_string dl_setting); 1. in + let digits = try ignore(int_of_string (ExtXml.attrib dl_setting "step")); 0 with _ -> 3 in let page_incr = step_incr and page_size = step_incr and show_auto = try ExtXml.attrib dl_setting "auto" = "true" with _ -> false in @@ -135,7 +136,7 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin else (* slider *) let value = (lower +. upper) /. 2. in let adj = GData.adjustment ~value ~lower ~upper:(upper+.step_incr) ~step_incr ~page_incr ~page_size () in - let _scale = GRange.scale `HORIZONTAL ~digits:3 ~update_policy:`DELAYED ~adjustment:adj ~packing:hbox#add () in + let _scale = GRange.scale `HORIZONTAL ~digits ~update_policy:`DELAYED ~adjustment:adj ~packing:hbox#add () in let f = fun _ -> do_change i ((adj#value-.alt_b)/.alt_a) in let callback = fun () -> modified := true; if auto_but#active then f () in ignore (adj#connect#value_changed ~callback); diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index add02f68a0..69705fc6e8 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -33,6 +33,7 @@ and col_settings_value = cols#add Gobject.Data.float and col_airframe_value_new = cols#add Gobject.Data.float and col_code_value = cols#add Gobject.Data.float and col_to_save = cols#add Gobject.Data.boolean +and col_integer = cols#add Gobject.Data.boolean let (//) = Filename.concat @@ -94,7 +95,8 @@ let write_xml = fun (model:GTree.tree_store) old_file airframe_xml file -> if model#get ~row ~column:col_to_save then begin let new_value = model#get ~row ~column:col_airframe_value_new and param = model#get ~row ~column:col_param in - new_xml := EditAirframe.set !new_xml param (string_of_float new_value) + let string_value = if model#get ~row ~column:col_integer then string_of_int (truncate new_value) else string_of_float new_value in + new_xml := EditAirframe.set !new_xml param string_value end; false); if old_file = file then begin @@ -171,6 +173,8 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> Failure "float_of_string" -> raise (EditAirframe.No_param param) in let airframe_value_new = value /. airframe_scale in + (* test if is has to be saved as integer or float *) + let integer = try ignore(int_of_string (attrib "step")); true with _ -> false in (* Printf.fprintf stderr "param %s: airframe_scale=%f display_scale=%f extra_scale=%f\n" param airframe_scale display_scale extra_scale; flush stderr; *) let row = model#append () in model#set ~row ~column:col_index index; @@ -179,7 +183,8 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> model#set ~row ~column:col_settings_value (value *. display_scale); model#set ~row ~column:col_airframe_value_new airframe_value_new; model#set ~row ~column:col_code_value value; - model#set ~row ~column:col_to_save (floats_not_equal airframe_value_scaled value) + model#set ~row ~column:col_to_save (floats_not_equal airframe_value_scaled value); + model#set ~row ~column:col_integer integer with Xml.No_attribute _ | Exit -> () | EditAirframe.No_param param -> From 7ed9a3adcca0c9ad68c34ad0961f7b8494151252 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 12 Mar 2013 14:29:50 +0100 Subject: [PATCH 040/109] [sonar] some fix for sonar module sonar_scale is now a float in m/adc --- sw/airborne/modules/sonar/sonar_adc.c | 28 +++++++++++++++++---------- sw/airborne/modules/sonar/sonar_adc.h | 14 ++++++++++---- 2 files changed, 28 insertions(+), 14 deletions(-) diff --git a/sw/airborne/modules/sonar/sonar_adc.c b/sw/airborne/modules/sonar/sonar_adc.c index e828670c3d..96672c573e 100644 --- a/sw/airborne/modules/sonar/sonar_adc.c +++ b/sw/airborne/modules/sonar/sonar_adc.c @@ -1,5 +1,4 @@ /* - * * Copyright (C) 2010 Gautier Hattenberger, 2013 Tobias Münch * * This file is part of paparazzi. @@ -22,28 +21,39 @@ */ #include "modules/sonar/sonar_adc.h" +#include "generated/airframe.h" #include "mcu_periph/adc.h" -#include "subsystems/datalink/downlink.h" #ifdef SITL -#include "subsystems/gps.h" +#include "state.h" #endif +#include "mcu_periph/uart.h" +#include "messages.h" +#include "subsystems/datalink/downlink.h" #ifndef DOWNLINK_DEVICE #define DOWNLINK_DEVICE DOWNLINK_AP_DEVICE #endif +/** Sonar offset. + * Offset value in m (float) + * equals to the height when the ADC gives 0 + */ #ifndef SONAR_OFFSET -#define SONAR_OFFSET 0 +#define SONAR_OFFSET 0. #endif + +/** Sonar scale. + * Sensor sensitivity in m/adc (float) + */ #ifndef SONAR_SCALE -#define SONAR_SCALE 166 +#define SONAR_SCALE 0.0166 #endif uint16_t sonar_meas; bool_t sonar_data_available; float sonar_distance; float sonar_offset; -uint16_t sonar_scale; +float sonar_scale; #ifndef SITL static struct adc_buf sonar_adc; @@ -67,12 +77,10 @@ void sonar_adc_read(void) { #ifndef SITL sonar_meas = sonar_adc.sum / sonar_adc.av_nb_sample; sonar_data_available = TRUE; -//sonar_offset in cm, sonar_distance in m! - sonar_distance = ((float)sonar_meas * (float)sonar_scale) / 10000 + sonar_offset; + sonar_distance = ((float)sonar_meas * sonar_scale) + sonar_offset; #else // SITL - sonar_distance = (gps.hmsl / 1000.0) - ground_alt; - //sonar_meas = (sonar_distance - sonar_offset / (sonar_scale / 1000); + sonar_distance = stateGetPositionEnu_f()->z; Bound(sonar_distance, 0.1f, 7.0f); #endif // SITL diff --git a/sw/airborne/modules/sonar/sonar_adc.h b/sw/airborne/modules/sonar/sonar_adc.h index bf66d5e0e9..ec5a8c06cb 100644 --- a/sw/airborne/modules/sonar/sonar_adc.h +++ b/sw/airborne/modules/sonar/sonar_adc.h @@ -1,5 +1,4 @@ /* - * * Copyright (C) 2010 Gautier Hattenberger * * This file is part of paparazzi. @@ -21,9 +20,8 @@ * */ -/** \file sonar_maxbotix.h - * - * simple driver to deal with one maxbotix sensor +/** @file sonar_adc.h + * @brief simple driver to deal with one sonar sensor on ADC */ #ifndef SONAR_ADC_H @@ -31,8 +29,16 @@ #include "std.h" +/** Raw ADC value. + */ extern uint16_t sonar_meas; + +/** New data available. + */ extern bool_t sonar_data_available; + +/** Sonar distance in m. + */ extern float sonar_distance; extern void sonar_adc_init(void); From cb35c0a528075072a7e089e8f7b09f2c238682a1 Mon Sep 17 00:00:00 2001 From: Ewoud Smeur Date: Tue, 12 Mar 2013 22:35:45 +0100 Subject: [PATCH 041/109] fixed misplaced brace --- .../stabilization_attitude_rc_setpoint.c | 28 +++++++++---------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c index 31a7f0921e..95f236e09c 100644 --- a/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c +++ b/sw/airborne/firmwares/rotorcraft/stabilization/stabilization_attitude_rc_setpoint.c @@ -130,25 +130,25 @@ void stabilization_attitude_read_rc_setpoint_eulers_f(struct FloatEulers *sp, bo } FLOAT_ANGLE_NORMALIZE(sp->psi); #endif - } - //Care Free mode - if (guidance_h_mode == GUIDANCE_H_MODE_CARE_FREE) { - //care_free_heading has been set to current psi when entering care free mode. - float cos_psi; - float sin_psi; - float temp_theta; + //Care Free mode + if (guidance_h_mode == GUIDANCE_H_MODE_CARE_FREE) { + //care_free_heading has been set to current psi when entering care free mode. + float cos_psi; + float sin_psi; + float temp_theta; - float care_free_delta_psi_f = sp->psi - care_free_heading; + float care_free_delta_psi_f = sp->psi - care_free_heading; - FLOAT_ANGLE_NORMALIZE(care_free_delta_psi_f); + FLOAT_ANGLE_NORMALIZE(care_free_delta_psi_f); - sin_psi = sin(care_free_delta_psi_f); - cos_psi = cos(care_free_delta_psi_f); + sin_psi = sin(care_free_delta_psi_f); + cos_psi = cos(care_free_delta_psi_f); - temp_theta = cos_psi*sp->theta - sin_psi*sp->phi; - sp->phi = cos_psi*sp->phi - sin_psi*sp->theta; + temp_theta = cos_psi*sp->theta - sin_psi*sp->phi; + sp->phi = cos_psi*sp->phi - sin_psi*sp->theta; - sp->theta = temp_theta; + sp->theta = temp_theta; + } } else { /* if not flying, use current yaw as setpoint */ sp->psi = stateGetNedToBodyEulers_f()->psi; From f83efcbba7b79010a191652f4267c6b069fdb02f Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 12 Mar 2013 23:32:19 +0100 Subject: [PATCH 042/109] [gcs] display settings to be saved as integer with correct format --- sw/ground_segment/cockpit/saveSettings.ml | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index 69705fc6e8..6bade089ca 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -28,9 +28,9 @@ module U = Unix let cols = new GTree.column_list let col_index = cols#add Gobject.Data.int let col_param = cols#add Gobject.Data.string -and col_airframe_value = cols#add Gobject.Data.float -and col_settings_value = cols#add Gobject.Data.float -and col_airframe_value_new = cols#add Gobject.Data.float +and col_airframe_value = cols#add Gobject.Data.string +and col_settings_value = cols#add Gobject.Data.string +and col_airframe_value_new = cols#add Gobject.Data.string and col_code_value = cols#add Gobject.Data.float and col_to_save = cols#add Gobject.Data.boolean and col_integer = cols#add Gobject.Data.boolean @@ -95,8 +95,7 @@ let write_xml = fun (model:GTree.tree_store) old_file airframe_xml file -> if model#get ~row ~column:col_to_save then begin let new_value = model#get ~row ~column:col_airframe_value_new and param = model#get ~row ~column:col_param in - let string_value = if model#get ~row ~column:col_integer then string_of_int (truncate new_value) else string_of_float new_value in - new_xml := EditAirframe.set !new_xml param string_value + new_xml := EditAirframe.set !new_xml param new_value end; false); if old_file = file then begin @@ -179,9 +178,15 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> let row = model#append () in model#set ~row ~column:col_index index; model#set ~row ~column:col_param param; - model#set ~row ~column:col_airframe_value (airframe_value_scaled *. display_scale); - model#set ~row ~column:col_settings_value (value *. display_scale); - model#set ~row ~column:col_airframe_value_new airframe_value_new; + model#set ~row ~column:col_airframe_value (string_of_float (airframe_value_scaled *. display_scale)); + if integer then begin + model#set ~row ~column:col_settings_value (string_of_int (truncate (value *. display_scale +. 0.5))); + model#set ~row ~column:col_airframe_value_new (string_of_int (truncate (airframe_value_new +. 0.5))) + end + else begin + model#set ~row ~column:col_settings_value (string_of_float (value *. display_scale)); + model#set ~row ~column:col_airframe_value_new (string_of_float airframe_value_new) + end; model#set ~row ~column:col_code_value value; model#set ~row ~column:col_to_save (floats_not_equal airframe_value_scaled value); model#set ~row ~column:col_integer integer From 82cc142159284eb22ba64b6647cb202afc86d098 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 12 Mar 2013 23:59:13 +0100 Subject: [PATCH 043/109] [gcs][settings] nicer popup warning about parameters not in the airframe file --- sw/ground_segment/cockpit/saveSettings.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index 6bade089ca..efd6166892 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -198,7 +198,7 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> (* Warning if needed *) if !not_in_airframe_file <> [] then begin - GToolbox.message_box ~title:"Warning" (Printf.sprintf "Parameter(s) '%s' not writable in the airframe file" (String.concat "," !not_in_airframe_file)); + GToolbox.message_box ~title:"Warning" (Printf.sprintf "Some parameters not writable in the airframe file:\n\n%s" (String.concat "\n" !not_in_airframe_file)); end From bfaece887343c1fc292c0e88ede5fed639736ac3 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Wed, 13 Mar 2013 00:35:11 +0100 Subject: [PATCH 044/109] [gcs] fix rounding of values --- sw/ground_segment/cockpit/saveSettings.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index efd6166892..5b3862c10a 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -180,8 +180,8 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> model#set ~row ~column:col_param param; model#set ~row ~column:col_airframe_value (string_of_float (airframe_value_scaled *. display_scale)); if integer then begin - model#set ~row ~column:col_settings_value (string_of_int (truncate (value *. display_scale +. 0.5))); - model#set ~row ~column:col_airframe_value_new (string_of_int (truncate (airframe_value_new +. 0.5))) + model#set ~row ~column:col_settings_value (string_of_int (truncate (floor (value *. display_scale +. 0.5)))); + model#set ~row ~column:col_airframe_value_new (string_of_int (truncate (floor (airframe_value_new +. 0.5)))) end else begin model#set ~row ~column:col_settings_value (string_of_float (value *. display_scale)); From fae59a533b9b9ac34e257c9a7aa8753e2b75f0bd Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 13 Mar 2013 00:44:48 +0100 Subject: [PATCH 045/109] [modules] fix sonar_adc doc --- conf/modules/sonar_adc.xml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/conf/modules/sonar_adc.xml b/conf/modules/sonar_adc.xml index 575812fac2..d477c56c96 100644 --- a/conf/modules/sonar_adc.xml +++ b/conf/modules/sonar_adc.xml @@ -7,8 +7,8 @@ output - Sonar_distance in [m] - - + +
From dc8d16931aebd3d9861a21bd7b37ed899f3eefcc Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 13 Mar 2013 22:31:56 +0100 Subject: [PATCH 046/109] [stm32] throw an error if trying to USE_I2C0 --- sw/airborne/arch/stm32/mcu_periph/i2c_arch.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sw/airborne/arch/stm32/mcu_periph/i2c_arch.c b/sw/airborne/arch/stm32/mcu_periph/i2c_arch.c index 7bb8a3a63c..16c96f46f7 100644 --- a/sw/airborne/arch/stm32/mcu_periph/i2c_arch.c +++ b/sw/airborne/arch/stm32/mcu_periph/i2c_arch.c @@ -859,6 +859,10 @@ I2C_SoftwareResetCmd(periph->reg_addr, DISABLE); */ +#ifdef USE_I2C0 +#error "The STM32 doesn't have I2C0, use I2C1 or I2C2" +#endif + #ifdef USE_I2C1 /** default I2C1 clock speed */ From bb0c69e6ce9c1e2d792ef9bd8e7ba21b50b66e34 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 14 Mar 2013 14:51:35 +0100 Subject: [PATCH 047/109] [i2c] convenience functions return i2c_submit success --- sw/airborne/mcu_periph/i2c.c | 12 ++++++------ sw/airborne/mcu_periph/i2c.h | 14 ++++++++------ 2 files changed, 14 insertions(+), 12 deletions(-) diff --git a/sw/airborne/mcu_periph/i2c.c b/sw/airborne/mcu_periph/i2c.c index d01c143638..897278d41c 100644 --- a/sw/airborne/mcu_periph/i2c.c +++ b/sw/airborne/mcu_periph/i2c.c @@ -69,32 +69,32 @@ void i2c_init(struct i2c_periph* p) { } -void i2c_transmit(struct i2c_periph* p, struct i2c_transaction* t, +bool_t i2c_transmit(struct i2c_periph* p, struct i2c_transaction* t, uint8_t s_addr, uint8_t len) { t->type = I2CTransTx; t->slave_addr = s_addr; t->len_w = len; t->len_r = 0; - i2c_submit(p, t); + return i2c_submit(p, t); } -void i2c_receive(struct i2c_periph* p, struct i2c_transaction* t, +bool_t i2c_receive(struct i2c_periph* p, struct i2c_transaction* t, uint8_t s_addr, uint16_t len) { t->type = I2CTransRx; t->slave_addr = s_addr; t->len_w = 0; t->len_r = len; - i2c_submit(p, t); + return i2c_submit(p, t); } -void i2c_transceive(struct i2c_periph* p, struct i2c_transaction* t, +bool_t i2c_transceive(struct i2c_periph* p, struct i2c_transaction* t, uint8_t s_addr, uint8_t len_w, uint16_t len_r) { t->type = I2CTransTxRx; t->slave_addr = s_addr; t->len_w = len_w; t->len_r = len_r; - i2c_submit(p, t); + return i2c_submit(p, t); } diff --git a/sw/airborne/mcu_periph/i2c.h b/sw/airborne/mcu_periph/i2c.h index 71ce56d095..6b22b0e9a9 100644 --- a/sw/airborne/mcu_periph/i2c.h +++ b/sw/airborne/mcu_periph/i2c.h @@ -176,15 +176,17 @@ extern void i2c_event(void); * Convenience functions. * Usually these are preferred over i2c_submit, * as they explicitly set the transaction type again. + * + * Return FALSE if submitting the transaction failed. */ -extern void i2c_transmit(struct i2c_periph* p, struct i2c_transaction* t, - uint8_t s_addr, uint8_t len); +extern bool_t i2c_transmit(struct i2c_periph* p, struct i2c_transaction* t, + uint8_t s_addr, uint8_t len); -extern void i2c_receive(struct i2c_periph* p, struct i2c_transaction* t, - uint8_t s_addr, uint16_t len); +extern bool_t i2c_receive(struct i2c_periph* p, struct i2c_transaction* t, + uint8_t s_addr, uint16_t len); -extern void i2c_transceive(struct i2c_periph* p, struct i2c_transaction* t, - uint8_t s_addr, uint8_t len_w, uint16_t len_r); +extern bool_t i2c_transceive(struct i2c_periph* p, struct i2c_transaction* t, + uint8_t s_addr, uint8_t len_w, uint16_t len_r); /** @}*/ /** @}*/ From 7f79a51224b4de4df82033fcabc349abae5de8ec Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Thu, 14 Mar 2013 16:35:45 +0100 Subject: [PATCH 048/109] [xsens] Commenting --- sw/airborne/modules/ins/ins_xsens.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/sw/airborne/modules/ins/ins_xsens.c b/sw/airborne/modules/ins/ins_xsens.c index 1cedb9e8ea..13fd1c0e90 100644 --- a/sw/airborne/modules/ins/ins_xsens.c +++ b/sw/airborne/modules/ins/ins_xsens.c @@ -46,26 +46,32 @@ bool_t gps_xsens_msg_available; #endif +// positions INS_FORMAT ins_x; INS_FORMAT ins_y; INS_FORMAT ins_z; +// velocities INS_FORMAT ins_vx; INS_FORMAT ins_vy; INS_FORMAT ins_vz; +// body angles INS_FORMAT ins_phi; INS_FORMAT ins_theta; INS_FORMAT ins_psi; +// angle rates INS_FORMAT ins_p; INS_FORMAT ins_q; INS_FORMAT ins_r; +// accelerations INS_FORMAT ins_ax; INS_FORMAT ins_ay; INS_FORMAT ins_az; +// magnetic INS_FORMAT ins_mx; INS_FORMAT ins_my; INS_FORMAT ins_mz; From a650e1e436f92ec3e29915435fd3ac2fac398c1e Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 16 Mar 2013 02:13:13 +0100 Subject: [PATCH 049/109] [actuators] mkk: if submit fails, start at last one next time --- .../subsystems/actuators/actuators_mkk.c | 26 ++++++++++++++----- .../subsystems/actuators/actuators_mkk.h | 1 + 2 files changed, 21 insertions(+), 6 deletions(-) diff --git a/sw/airborne/subsystems/actuators/actuators_mkk.c b/sw/airborne/subsystems/actuators/actuators_mkk.c index 4064e64fb4..2541bc6bd3 100644 --- a/sw/airborne/subsystems/actuators/actuators_mkk.c +++ b/sw/airborne/subsystems/actuators/actuators_mkk.c @@ -33,25 +33,39 @@ struct ActuatorsMkk actuators_mkk; void actuators_mkk_init(void) { + actuators_mkk.submit_err_cnt = 0; } void actuators_mkk_set(void) { const uint8_t actuators_addr[ACTUATORS_MKK_NB] = ACTUATORS_MKK_ADDR; + static uint8_t last_idx = ACTUATORS_MKK_NB; #if defined ACTUATORS_START_DELAY && ! defined SITL if (!actuators_delay_done) { - if (SysTimeTimer(actuators_delay_time) < USEC_OF_SEC(ACTUATORS_START_DELAY)) return; - else actuators_delay_done = TRUE; + if (SysTimeTimer(actuators_delay_time) < USEC_OF_SEC(ACTUATORS_START_DELAY)) + return; + else + actuators_delay_done = TRUE; } #endif + uint8_t cur_idx = last_idx; for (uint8_t i=0; i= ACTUATORS_MKK_NB) { + cur_idx = 0; + } #ifdef KILL_MOTORS - actuators_mkk.trans[i].buf[0] = 0; + actuators_mkk.trans[cur_idx].buf[0] = 0; #endif - - i2c_transmit(&ACTUATORS_MKK_DEVICE, &actuators_mkk.trans[i], actuators_addr[i], 1); + if (!i2c_transmit(&ACTUATORS_MKK_DEVICE, &actuators_mkk.trans[cur_idx], + actuators_addr[cur_idx], 1)) { + actuators_mkk.submit_err_cnt++; + last_idx = cur_idx; + return; + } + cur_idx++; } + /* successfully submitted all transactions */ + last_idx = ACTUATORS_MKK_NB; } diff --git a/sw/airborne/subsystems/actuators/actuators_mkk.h b/sw/airborne/subsystems/actuators/actuators_mkk.h index e90a2ecae8..9574b19282 100644 --- a/sw/airborne/subsystems/actuators/actuators_mkk.h +++ b/sw/airborne/subsystems/actuators/actuators_mkk.h @@ -34,6 +34,7 @@ struct ActuatorsMkk { struct i2c_transaction trans[ACTUATORS_MKK_NB]; + uint16_t submit_err_cnt; }; extern struct ActuatorsMkk actuators_mkk; From 7f899b5ef6b206bb403f7d5a266bc7436802d2ce Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 16 Mar 2013 14:15:49 +0100 Subject: [PATCH 050/109] [sim] don't include ocaml stuff for jsbsim target --- conf/firmwares/subsystems/fixedwing/autopilot.makefile | 2 +- sw/airborne/arch/sim/subsystems/radio_control/ppm_arch.c | 4 ++-- sw/airborne/subsystems/ahrs/ahrs_sim.c | 3 --- 3 files changed, 3 insertions(+), 6 deletions(-) diff --git a/conf/firmwares/subsystems/fixedwing/autopilot.makefile b/conf/firmwares/subsystems/fixedwing/autopilot.makefile index 309581e472..f15c206c9f 100644 --- a/conf/firmwares/subsystems/fixedwing/autopilot.makefile +++ b/conf/firmwares/subsystems/fixedwing/autopilot.makefile @@ -234,7 +234,7 @@ endif jsbsim.CFLAGS += $(fbw_CFLAGS) $(ap_CFLAGS) jsbsim.srcs += $(fbw_srcs) $(ap_srcs) -jsbsim.CFLAGS += -DSITL +jsbsim.CFLAGS += -DSITL -DUSE_JSBSIM jsbsim.srcs += $(SIMDIR)/sim_ac_jsbsim.c $(SIMDIR)/sim_ac_fw.c $(SIMDIR)/sim_ac_flightgear.c # external libraries diff --git a/sw/airborne/arch/sim/subsystems/radio_control/ppm_arch.c b/sw/airborne/arch/sim/subsystems/radio_control/ppm_arch.c index c52ec9437f..ce8235f6ee 100644 --- a/sw/airborne/arch/sim/subsystems/radio_control/ppm_arch.c +++ b/sw/airborne/arch/sim/subsystems/radio_control/ppm_arch.c @@ -27,7 +27,7 @@ #if USE_NPS #include "nps_radio_control.h" -#else +#elif !USE_JSBSIM #include #endif @@ -74,7 +74,7 @@ void radio_control_feed(void) { void radio_control_feed(void) {} #endif //RADIO_CONTROL -#else //!USE_NPS +#elif !USE_JSBSIM // not NPS and not JSBSIM -> simple ocaml sim #ifdef RADIO_CONTROL value update_rc_channel(value c, value v) { ppm_pulses[Int_val(c)] = Double_val(v); diff --git a/sw/airborne/subsystems/ahrs/ahrs_sim.c b/sw/airborne/subsystems/ahrs/ahrs_sim.c index 3c3b0df5fa..b5f6bc11cf 100644 --- a/sw/airborne/subsystems/ahrs/ahrs_sim.c +++ b/sw/airborne/subsystems/ahrs/ahrs_sim.c @@ -31,9 +31,6 @@ #include "math/pprz_algebra_float.h" #include "generated/airframe.h" -#include -#include - extern float sim_phi; extern float sim_theta; extern float sim_psi; From 771d59f05404e0bd2c8c67599a12d270526a3f6f Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 18 Mar 2013 14:53:02 +0100 Subject: [PATCH 051/109] [rotorcraft] AHRS_EULER_INT message only for CMPL_EULER --- sw/airborne/firmwares/rotorcraft/telemetry.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sw/airborne/firmwares/rotorcraft/telemetry.h b/sw/airborne/firmwares/rotorcraft/telemetry.h index 208aae300c..9298c1dd16 100644 --- a/sw/airborne/firmwares/rotorcraft/telemetry.h +++ b/sw/airborne/firmwares/rotorcraft/telemetry.h @@ -464,6 +464,7 @@ &(stateGetNedToBodyQuat_i()->qz)); \ } +#if USE_AHRS_CMPL_EULER #define PERIODIC_SEND_AHRS_EULER_INT(_trans, _dev) { \ DOWNLINK_SEND_AHRS_EULER_INT(_trans, _dev, \ &ahrs_impl.ltp_to_imu_euler.phi, \ @@ -473,6 +474,9 @@ &(stateGetNedToBodyEulers_i()->theta), \ &(stateGetNedToBodyEulers_i()->psi)); \ } +#else +#define PERIODIC_SEND_AHRS_EULER_INT(_trans, _dev) {} +#endif #define PERIODIC_SEND_AHRS_RMAT_INT(_trans, _dev) { \ struct Int32RMat* att_rmat = stateGetNedToBodyRMat_i(); \ From c9b3c9c91f456ec47361afaca2a50b81792d338e Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Mon, 18 Mar 2013 16:58:47 +0100 Subject: [PATCH 052/109] suppress compilation warning for px4flow --- conf/airframes/ENAC/quadrotor/booz2_g1.xml | 10 +++++----- conf/airframes/ENAC/quadrotor/hen1.xml | 17 +++++++++++------ sw/airborne/modules/optical_flow/px4flow.c | 2 +- 3 files changed, 17 insertions(+), 12 deletions(-) diff --git a/conf/airframes/ENAC/quadrotor/booz2_g1.xml b/conf/airframes/ENAC/quadrotor/booz2_g1.xml index cc8f78e1f7..275f05fe4b 100644 --- a/conf/airframes/ENAC/quadrotor/booz2_g1.xml +++ b/conf/airframes/ENAC/quadrotor/booz2_g1.xml @@ -3,17 +3,17 @@ - + - + @@ -41,9 +41,9 @@ - + diff --git a/conf/airframes/ENAC/quadrotor/hen1.xml b/conf/airframes/ENAC/quadrotor/hen1.xml index 2fe0d7e579..fdcc63192f 100644 --- a/conf/airframes/ENAC/quadrotor/hen1.xml +++ b/conf/airframes/ENAC/quadrotor/hen1.xml @@ -3,6 +3,11 @@ + + + + + @@ -29,9 +34,9 @@ - + @@ -164,12 +169,12 @@ - - + + - - + + diff --git a/sw/airborne/modules/optical_flow/px4flow.c b/sw/airborne/modules/optical_flow/px4flow.c index 01608bc862..345ed01b0b 100644 --- a/sw/airborne/modules/optical_flow/px4flow.c +++ b/sw/airborne/modules/optical_flow/px4flow.c @@ -42,7 +42,7 @@ bool_t optical_flow_available; struct mavlink_msg_req req; // callback function on message reception -static void decode_optical_flow_msg(struct mavlink_message * msg) { +static void decode_optical_flow_msg(struct mavlink_message * msg __attribute__ ((unused))) { optical_flow_available = TRUE; } From 61f0c39f791af48e1a0c60af740b34f8f9b340d9 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 18 Mar 2013 17:58:15 +0100 Subject: [PATCH 053/109] [ahrs] remove ltp_to_imu_euler from int_cmpl_quat --- sw/airborne/firmwares/rotorcraft/telemetry.h | 12 +++++++++++- sw/airborne/subsystems/ahrs/ahrs_int_cmpl_quat.h | 1 - 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/telemetry.h b/sw/airborne/firmwares/rotorcraft/telemetry.h index 9298c1dd16..4e35e77dbc 100644 --- a/sw/airborne/firmwares/rotorcraft/telemetry.h +++ b/sw/airborne/firmwares/rotorcraft/telemetry.h @@ -475,7 +475,17 @@ &(stateGetNedToBodyEulers_i()->psi)); \ } #else -#define PERIODIC_SEND_AHRS_EULER_INT(_trans, _dev) {} +#define PERIODIC_SEND_AHRS_EULER_INT(_trans, _dev) { \ + struct Int32Eulers ltp_to_imu_euler; \ + INT32_EULERS_OF_QUAT(ltp_to_imu_euler, ahrs_impl.ltp_to_imu_quat); \ + DOWNLINK_SEND_AHRS_EULER_INT(_trans, _dev, \ + <p_to_imu_euler.phi, \ + <p_to_imu_euler.theta, \ + <p_to_imu_euler.psi, \ + &(stateGetNedToBodyEulers_i()->phi), \ + &(stateGetNedToBodyEulers_i()->theta), \ + &(stateGetNedToBodyEulers_i()->psi)); \ +} #endif #define PERIODIC_SEND_AHRS_RMAT_INT(_trans, _dev) { \ diff --git a/sw/airborne/subsystems/ahrs/ahrs_int_cmpl_quat.h b/sw/airborne/subsystems/ahrs/ahrs_int_cmpl_quat.h index a71c60e058..b5e2ac3df3 100644 --- a/sw/airborne/subsystems/ahrs/ahrs_int_cmpl_quat.h +++ b/sw/airborne/subsystems/ahrs/ahrs_int_cmpl_quat.h @@ -42,7 +42,6 @@ struct AhrsIntCmpl { struct Int64Quat high_rez_quat; struct Int64Rates high_rez_bias; struct Int32Quat ltp_to_imu_quat; - struct Int32Eulers ltp_to_imu_euler; // FIXME to compile telemetry struct Int32Vect3 mag_h; int32_t ltp_vel_norm; bool_t ltp_vel_norm_valid; From ab5dcccaa4b468fc11bb7844ba15740378774665 Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 18 Mar 2013 19:34:24 +0100 Subject: [PATCH 054/109] Ubuntu application launcher for Paparazzi --- conf/system/launcher/Paparazzi.desktop | 10 ++++++++++ conf/system/launcher/logo.png | Bin 0 -> 5274 bytes conf/system/launcher/readme.txt | 9 +++++++++ 3 files changed, 19 insertions(+) create mode 100644 conf/system/launcher/Paparazzi.desktop create mode 100644 conf/system/launcher/logo.png create mode 100644 conf/system/launcher/readme.txt diff --git a/conf/system/launcher/Paparazzi.desktop b/conf/system/launcher/Paparazzi.desktop new file mode 100644 index 0000000000..bf06e7168d --- /dev/null +++ b/conf/system/launcher/Paparazzi.desktop @@ -0,0 +1,10 @@ +[Desktop Entry] +Version=3 +Type=Application +Terminal=false +StartupNotify=true +Icon=/home/USERNAME/paparazzi/conf/system/launcher/logo.png +Name=Paparazzi +Comment=The Free Autopilot +Exec=/home/USERNAME/paparazzi/paparazzi +Categories=Application; diff --git a/conf/system/launcher/logo.png b/conf/system/launcher/logo.png new file mode 100644 index 0000000000000000000000000000000000000000..ecbf73e77f2ed2087ad1facd3b20ca293b73a40a GIT binary patch literal 5274 zcmV;L6lLp)P)C00001b5ch_0Itp) z=>Px%`cO<%MFj=`2MGfS2LcHR0}c)e4-pL$3N}7#9*7 z8xxV@?WdQwU>G6?R$&XHhU?T03?_ zJ$_>lb!9R|L_tPKLrF(ON=ijfNk&agNm5fzSyV+;RZ>`2R9ae9TwPgSU|nZgR&Y;9 zbX-?#Wl3UUU2SGpeRW!8WnyP&V`^$;ZEb3AaB6pKW^!?DdUR}cb#i!kb$WVre0+I- zfPRGv1&js*iwXmZ77>#L0+R{@oCE=z3IduB2$3Tmf+!=S1_GxG1gZuBr4kIa2n4$Y z0*7Y@jA{mkY#Nbn1eI|Fn{@=4b_%0=1*3cjg}pg z(**<82n5{;1>^<<;|T@s1_tg42Jr?4@d*Zje}b)q1+#_(wu%S4jRcQ`UW0;th=F*L zgmABzQpJ=7$d?Aqn+4OJ1lFPj*P{vCr3Bxo2jr^+3=ZiiVDjiqN=H-tg5Z9tg)}Ltg)%3va+tYwX3zYvbwdhxw*Ez zy}G`@yurV_#>2J2!M()A!^y|R$;!se&C1Tv&d$-&(ay`!(azJ=(%0G6+1b|I+}hsY z-rwWk;o;xp<>Ke)<>~3>?d|LD@b2&M@bU5P^!4-i`S$qt_4)bt{{H+y(*>mf0004E zOGiWihy@);00009a7bBm000XU000XU0RWnu7ytkO2XskIMF-jm6%`2rFo)~Q000pg zNklN%wcQ*dXm72 zbW87lfBWD;ujMg6?n(G@A;HGH#6XZFPACGCic3n4eX``Wy{%^6kCGTu0$dsf2uPfq z`f=l>OU#AZqQv-(pMP)lmp6_9z}hyOATW|7Ko3~>v5PDWrm^mL(%R1-`iG*hC*5Yf zwstWrKDe+b97F)G__GWEU>LUP{P9hn8n|)H$$RgH++R1>)W_qbte9c`yzXZtQbcg# zc~*eHu+4ReyB~Tdcz#>}Om7rjWQz$L4{x}{FinXhG6fP$;V%LJhGj0EUH5_cX%Uh2 z>YKIAY~56X#1mPziD4Szh52z@7GBeYriT}Mv1UV;k7nowfO%U|1IsqX6R_+WalseD z1v9{LJh(;xfIejFH+PM5GTsvj{J5LAIztfQ0OTJ+qthFA>?^D-l#&94JuWx+cl!8KxwVzy%rLvP6dxz$?%E z%_lDy1xjCtrey16jc3zh&J0|7{~W*VkS zBEWELQQh%r6XvS3K2S$Zz*_xBM7NKDWdnjjVh8}5`(k~4ZGBTBfgCaPo$Fn#TVGIY zzb}{{Z*J*!FKOO00M<_%1g>w2$0b>R0`Ho?C|vyf^V65CTMWz;(kA4HHsjr=krRGf zBTUaUPLn(in3$Z1>~fT>|(`ok%%s5eD9_ymGZ= zi#((kasw6Eq-$H}eFHHZfaT3biS`m<{uX58e6L{P?U0vYJDz%BayO|N^xxc2cLr#% zeHb(am_&rtUxIf5K=>y6cfdMlH*MJPnjFg*eq#zG$1=-!p3i%vrQs5Izn*O_-2MFk zMC6glRyGb!q4$6JJ{-Uw&Npp(*Y$n(Wdwm|`M-fM0zm!orEbK`&4CInnfFh-f*%IJ z>D?b{-n{4TCN+@4#6G`SAn#HFZHwGzH?25uqrtBYthQ;Iz8_W!2JVNG#XX;t8WZW zxflE}WF!@F4^6!`PmGTrmjq6h(ONA4ps0$t&m0KaAsS#t=gS_q?fCVI1q*i?y>~{} z0Qj9{w5FoGyu7lC((GR@A?Smg0J}PL)j-P(`J|j`jizFMDd%S!*p*+s>csC)p4|CL z?kVk|HJn667)hi$)?sOh++ldo_4*+Yl_thG#;SP_ZQz?jIakmIaT1H534N z->(e{7(1|ALoTs2CM*LXxQqa_A&=avmXywYRzOp z$##3cI#rtAv@}Pn)le0aA9@=c-2t#&RXIC*Yls{wK~oS=k-XQkRVB`E)4z0}ng$z; zbB>a{UnBquZ{eIC*gYrIWH(b^IXen@lychbtP7d4yux4lfkB}uP z1ti80C3k-Uj{0V(JmrkpFU`-Z2K`f1-ejZ4#_z5)8#Zq4Fxl-L7=}fe?Eh3w4p65+ zJcPVVW$DhI8@BRjHDXHYRNPyAUb^6z;nt?!oWD9UQK^RQXnq7d-+8fWPH^ z*f#8Y%Qs)`TE6_PPy)x148jU3>4E?PwTLc{ddUCwwY<7-f54VLFMQDf;P3gGgTHqK zcFufb*TUGG{G)kc5Pp!<@qqa;abZHw21^+!YSa5Gax19)Y5m>=Wd{Im=Rs}xk(2kj zd(Fnr*R04nT2)OI#6<@L$z+1%#Z|>hEkX=mdfPepKFC^e2(p)ogh4MbOp4Re zrwaDPt=e~}TtidZ{Fj%XGnj0)hgU!i^DF5X(Fe(`bFhG=?|q}Yb@RIJ*0;J{3v*EN zMCC8F`V-AoW*tz6HdwM??I3Oljt={ocdDQ}8 zm9{&(KFlu%5ooGT9XDzWL#W7%9ggF3G}T!a_%dUA`Yevx)bo4e*xixf3ApL|1EoAFIQp?K*Mq zR-S2eX5GhEA|YnUWV6x@oF@W#(h&|*h5|$Lk^3kO5M&` zA|ydb=+RJj01fOz`!|Doh7tq}$=sYFBZfiy`A}-drKUz0ya3P}IXD--3PnhYT8ZQ2 zsDbuW$RJF**Z~nA?4ejwe``LZeQp5gWrJFVT)0w8g9%he3l8Xz0)dYZ1yX?Ohkx_>hE=4T2X^mC^VUmX5w7 z<~_FCxGlnEm^>;ud8<;HkPw-W5Cuaq<7?gJ*>mR3i;PkxC#YtFvLp=909-^yADgWjsjpLoisq=^93iMwa#8Zj^G2~humaO4`~S%ufSyTnNiBL%+p_^ zHS0Q3J32Gd01m8Q*LhivVPd3#o<~7xGZY6aOe$`psLnEW)lEOot>plZ|l(MkycVL98)3*w1pDaM+4YO zNGEl~WjH^`kGAVvfU06Aq#54$|m!HNGhW5NW*%qUe_#@;Il zK%g?U$(R|637xJH0Fp5h4}5NFu;};rgo6STQ)QF)+#Yz$*{na_QMf~Z6VD|kE&3T2 zB8ADenS&c}d>1l>n>W8sS1BiAfPjz#6+~EE@W2*~3@@p_aAuLjhAV*xp!?3+8aumK&x=8qfuo{8GUZzTcoRei02^;w<;e(1cv% z1~gsvcP9YDVt^BX;-YwX0@GCZFPz=8!|nIaZQHi(Uz2K^9H+AwrWODYiYp(yjPel; zUHR&OW7}jnfFTHY;2HMIlEuZ%Ow+nMo+YJsHWikfscR6<#))UPm`jE5M8z%pz^^K3 z)UBX$uSqxDz=lz9W`ZLPz_DqCbxi%b!e+MSUEUJ_w#|awv5rG?O(25Ca7;Wh^3`D) zH7ux8%OvkIN|}#1t=|4fMWA$)49&jRn)+gVT|<0QbL~c(Cyh$$=0?Z#%?=Z&2_%Vh zAw0iYiHdeDowrL=LXX@@?GZ3hUkFfiXr@rLo8Nx1usCpCQoBbg;5Ii5u3nS?!>q%w z5V76yRi2QR(waCCL64jq2Eh6-A}G1VVIka|geh;S+dOR7fA?`C!!$cVV9#&J+8WX> zxKjVG%23mWrm9x%K)z^}J5yn1mTHfFSUZC=ah_L3=}D|`a#qwo{M=-)^WA%vs&4`Y z)53D07eiI=f9X1B?{(s0B1oK_&JC0Nn0lbr%E|MApdGe(G4(K*Hjp^&4M%Zb9yWxY(E#znC1P zP>@5xfbhdkvdDzoWkq6>L;-Bc8$&%`V7+o|WwZ9Fd?rexXL>Ah0VB$RY;!B*cp6b=C0Yilpmf61~JHVto* z-6)h!5VOUzBmnjnM>$4@KK5;P=V)l!_~N23*t2U#aENtdooE_omJF781M^S-5OSy6 zzFFX~aLlDl{rHo2dq-Z-wH}E2{PCpe|8&ZogQO5dyv_T|2GC;vdac*R^I8)d&Mx`) ztIqiie^mrP;0mA4IP&A_6Y_iFr;n_0`3w;NfoJ=m{&6-c?Y8f`MmM`Ngsmh9*`}x6 zsB|~Z35-Y(YMa;g=NkZfR}_iL6|&v0eL_!++InuLkdR$}HYyMx7`7?oL38^&UA6PU zPhbDvkb~&JjVXR_53_lFD8K`2zbMmTO!d1wRt)57snNx&lv&-mYd g`SAeYpQ=p$56e6o5^v`fmH+?%07*qoM6N<$f&!GCIsgCw literal 0 HcmV?d00001 diff --git a/conf/system/launcher/readme.txt b/conf/system/launcher/readme.txt new file mode 100644 index 0000000000..63205bf7e1 --- /dev/null +++ b/conf/system/launcher/readme.txt @@ -0,0 +1,9 @@ +Ubuntu shortcut + +To create a shortcut on the desktop to easily start Paparazzi copy the launcher to the desktop + +cp Paparazzi.desktop ~/Desktop + +and edit it to fit your username. Replace USERNAME with your actual user name in the 'Icon' and 'Exec' lines. + +gedit ~/Desktop/Paparazzi.desktop From f70caabdf8bcd3a4c23efa82b7fa3b74954f6623 Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 18 Mar 2013 19:02:14 +0000 Subject: [PATCH 055/109] OTF! typo, description --- conf/modules/airspeed_otf.xml | 19 +++++++++++++++---- sw/airborne/modules/sensors/met_module.h | 17 +---------------- 2 files changed, 16 insertions(+), 20 deletions(-) diff --git a/conf/modules/airspeed_otf.xml b/conf/modules/airspeed_otf.xml index 7ee2919574..b9dcb05e31 100644 --- a/conf/modules/airspeed_otf.xml +++ b/conf/modules/airspeed_otf.xml @@ -2,7 +2,17 @@ - + + OTF! airspeed/flow angle sensor + Driver for the Aeroprobe On-The-Fly! air data computer. + + The Aeroprobe On-The-Fly! air data computer measures + air pressure from a 5-hole pitot tube and can write + resulting data to an SD card or transmit it through an + UART. It outputs speed, angle of attack, angle of + sideslip and altitude. + +
@@ -13,8 +23,9 @@ - - - + + + + diff --git a/sw/airborne/modules/sensors/met_module.h b/sw/airborne/modules/sensors/met_module.h index c91f97b11b..b6bd3b738c 100644 --- a/sw/airborne/modules/sensors/met_module.h +++ b/sw/airborne/modules/sensors/met_module.h @@ -34,9 +34,6 @@ #include "std.h" #include "led.h" -extern volatile uint8_t ins_msg_received; -extern volatile uint8_t new_ins_attitude; - #ifndef SITL #include "mcu_periph/uart.h" @@ -54,17 +51,5 @@ extern volatile uint8_t new_ins_attitude; #endif /** !SITL */ -#define InsEventCheckAndHandle(handler) { \ - if (InsBuffer()) { \ - ReadInsBuffer(); \ - } \ - if (ins_msg_received) { \ - LED_TOGGLE(2); \ - parse_ins_msg(); \ - handler; \ - ins_msg_received = FALSE; \ - } \ - } - - #endif /* MET_H */ + From 6f70adf31bef5ed959bfb95c6b615f8473f4389b Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Mon, 18 Mar 2013 20:14:56 +0100 Subject: [PATCH 056/109] add recent Digi XBee pro modem (metal case) to udev rules --- conf/system/udev/rules/50-paparazzi.rules | 3 +++ 1 file changed, 3 insertions(+) diff --git a/conf/system/udev/rules/50-paparazzi.rules b/conf/system/udev/rules/50-paparazzi.rules index 1d3383c6b3..4a8f7ef37e 100644 --- a/conf/system/udev/rules/50-paparazzi.rules +++ b/conf/system/udev/rules/50-paparazzi.rules @@ -9,6 +9,9 @@ SUBSYSTEM=="tty", ATTRS{product}=="FT232R USB UART", SYMLINK+="paparazzi/serial" # MaxStream xbee pro box SUBSYSTEM=="tty", ATTRS{product}=="MaxStream PKG-U", SYMLINK+="paparazzi/xbee", GROUP="plugdev" +# Recent Digi XBee pro modems (XBP24-PKC-001-UA) +SUBSYSTEM=="tty", ATTRS{idVendor}=="0403", ATTRS{idProduct}=="6001", ATTRS{product}=="USB <-> Serial", SYMLINK+="paparazzi/xbee", GROUP="plugdev" + LABEL="tty_FTDI232_end" SUBSYSTEM!="usb", GOTO="paparazzi_rules_end" From 2f2a0fafcd167bf988e9cfc915eabb412f47d556 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 19 Mar 2013 14:46:23 +0100 Subject: [PATCH 057/109] [makefile] add LIBPPRZDIR to OCAMLPATH instead of replace --- sw/Makefile.ocaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml index 85059795cf..327d4cdc38 100644 --- a/sw/Makefile.ocaml +++ b/sw/Makefile.ocaml @@ -36,4 +36,4 @@ XLIBPPRZCMXA = $(XLIBPPRZCMA:.cma=.cmxa) OCAMLDLL = -dllpath $(LIBPPRZDIR) OCAMLXDLL = -dllpath $(LIBPPRZDIR) -export OCAMLPATH=$(LIBPPRZDIR) +export OCAMLPATH=$(LIBPPRZDIR):$OCAMLPATH From bcb56b8ea5186ac39d91d05c0d24b16338b93081 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 19 Mar 2013 15:50:32 +0100 Subject: [PATCH 058/109] [makefile] ocaml: -threads is sufficient no need to add the threads package explicitly or add gtkThread.cm[ox] --- sw/ground_segment/cockpit/Makefile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 05515114b8..830dabb987 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -40,7 +40,7 @@ LIBS= LIBSX=$(LIBS:.cma=.cmxa) INCLUDES= -I ../multimon -PKG = -package pprz.xlib,threads +PKG = -package pprz.xlib LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz.xlib ML= gtk_setting_time.ml gtk_strip.ml horizon.ml strip.ml gtk_save_settings.ml saveSettings.ml page_settings.ml pages.ml speech.ml plugin.ml sectors.ml map2d.ml editFP.ml live.ml particules.ml papgets.ml gcs.ml @@ -54,11 +54,11 @@ opt : $(MAIN).opt $(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) gtkThread.cmo myGtkInit.cmo $(CMO) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) myGtkInit.cmo $(CMO) -o $@ $(MAIN).opt : $(CMX) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) $(LINKPKG) gtkThread.cmx gtkInit.cmx $(CMX) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) $(LINKPKG) gtkInit.cmx $(CMX) -o $@ %.cmo: %.ml From 57fdb9292171a1ae25a057a4b2219ba160877d33 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 19 Mar 2013 15:52:37 +0100 Subject: [PATCH 059/109] [makefile] fix ocaml native compilation there is no -dllpath option for ocamlopt --- sw/ground_segment/cockpit/Makefile | 2 +- sw/ground_segment/tmtc/Makefile | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 830dabb987..baa36f80d7 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -58,7 +58,7 @@ $(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) $(MAIN).opt : $(CMX) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) $(LINKPKG) gtkInit.cmx $(CMX) -o $@ + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) -package pprz.xlib,lablgtk2.init -linkpkg $(CMX) -o $@ %.cmo: %.ml diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 6922ee277e..57eb500a56 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -74,7 +74,7 @@ server : $(SERVERCMO) $(LIBPPRZCMA) server.opt : $(SERVERCMX) $(LIBPPRZCMXA) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMX) + $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ -package glibivy,pprz -linkpkg $(SERVERCMX) link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ From 7082154183060c7a576f543443529f55ffc69c11 Mon Sep 17 00:00:00 2001 From: Dino Hensen Date: Tue, 19 Mar 2013 22:18:22 +0100 Subject: [PATCH 060/109] [tools] propsal to use meld instead of tkdiff, which is nowadays removed from ubuntu repo --- sw/supervision/paparazzicenter.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sw/supervision/paparazzicenter.ml b/sw/supervision/paparazzicenter.ml index cc4b8dc333..b3af7d514e 100644 --- a/sw/supervision/paparazzicenter.ml +++ b/sw/supervision/paparazzicenter.ml @@ -135,7 +135,7 @@ let quit_button_callback = fun gui ac_combo session_combo target_combo () -> Sys.rename Utils.backup_xml_file Utils.conf_xml_file; quit_callback gui ac_combo session_combo target_combo () | 3 -> - ignore (Sys.command (sprintf "tkdiff %s %s" Utils.backup_xml_file Utils.conf_xml_file)); + ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () | 1 -> Sys.remove Utils.backup_xml_file; @@ -175,7 +175,7 @@ let () = let rec question_box = fun () -> match GToolbox.question_box ~title:"Backup" ~buttons:["Keep changes"; "Discard changes"; "View changes"] ~default:2 "Configuration changes made during the last session were not saved. ?" with | 2 -> Sys.rename Utils.backup_xml_file Utils.conf_xml_file - | 3 -> ignore (Sys.command (sprintf "tkdiff %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () + | 3 -> ignore (Sys.command (sprintf "meld %s %s" Utils.backup_xml_file Utils.conf_xml_file)); question_box () | _ -> Sys.remove Utils.backup_xml_file in question_box () end; From 346fc0c416551d79f78b29cbf49cc96f3ef7ebc4 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 20 Mar 2013 00:50:06 +0100 Subject: [PATCH 061/109] [makefile] set OCAMLC and OCAMLOPT to use ocamlfind --- conf/Makefile.sim | 2 +- sw/Makefile.ocaml | 5 ++--- sw/ground_segment/cockpit/Makefile | 12 ++++++------ sw/ground_segment/joystick/Makefile | 4 ++-- sw/ground_segment/tmtc/Makefile | 30 ++++++++++++++--------------- sw/lib/ocaml/Makefile | 25 ++++++++++++------------ sw/logalizer/Makefile | 16 +++++++-------- sw/simulator/Makefile | 12 ++++++------ sw/supervision/Makefile | 6 +++--- sw/tools/Makefile | 12 ++++++------ 10 files changed, 61 insertions(+), 63 deletions(-) diff --git a/conf/Makefile.sim b/conf/Makefile.sim index d063602448..6e892e09e3 100644 --- a/conf/Makefile.sim +++ b/conf/Makefile.sim @@ -83,7 +83,7 @@ autopilot.so : $($(TARGET).objs) $(OBJDIR)/simsitl : autopilot.so $(SITLCMA) $(SIMSITLML) @echo LD $@ - $(Q)$(OCAMLFIND) $(OCAMLC) -g $(CAMLINCLUDES) -o $@ $(LINKPKG) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) + $(Q)$(OCAMLC) -g $(CAMLINCLUDES) -o $@ $(LINKPKG) $(MYGTKINITCMO) $^ -dllpath $(OBJDIR) -dllpath $(SIMDIR) # The id of the A/C is hardcoded in the code (to be improved with dynlink ?) diff --git a/sw/Makefile.ocaml b/sw/Makefile.ocaml index 327d4cdc38..682a382c72 100644 --- a/sw/Makefile.ocaml +++ b/sw/Makefile.ocaml @@ -23,10 +23,9 @@ # General ocaml compiling tools and pprz lib OCAML = ocaml -OCAMLC = ocamlc -OCAMLOPT = ocamlopt +OCAMLC = ocamlfind ocamlc +OCAMLOPT = ocamlfind ocamlopt OCAMLDEP = ocamldep -OCAMLFIND = ocamlfind OCAMLMKLIB = ocamlmklib LIBPPRZDIR = $(PAPARAZZI_SRC)/sw/lib/ocaml LIBPPRZCMA = $(LIBPPRZDIR)/lib-pprz.cma diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index baa36f80d7..6c8a6d4305 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -54,22 +54,22 @@ opt : $(MAIN).opt $(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) myGtkInit.cmo $(CMO) -o $@ + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) myGtkInit.cmo $(CMO) -o $@ $(MAIN).opt : $(CMX) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) -package pprz.xlib,lablgtk2.init -linkpkg $(CMX) -o $@ + $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(LIBSX) -package pprz.xlib,lablgtk2.init -linkpkg $(CMX) -o $@ %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) $(PKG) -c $< saveSettings.cmo : gtk_save_settings.cmo saveSettings.cmx: gtk_save_settings.cmx @@ -90,7 +90,7 @@ strip.cmo : gtk_strip.cmo gtk_setting_time.cmo compass : compass.ml @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LINKPKG) gtkInit.cmo $^ -o $@ + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LINKPKG) gtkInit.cmo $^ -o $@ clean: diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index ccf20bbd57..aecc2cbd23 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -62,7 +62,7 @@ test_stick: test_sdl_stick.o input2ivy: sdl_stick.so input2ivy.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) + $(Q)$(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) # dependency of input2ivy input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo @@ -77,7 +77,7 @@ sdl_stick.so : sdl_stick.o ml_sdl_stick.o %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLINCLUDES) -c $(PKG) $< + $(Q)$(OCAMLC) $(OCAMLINCLUDES) -c $(PKG) $< clean: $(Q)rm -f *~ core *.o *.bak .depend test*stick *.cmo *.cmi input2ivy diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index 57eb500a56..ea42850287 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -62,73 +62,73 @@ $(VAR)/boa.conf :$(CONF)/boa.conf messages : messages.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< settings : settings.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) ../cockpit/page_settings.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< server : $(SERVERCMO) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMO) + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMO) server.opt : $(SERVERCMX) $(LIBPPRZCMXA) @echo OOL $@ - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -o $@ -package glibivy,pprz -linkpkg $(SERVERCMX) + $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ -package glibivy,pprz -linkpkg $(SERVERCMX) link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< dia : dia.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< diadec : diadec.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< 150m : 150m.cmo $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< settings.cmo : INCLUDES += -I ../cockpit settings.cmo : ../cockpit/page_settings.cmi %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLOPT) $(INCLUDES) $(PKG) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) $< + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) $< CC = gcc diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index b4387f791c..aa60507db5 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -24,10 +24,9 @@ Q=@ -OCAMLC=ocamlc -OCAMLFIND=ocamlfind +OCAMLC=ocamlfind ocamlc +OCAMLOPT=ocamlfind ocamlopt OCAMLDEP=ocamldep -OCAMLOPT=ocamlopt OCAMLLEX=ocamllex OCAMLYACC=ocamlyacc OCAMLMKLIB=ocamlmklib @@ -91,48 +90,48 @@ xlib-pprz.cmxa: | libxlib-pprz.a dllxlib-pprz.so xml_get.out : lib-pprz.cma xml_get.cmo | opt @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package str,xml-light -linkpkg -I . $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ -package str,xml-light -linkpkg -I . $^ tests : lib-pprz.cma $(TESTS_CMO) - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg -I . -dllpath . $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg -I . -dllpath . $^ GTKCFLAGS := `pkg-config --cflags gtk+-2.0` %.o : %.c @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(FPIC) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLC) $(FPIC) $(INCLUDES) -package $(PKGCOMMON) -c $< $(XCMO) $(XCMX) myGtkInit.cmo : PKGCOMMON=$(XPKGCOMMON) ml_gtk_drag.o : ml_gtk_drag.c @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< + $(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< ml_gtkgl_hack.o : ml_gtkgl_hack.c @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< + $(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< camltm.o : register_example.cmo - $(OCAMLFIND) $(OCAMLC) $(INCLUDES) -output-obj -o $@ -package unix,str,xml-light,ivy debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo + $(OCAMLC) $(INCLUDES) -output-obj -o $@ -package unix,str,xml-light,ivy debug.cmo serial.cmo extXml.cmo env.cmo pprz.cmo tm.cmo caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o $(CC) -o $@ $^ -L$(OCAMLLIBDIR) -lunix -lstr -livy-ocaml -lcamlrun -lm -livy -lcurses %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLOPT) $(INCLUDES) -package $(PKGCOMMON) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(XINCLUDES) $(INCLUDES) -package $(PKGCOMMON),$(XPKGCOMMON) $< + $(Q)$(OCAMLC) $(XINCLUDES) $(INCLUDES) -package $(PKGCOMMON),$(XPKGCOMMON) $< %.cmi : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(XINCLUDES) -package $(PKGCOMMON) -c $< + $(Q)$(OCAMLC) $(XINCLUDES) -package $(PKGCOMMON) -c $< %.ml : %.mll @echo OCL $< diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 56b4a16d11..fc7d8291de 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -37,23 +37,23 @@ all: play plotter plot sd2log plotprofile openlog2tlm play : $(LIBPPRZCMA) log_file.cmo play_core.cmo play.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ play-nox : $(LIBPPRZCMA) play_core.cmo play-nox.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) plotter.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) log_file.cmo gtk_export.cmo export.cmo plot.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ sd2log : $(LIBPPRZCMA) sd2log.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ CC = gcc CFLAGS=-g -O2 -Wall @@ -70,13 +70,13 @@ openlog2tlm: openlog2tlm.c %.cmo: %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< %.cmi: %.mli @echo OCI $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< %.cmx: %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLOPT) $(OCAMLCFLAGS) $(INCLUDES) -c $(PKG) $< export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index ca97704435..d2bea01533 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -57,7 +57,7 @@ fg.so : fg.o simhitl : fg.so $(SIMHCMO) simhitl.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< sitl.cma : fg.o $(SIMSCMO) @echo OL $@ @@ -69,15 +69,15 @@ sitl.cmxa : $(SIMSCMX) gaia : gaia.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< diffusion : stdlib.cmo diffusion.cmo @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -c $(PKG) $< %.o : %.c @echo CC $< @@ -85,11 +85,11 @@ diffusion : stdlib.cmo diffusion.cmo %.cmx : %.ml @echo OOC $< - $(Q)$(OCAMLFIND) $(OCAMLOPT) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLOPT) $(INCLUDES) -c $(PKG) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(PKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -c $(PKG) $< # dependency on lib-pprz simhitl diffusion gaia: $(LIBPPRZCMA) diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index b9a5f39262..9e244eb308 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -38,7 +38,7 @@ all: paparazzicenter paparazzicenter : $(PAPARAZZICENTERCMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ gtk_pc.ml : paparazzicenter.glade @echo GLADE $@ @@ -54,11 +54,11 @@ gtk_process.ml : paparazzicenter.glade %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(XPKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -c $(XPKG) $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -c $(XPKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -c $(XPKG) $< pc_common.cmo: gtk_process.cmo diff --git a/sw/tools/Makefile b/sw/tools/Makefile index 92b7798e89..04a06a2595 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -35,23 +35,23 @@ ABS_FP = $(FP_CMO:%=$$PAPARAZZI_SRC/sw/tools/%) gen_flight_plan.out : $(FP_CMO) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ - + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ + gen_srtm.out : gen_srtm.ml $(LIBPPRZCMA) @echo OL $@ - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< %.out : %.ml gen_common.cmo $(LIBPPRZCMA) @echo OL $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gen_common.cmo $< + $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gen_common.cmo $< %.cmo : %.ml @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< %.cmi : %.mli @echo OC $< - $(Q)$(OCAMLFIND) $(OCAMLC) $(INCLUDES) $(PKG) -c $< + $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< # dependency on lib-pprz gen_flight_plan.out : $(LIBPPRZCMA) From 1436e2324c2ee5616c0a741fca4116ebdf4b47f4 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Wed, 20 Mar 2013 15:54:19 +0100 Subject: [PATCH 062/109] [http] get the proxy settings from env --- sw/lib/ocaml/http.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/sw/lib/ocaml/http.ml b/sw/lib/ocaml/http.ml index 63b3488da3..bcec3bb6b5 100644 --- a/sw/lib/ocaml/http.ml +++ b/sw/lib/ocaml/http.ml @@ -15,6 +15,7 @@ let file_of_url = fun ?dest url -> let call = new Http_client.get url in call#set_response_body_storage (`File (fun () -> tmp_file)); let pipeline = new Http_client.pipeline in + pipeline#set_proxy_from_environment (); pipeline#add call; pipeline#run (); match call#status with From ae48da938da511ff1f7a8c8c765782b23111e187 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Wed, 20 Mar 2013 19:45:29 +0100 Subject: [PATCH 063/109] [paparazzicenter] add checkbox to enable PRINT_CONFIG --- Makefile.ac | 2 +- conf/airframes/examples/microjet_lisa_m.xml | 3 - .../examples/microjet_twog_aspirin.xml | 3 - conf/airframes/fraser_lisa_m_rotorcraft.xml | 3 - sw/airborne/Makefile | 4 + sw/supervision/paparazzicenter.glade | 219 +++++++++++++++++- sw/supervision/pc_aircraft.ml | 7 +- 7 files changed, 224 insertions(+), 17 deletions(-) diff --git a/Makefile.ac b/Makefile.ac index 22b883e59b..cdd479e849 100644 --- a/Makefile.ac +++ b/Makefile.ac @@ -155,7 +155,7 @@ $(SETTINGS_TELEMETRY) : $(PERIODIC_H) %.upload: %.compile cd $(AIRBORNE); $(MAKE) TARGET=$* upload -jsbsim jsbsim.compile: jsbsim.ac_h +jsbsim jsbsim.compile: jsbsim.ac_h print_version cd $(AIRBORNE); $(MAKE) TARGET=jsbsim ARCHI=jsbsim ARCH=jsbsim all sim sim.compile: sim.ac_h print_version diff --git a/conf/airframes/examples/microjet_lisa_m.xml b/conf/airframes/examples/microjet_lisa_m.xml index 202fe5d999..6ed7c1bed7 100644 --- a/conf/airframes/examples/microjet_lisa_m.xml +++ b/conf/airframes/examples/microjet_lisa_m.xml @@ -20,9 +20,6 @@ - - - diff --git a/conf/airframes/examples/microjet_twog_aspirin.xml b/conf/airframes/examples/microjet_twog_aspirin.xml index 8160835491..c777bc0f44 100644 --- a/conf/airframes/examples/microjet_twog_aspirin.xml +++ b/conf/airframes/examples/microjet_twog_aspirin.xml @@ -26,9 +26,6 @@ - - - diff --git a/conf/airframes/fraser_lisa_m_rotorcraft.xml b/conf/airframes/fraser_lisa_m_rotorcraft.xml index 4c8b7765d2..a232a41767 100644 --- a/conf/airframes/fraser_lisa_m_rotorcraft.xml +++ b/conf/airframes/fraser_lisa_m_rotorcraft.xml @@ -30,9 +30,6 @@ - - - diff --git a/sw/airborne/Makefile b/sw/airborne/Makefile index 0dd7b7f31c..dea5860293 100644 --- a/sw/airborne/Makefile +++ b/sw/airborne/Makefile @@ -45,6 +45,10 @@ ifneq ($(MAKECMDGOALS),clean) endif endif + ifdef PRINT_CONFIG + $(TARGET).CFLAGS += -DPRINT_CONFIG + endif + # sort cflags and sources to throw out duplicates # #$(info CFLAGS_orig = $($(TARGET).CFLAGS)) diff --git a/sw/supervision/paparazzicenter.glade b/sw/supervision/paparazzicenter.glade index cee69a6eb5..c59f210306 100644 --- a/sw/supervision/paparazzicenter.glade +++ b/sw/supervision/paparazzicenter.glade @@ -1,17 +1,20 @@ - + - + True + False window1 32 True + False True + False process name 20 @@ -25,9 +28,15 @@ True True - ● + â— + False + False + True + True + True + True 1 @@ -37,6 +46,7 @@ True False Automatic respawn + False True @@ -55,6 +65,7 @@ True True False + False True @@ -71,6 +82,7 @@ False True False + False True @@ -84,24 +96,32 @@ True + False Paparazzi Center True + False True + False True + False + False _A/C True + False gtk-new True + False + False True True @@ -112,6 +132,8 @@ gtk-delete True + False + False True True @@ -122,6 +144,8 @@ gtk-save True + False + False True True @@ -130,12 +154,15 @@ True + False gtk-quit True + False + False True True @@ -148,14 +175,19 @@ True + False + False Session True + False gtk-new True + False + False True True @@ -165,6 +197,8 @@ gtk-save True + False + False True True @@ -174,6 +208,8 @@ gtk-delete True + False + False True True @@ -186,6 +222,8 @@ True + False + False _Tools True @@ -194,15 +232,20 @@ True + False + False _View True + False gtk-fullscreen True + False + False True True @@ -216,13 +259,18 @@ True + False + False _Help True + False True + False + False _About True @@ -248,20 +296,25 @@ 250 400 True + False True + False True + False 0 True + False 12 True + False @@ -272,6 +325,7 @@ True + False <b>A/C</b> True @@ -281,16 +335,20 @@ + True + True 0 True + False 0 True + False 12 @@ -298,8 +356,12 @@ True ID of the aircraft (number from 1 to 255) 3 - ● + â— 3 + False + False + True + True @@ -307,6 +369,7 @@ True + False <b>id</b> True @@ -316,28 +379,36 @@ + True + True 1 True + False 0 True + False 12 True + False True + False + True + True 0 @@ -348,6 +419,7 @@ True False Color selector + False True @@ -363,6 +435,7 @@ True + False <b>GUI color</b> True @@ -372,12 +445,15 @@ + True + True 2 False + True 0 @@ -391,27 +467,35 @@ True + False True + False True + False 0 True + False 12 True + False 2 True + False ________________ + True + True 0 @@ -422,6 +506,7 @@ True False Browse + False True @@ -437,6 +522,7 @@ True False Launch the GCS editor or a text editor (gedit or EDITOR env variable if set) + False True @@ -452,6 +538,7 @@ True + False <b>Airframe</b> True @@ -462,26 +549,33 @@ False + True 0 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -491,6 +585,7 @@ True True False + False True @@ -506,6 +601,7 @@ True False Launch a text editor (gedit or EDITOR env variable if set) + False True @@ -521,6 +617,7 @@ True + False <b>Flight plan</b> True @@ -531,20 +628,24 @@ False + True 1 True + False 0 True + False 12 True + False 4 @@ -553,21 +654,26 @@ False + True + True 0 True + False False + True 1 True + False gtk-add @@ -576,6 +682,7 @@ True True Add a settings file + False True True @@ -593,6 +700,7 @@ True True Launch an editor on all the settings file + False True @@ -608,6 +716,7 @@ True True Remove the selected settings file + False True @@ -630,6 +739,7 @@ True + False <b>Settings</b> True @@ -640,26 +750,33 @@ False + True 2 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -669,6 +786,7 @@ True True False + False True @@ -683,6 +801,7 @@ True True False + False True @@ -698,6 +817,7 @@ True + False <b>Radio</b> True @@ -708,26 +828,33 @@ False + True 3 True + False 0 True + False 12 True + False True + False _________________ + True + True 0 @@ -737,6 +864,7 @@ True True False + False True @@ -751,6 +879,7 @@ True True False + False True @@ -766,6 +895,7 @@ True + False <b>Telemetry</b> True @@ -776,6 +906,7 @@ False + True 4 @@ -785,6 +916,8 @@ + True + True 1 @@ -797,29 +930,35 @@ True + False True + False 3 True + False 1 - True True + False True + False 0 True + False 12 True + False @@ -830,6 +969,7 @@ True + False <b>Target</b> True @@ -839,6 +979,8 @@ + True + True 0 @@ -848,18 +990,22 @@ True False Add a target in the combo list + False True + False 0 0 True + False 2 True + False gtk-add @@ -871,6 +1017,7 @@ True + False New Target True @@ -901,24 +1048,29 @@ True + False True True True False + False True + False 0 0 True + False 2 True + False gtk-clear @@ -930,6 +1082,7 @@ True + False Clean True @@ -957,18 +1110,22 @@ True False Build the selected target of the selected A/C. Warning: Save is required before this action + False True + False 0 0 True + False 2 True + False gtk-convert @@ -980,6 +1137,7 @@ True + False Build True @@ -1007,18 +1165,22 @@ True False Upload into the airborne device (which must be plugged !). + False True + False 0 0 True + False 2 True + False gtk-go-up @@ -1030,6 +1192,7 @@ True + False Upload True @@ -1057,39 +1220,64 @@ 1 + + + print config at build time + True + True + False + Enable configuration messages at build time (PRINT_CONFIG). + False + True + + + True + True + 2 + + + True + True 0 True + False False + True 1 True + False 1 True True + False True + False 0 True + False 12 True + False @@ -1100,6 +1288,7 @@ True + False <b>Session</b> True @@ -1109,6 +1298,8 @@ + True + True 0 @@ -1118,6 +1309,7 @@ True True False + False True @@ -1138,18 +1330,22 @@ True True False + False True + False 0 0 True + False 2 True + False gtk-clear @@ -1161,6 +1357,7 @@ True + False Stop/Remove All Processes True @@ -1183,33 +1380,40 @@ + True + True 2 True + False False + True 3 False + True 0 True + False False + True 1 @@ -1225,6 +1429,8 @@ + True + True 2 @@ -1236,12 +1442,15 @@ + True + True 1 True + False False diff --git a/sw/supervision/pc_aircraft.ml b/sw/supervision/pc_aircraft.ml index 6d715d9115..005945ab75 100644 --- a/sw/supervision/pc_aircraft.ml +++ b/sw/supervision/pc_aircraft.ml @@ -384,8 +384,11 @@ let build_handler = fun ~file gui ac_combo (target_combo:Gtk_tools.combo) (log:s try ( let ac_name = Gtk_tools.combo_value ac_combo and target = Gtk_tools.combo_value target_combo in - let target = if target="sim" then target else sprintf "%s.compile" target in - Utils.command ~file gui log ac_name target + let target_cmd = if gui#checkbutton_printconfig#active then + sprintf "PRINT_CONFIG=1 %s.compile" target + else + sprintf "%s.compile" target in + Utils.command ~file gui log ac_name target_cmd ) with _ -> log "ERROR: Nothing to build!!!\n" in ignore (gui#button_build#connect#clicked ~callback); From 1740fbf8def0311ac125b3c8096eabe381439153 Mon Sep 17 00:00:00 2001 From: Martin Mueller Date: Wed, 20 Mar 2013 21:39:41 +0000 Subject: [PATCH 064/109] add IR_MLX_ONE_TIME_CONFIG for setting MLX90614 address --- sw/airborne/modules/meteo/ir_mlx.c | 53 +++++++++++++++++++++++++++++- sw/airborne/modules/meteo/ir_mlx.h | 5 +++ 2 files changed, 57 insertions(+), 1 deletion(-) diff --git a/sw/airborne/modules/meteo/ir_mlx.c b/sw/airborne/modules/meteo/ir_mlx.c index 35cb85acf7..87fb548e11 100644 --- a/sw/airborne/modules/meteo/ir_mlx.c +++ b/sw/airborne/modules/meteo/ir_mlx.c @@ -54,20 +54,48 @@ float ir_mlx_temp_obj; uint32_t ir_mlx_id_01; uint32_t ir_mlx_id_23; -/* I2C address is set to 3 */ +/* I2C address is set to 6 (8 bit) */ #ifndef MLX90614_ADDR #define MLX90614_ADDR 0x06 #endif +#define MLX90614_GENERAL_ADDR 0 + // printf("Ta = %2.2f°C (0x%04X)\n", (tp*0.02)-273.15, tp); +void ir_mlx_crc(unsigned char addr, volatile unsigned char* data) { + unsigned char i, bit, crc = 0; + + for (i = 0; i < 4; i++) { + if (i != 0) crc ^= (data[i-1]); + else crc ^= addr; + for (bit = 8; bit > 0; bit--) { + if (crc & 0x80) + /* SMBus x^8 + x^2 + x + 1 */ + crc = (crc << 1) ^ 0x107; + else + crc = (crc << 1); + } + } + data[3] = crc; +} void ir_mlx_init( void ) { +#ifdef IR_MLX_ONE_TIME_CONFIG +#warning Starting MLX90614 in CONFIGURATION MODE, do this only once for +#warning setup, then turn this MODE off again and recompile/flash + ir_mlx_status = IR_MLX_ADDR_CHANGE; +#else ir_mlx_status = IR_MLX_UNINIT; +#endif } void ir_mlx_periodic( void ) { +#ifdef IR_MLX_ONE_TIME_CONFIG + if (sys_time.nb_sec > 4) { +#else if (sys_time.nb_sec > 1) { +#endif if (ir_mlx_status >= IR_MLX_IDLE) { /* start two byte case temperature */ mlx_trans.buf[0] = MLX90614_TA; @@ -82,6 +110,29 @@ void ir_mlx_periodic( void ) { ir_mlx_status = IR_MLX_RD_ID_0; } } +#ifdef IR_MLX_ONE_TIME_CONFIG + else if ((sys_time.nb_sec > 1) && (ir_mlx_status == IR_MLX_ADDR_CHANGE)) { + /* erase address by writing zero to SMBus address register */ + ir_mlx_status = IR_MLX_ADDR_ERASE; + mlx_trans.buf[0] = MLX90614_SADR; + mlx_trans.buf[1] = 0; + mlx_trans.buf[2] = 0; + ir_mlx_crc(MLX90614_GENERAL_ADDR, mlx_trans.buf); + i2c_transmit(&MLX_I2C_DEV, &mlx_trans, MLX90614_GENERAL_ADDR, 4); + } else + if ((sys_time.nb_sec > 2) && (ir_mlx_status == IR_MLX_ADDR_ERASE)) { + /* set address by writing it to AMBus address register */ + ir_mlx_status = IR_MLX_ADDR_SET; + mlx_trans.buf[0] = MLX90614_SADR; + mlx_trans.buf[1] = MLX90614_ADDR >> 1; + mlx_trans.buf[2] = 0; + ir_mlx_crc(MLX90614_GENERAL_ADDR, mlx_trans.buf); + i2c_transmit(&MLX_I2C_DEV, &mlx_trans, MLX90614_GENERAL_ADDR, 4); + } else + if ((sys_time.nb_sec > 3) && (ir_mlx_status == IR_MLX_ADDR_SET)) { + ir_mlx_status = IR_MLX_UNINIT; + } +#endif } void ir_mlx_event( void ) { diff --git a/sw/airborne/modules/meteo/ir_mlx.h b/sw/airborne/modules/meteo/ir_mlx.h index cf3508ea3b..74b70e5b99 100644 --- a/sw/airborne/modules/meteo/ir_mlx.h +++ b/sw/airborne/modules/meteo/ir_mlx.h @@ -5,12 +5,16 @@ #define MLX90614_TA 0x06 #define MLX90614_TOBJ 0x07 +#define MLX90614_SADR 0x2E #define MLX90614_ID_0 0x3C #define MLX90614_ID_1 0x3D #define MLX90614_ID_2 0x3E #define MLX90614_ID_3 0x3F enum mlx_type { + IR_MLX_ADDR_CHANGE, + IR_MLX_ADDR_ERASE, + IR_MLX_ADDR_SET, IR_MLX_UNINIT, IR_MLX_RD_ID_0, IR_MLX_RD_ID_1, @@ -21,6 +25,7 @@ enum mlx_type { IR_MLX_RD_OBJ_TEMP }; +void ir_mlx_crc(unsigned char addr, volatile unsigned char* data); void ir_mlx_init(void); void ir_mlx_periodic(void); void ir_mlx_event(void); From 5e1f491b459372a5f800e7dff87eab57cf23c5d3 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 21 Mar 2013 15:11:25 +0100 Subject: [PATCH 065/109] [makefile] no explicit dependencies on libpprz --- sw/ground_segment/cockpit/Makefile | 2 +- sw/ground_segment/joystick/Makefile | 8 ++++---- sw/ground_segment/tmtc/Makefile | 24 ++++++++++++------------ sw/lib/ocaml/Makefile | 7 +++++-- sw/logalizer/Makefile | 12 ++++++------ sw/simulator/Makefile | 3 --- sw/supervision/Makefile | 1 - sw/tools/Makefile | 7 ++----- 8 files changed, 30 insertions(+), 34 deletions(-) diff --git a/sw/ground_segment/cockpit/Makefile b/sw/ground_segment/cockpit/Makefile index 6c8a6d4305..84703ccffa 100644 --- a/sw/ground_segment/cockpit/Makefile +++ b/sw/ground_segment/cockpit/Makefile @@ -52,7 +52,7 @@ all : $(MAIN) opt : $(MAIN).opt -$(MAIN) : $(CMO) $(XLIBPPRZCMA) $(LIBPPRZCMA) +$(MAIN) : $(CMO) @echo OL $@ $(Q)$(OCAMLC) $(OCAMLCFLAGS) $(INCLUDES) $(LIBS) $(LINKPKG) myGtkInit.cmo $(CMO) -o $@ diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index aecc2cbd23..6cd13ca02d 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -36,7 +36,7 @@ else FPIC= endif -OCAMLINCLUDES= -I $(LIBPPRZDIR) -I $(TOOLSDIR) +OCAMLINCLUDES= -I $(TOOLSDIR) PKG = -package pprz,glibivy LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz @@ -51,7 +51,7 @@ SDL_LDFLAGS = $(SDL_LDIRS) $(SDL_LIBS) # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want ML_SDL_LFLAGS = $(foreach u,$(SDL_LDIRS),-ccopt $(u)) $(foreach u,$(SDL_LIBS),-cclib $(u)) libSDL.so ML_SDL_LFLAGS += -dllpath ${PAPARAZZI_SRC}/sw/ground_segment/joystick -INCLUDES += -I `ocamlc -where` +INCLUDES += -I $(shell ocamlc -where) all: test_stick input2ivy @@ -60,12 +60,12 @@ test_stick: test_sdl_stick.o @echo BUILD $@ $(Q)$(CC) -g -O2 -DSTICK_DBG $(GLIB_CFLAGS) -o $@ $^ sdl_stick.c $(GLIB_LDFLAGS) $(SDL_LDFLAGS) -input2ivy: sdl_stick.so input2ivy.cmo $(LIBPPRZCMA) +input2ivy: sdl_stick.so input2ivy.cmo @echo OL $@ $(Q)$(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) # dependency of input2ivy -input2ivy: $(LIBPPRZCMA) $(TOOLSDIR)/fp_proc.cmo +input2ivy: $(TOOLSDIR)/fp_proc.cmo sdl_stick.so : sdl_stick.o ml_sdl_stick.o @echo BUILD $@ diff --git a/sw/ground_segment/tmtc/Makefile b/sw/ground_segment/tmtc/Makefile index ea42850287..814ea6b996 100644 --- a/sw/ground_segment/tmtc/Makefile +++ b/sw/ground_segment/tmtc/Makefile @@ -60,58 +60,58 @@ $(VAR)/boa.conf :$(CONF)/boa.conf sed 's|PAPARAZZI_HOME|$(PAPARAZZI_HOME)|' < $< > $@ -messages : messages.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) +messages : messages.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< -settings : settings.cmo $(XLIBPPRZCMA) $(LIBPPRZCMA) ../cockpit/page_settings.cmo +settings : settings.cmo ../cockpit/page_settings.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo -I ../cockpit gtk_save_settings.cmo saveSettings.cmo page_settings.cmo $< -server : $(SERVERCMO) $(LIBPPRZCMA) +server : $(SERVERCMO) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(SERVERCMO) -server.opt : $(SERVERCMX) $(LIBPPRZCMXA) +server.opt : $(SERVERCMX) @echo OOL $@ $(Q)$(OCAMLOPT) $(INCLUDES) -o $@ -package glibivy,pprz -linkpkg $(SERVERCMX) -link : link.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +link : link.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +ivy_tcp_aircraft : ivy_tcp_aircraft.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +ivy_tcp_controller : ivy_tcp_controller.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +broadcaster : broadcaster.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -ivy2udp : ivy2udp.cmo $(LIBPPRZCMA) +ivy2udp : ivy2udp.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< -dia : dia.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +dia : dia.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -diadec : diadec.cmo $(LIBMULTIMONCMA) $(LIBPPRZCMA) +diadec : diadec.cmo $(LIBMULTIMONCMA) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $(LIBMULTIMONDLL) $< -150m : 150m.cmo $(LIBPPRZCMA) +150m : 150m.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $< diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index aa60507db5..7594894388 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -95,14 +95,14 @@ xml_get.out : lib-pprz.cma xml_get.cmo | opt tests : lib-pprz.cma $(TESTS_CMO) $(Q)$(OCAMLC) $(INCLUDES) -o $@ -package unix,str,xml-light,ivy -linkpkg -I . -dllpath . $^ -GTKCFLAGS := `pkg-config --cflags gtk+-2.0` - %.o : %.c @echo OC $< $(Q)$(OCAMLC) $(FPIC) $(INCLUDES) -package $(PKGCOMMON) -c $< $(XCMO) $(XCMX) myGtkInit.cmo : PKGCOMMON=$(XPKGCOMMON) + +GTKCFLAGS := $(shell pkg-config --cflags gtk+-2.0) ml_gtk_drag.o : ml_gtk_drag.c @echo OC $< $(Q)$(OCAMLC) $(INCLUDES) -package $(PKGCOMMON) -c -ccopt "$(GTKCFLAGS)" $< @@ -141,6 +141,8 @@ caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o @echo OCY $< $(Q)$(OCAMLYACC) $< +# these deps *should* be generated correctly by ocamldep +# somehow this is not the case for all expr_parser.cmo expr_parser.cmx : expr_parser.cmi expr_syntax.cmi expr_parser.cmi : expr_parser.ml expr_syntax.cmi expr_lexer.ml : expr_parser.ml @@ -173,6 +175,7 @@ gtk_papget_led_editor.ml : widgets.glade $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ $(Q)rm $(TMPDIR)/$@_$< + clean : $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index fc7d8291de..7eff8b6343 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -24,7 +24,7 @@ Q=@ include ../Makefile.ocaml -INCLUDES= -I $(LIBPPRZDIR) +INCLUDES= PKG = -package glibivy,pprz LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz XPKG = -package pprz.xlib @@ -35,23 +35,23 @@ TMPDIR ?= /tmp all: play plotter plot sd2log plotprofile openlog2tlm -play : $(LIBPPRZCMA) log_file.cmo play_core.cmo play.cmo +play : log_file.cmo play_core.cmo play.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gtkInit.cmo $^ -play-nox : $(LIBPPRZCMA) play_core.cmo play-nox.cmo +play-nox : play_core.cmo play-nox.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ -plotter : $(LIBPPRZCMA) $(XLIBPPRZCMA) plotter.cmo +plotter : plotter.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ -plot : $(LIBPPRZCMA) $(XLIBPPRZCMA) log_file.cmo gtk_export.cmo export.cmo plot.cmo +plot : log_file.cmo gtk_export.cmo export.cmo plot.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(XLINKPKG) gtkInit.cmo $^ -sd2log : $(LIBPPRZCMA) sd2log.cmo +sd2log : sd2log.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index d2bea01533..d12a3eb96c 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -91,9 +91,6 @@ diffusion : stdlib.cmo diffusion.cmo @echo OC $< $(Q)$(OCAMLC) $(INCLUDES) -c $(PKG) $< -# dependency on lib-pprz -simhitl diffusion gaia: $(LIBPPRZCMA) - clean : $(Q)rm -f *.cm* *~ *.out .depend *.o *.a *.so gaia simhitl diffusion diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 9e244eb308..931ce1af44 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -62,7 +62,6 @@ gtk_process.ml : paparazzicenter.glade pc_common.cmo: gtk_process.cmo -paparazzicenter : $(LIBPPRZCMA) $(XLIBPPRZCMA) paparazzicenter.cmo : gtk_pc.cmo clean: diff --git a/sw/tools/Makefile b/sw/tools/Makefile index 04a06a2595..843326d1e2 100644 --- a/sw/tools/Makefile +++ b/sw/tools/Makefile @@ -37,11 +37,11 @@ gen_flight_plan.out : $(FP_CMO) @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $^ -gen_srtm.out : gen_srtm.ml $(LIBPPRZCMA) +gen_srtm.out : gen_srtm.ml @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) $< -%.out : %.ml gen_common.cmo $(LIBPPRZCMA) +%.out : %.ml gen_common.cmo @echo OL $< $(Q)$(OCAMLC) $(INCLUDES) -o $@ $(LINKPKG) gen_common.cmo $< @@ -53,9 +53,6 @@ gen_srtm.out : gen_srtm.ml $(LIBPPRZCMA) @echo OC $< $(Q)$(OCAMLC) $(INCLUDES) $(PKG) -c $< -# dependency on lib-pprz -gen_flight_plan.out : $(LIBPPRZCMA) - mergelogs: mergelogs.c gcc mergelogs.c -o mergelogs From 9d44b45da521926fd95cbf5fa655532032e2a893 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 21 Mar 2013 15:11:49 +0100 Subject: [PATCH 066/109] [makefile] rename target lib to libpprz for clarity --- Makefile | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Makefile b/Makefile index 18183b9dac..c9f52fac43 100644 --- a/Makefile +++ b/Makefile @@ -112,29 +112,29 @@ conf/%.xml :conf/%.xml.example [ -L $@ ] || [ -f $@ ] || cp $< $@ -ground_segment: print_build_version update_google_version conf lib subdirs commands static +ground_segment: print_build_version update_google_version conf libpprz subdirs commands static static: cockpit tmtc tools sim_static joystick static_h -lib: +libpprz: $(MAKE) -C $(LIB)/ocaml multimon: $(MAKE) -C $(MULTIMON) -cockpit: lib +cockpit: libpprz $(MAKE) -C $(COCKPIT) -tmtc: lib cockpit multimon +tmtc: libpprz cockpit multimon $(MAKE) -C $(TMTC) -tools: lib +tools: libpprz $(MAKE) -C $(TOOLS) -joystick: lib +joystick: libpprz $(MAKE) -C $(JOYSTICK) -sim_static: lib +sim_static: libpprz $(MAKE) -C $(SIMULATOR) ext: @@ -148,9 +148,9 @@ subdirs: $(SUBDIRS) $(SUBDIRS): $(MAKE) -C $@ -$(PPRZCENTER): lib +$(PPRZCENTER): libpprz -$(LOGALIZER): lib +$(LOGALIZER): libpprz static_h: $(GEN_HEADERS) @@ -222,10 +222,10 @@ paparazzi: chmod a+x $@ -install : +install: all $(MAKE) -f Makefile.install PREFIX=$(PREFIX) -uninstall : +uninstall: $(MAKE) -f Makefile.install PREFIX=$(PREFIX) uninstall @@ -278,7 +278,7 @@ test: all replace_current_conf_xml run_tests restore_conf_xml .PHONY: all print_build_version update_google_version ground_segment \ -subdirs $(SUBDIRS) conf ext lib multimon cockpit tmtc tools\ +subdirs $(SUBDIRS) conf ext libpprz multimon cockpit tmtc tools\ static sim_static lpctools commands install uninstall \ clean cleanspaces ab_clean dist_clean distclean dist_clean_irreversible \ test replace_current_conf_xml run_tests restore_conf_xml From 7325f9fec8744d16371c83c63292c095d87e8a80 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 21 Mar 2013 15:16:21 +0100 Subject: [PATCH 067/109] [misc] davis2ivy: suppress unused var warning --- sw/ground_segment/misc/davis2ivy.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sw/ground_segment/misc/davis2ivy.c b/sw/ground_segment/misc/davis2ivy.c index 734fbe9093..b4a876bf14 100644 --- a/sw/ground_segment/misc/davis2ivy.c +++ b/sw/ground_segment/misc/davis2ivy.c @@ -101,7 +101,8 @@ void open_port(const char* device) { /// disable transactions and empty queue void reset_station() { - char newline = '\n', bytes = 0; + char newline = '\n'; + char bytes __attribute__ ((unused)); fprintf(stderr, "Resetting communication\n"); // send a \n (wakeup and cancel all running transmits) bytes = write(fd, &newline, 1); From 77cd732702114aad2803e566997502fcfc14740d Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 21 Mar 2013 16:43:42 +0100 Subject: [PATCH 068/109] [makefile] use mktemp to create unique temp files This assumes that mktemp is available, but should provide a better solution for issue #229. Also create a variable holding the tempfile name which is unique to each target. This should prevent problems with parallel builds, since these variables are global. --- Makefile | 65 ++++++++++++++++++++-------------- Makefile.ac | 57 +++++++++++++++++------------ data/maps/Makefile | 15 ++++---- sw/in_progress/button/Makefile | 11 +++--- sw/lib/ocaml/Makefile | 31 ++++++++-------- sw/logalizer/Makefile | 10 +++--- sw/supervision/Makefile | 17 +++++---- 7 files changed, 112 insertions(+), 94 deletions(-) diff --git a/Makefile b/Makefile index c9f52fac43..4f313de206 100644 --- a/Makefile +++ b/Makefile @@ -93,9 +93,6 @@ ABI_MESSAGES_H=$(STATICINCLUDE)/abi_messages.h GEN_HEADERS = $(MESSAGES_H) $(MESSAGES2_H) $(UBX_PROTOCOL_H) $(MTK_PROTOCOL_H) $(XSENS_PROTOCOL_H) $(DL_PROTOCOL_H) $(DL_PROTOCOL2_H) $(ABI_MESSAGES_H) -# default directory for temporary files -TMPDIR ?= /tmp - all: ground_segment ext lpctools print_build_version: @@ -157,47 +154,61 @@ static_h: $(GEN_HEADERS) $(MESSAGES_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< telemetry > $(TMPDIR)/msg.h - $(Q)mv $(TMPDIR)/msg.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< telemetry > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(MESSAGES2_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< telemetry > $(TMPDIR)/msg2.h - $(Q)mv $(TMPDIR)/msg2.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< telemetry > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(UBX_PROTOCOL_H) : $(UBX_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_ubx.out $< > $(TMPDIR)/ubx.h - $(Q)mv $(TMPDIR)/ubx.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_ubx.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(MTK_PROTOCOL_H) : $(MTK_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_mtk.out $< > $(TMPDIR)/mtk.h - $(Q)mv $(TMPDIR)/mtk.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_mtk.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(XSENS_PROTOCOL_H) : $(XSENS_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_xsens.out $< > $(TMPDIR)/xsens.h - $(Q)mv $(TMPDIR)/xsens.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_xsens.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(DL_PROTOCOL_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< datalink > $(TMPDIR)/dl.h - $(Q)mv $(TMPDIR)/dl.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< datalink > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(DL_PROTOCOL2_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< datalink > $(TMPDIR)/dl2.h - $(Q)mv $(TMPDIR)/dl2.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< datalink > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(ABI_MESSAGES_H) : $(MESSAGES_XML) tools - @echo BUILD $@ - $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_abi.out $< airborne > $(TMPDIR)/abi.h - $(Q)mv $(TMPDIR)/abi.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_abi.out $< airborne > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ include Makefile.ac diff --git a/Makefile.ac b/Makefile.ac index fdd11d5da3..64f79c35f2 100644 --- a/Makefile.ac +++ b/Makefile.ac @@ -62,9 +62,6 @@ endif # telemetry periodic frequency defaults to 60Hz TELEMETRY_FREQUENCY ?= 60 -# default directory for temporary files -TMPDIR ?= /tmp - init: @[ -d $(PAPARAZZI_HOME) ] || (echo "Copying config example in your $(PAPARAZZI_HOME) directory"; mkdir -p $(PAPARAZZI_HOME); cp -a conf $(PAPARAZZI_HOME); cp -a data $(PAPARAZZI_HOME); mkdir -p $(PAPARAZZI_HOME)/var/maps; mkdir -p $(PAPARAZZI_HOME)/var/include) @@ -89,56 +86,70 @@ makefile_ac: $(MAKEFILE_AC) $(AIRFRAME_H) : $(CONF)/$(AIRFRAME_XML) $(CONF_XML) $(AIRCRAFT_MD5) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_airframe.out $(AC_ID) $(AIRCRAFT) $(MD5SUM) $< > $(TMPDIR)/airframe.h - $(Q)mv $(TMPDIR)/airframe.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_airframe.out $(AC_ID) $(AIRCRAFT) $(MD5SUM) $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(Q)cp $(CONF)/airframes/airframe.dtd $(AIRCRAFT_CONF_DIR)/airframes $(RADIO_H) : $(CONF)/$(RADIO) $(CONF_XML) $(TOOLS)/gen_radio.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_radio.out $< > $(TMPDIR)/radio.h - $(Q)mv $(TMPDIR)/radio.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_radio.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ $(Q)cp $< $(AIRCRAFT_CONF_DIR)/radios $(PERIODIC_H) : $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF_XML) $(CONF)/$(TELEMETRY) $(MAKEFILE_AC) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_periodic.out $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_periodic.out $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ - $(Q)cp $< $(AIRCRAFT_CONF_DIR) $(Q)cp $(CONF)/$(TELEMETRY) $(AIRCRAFT_CONF_DIR)/telemetry $(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_flight_plan.out $< > $(TMPDIR)/$(AC_ID)_fp.h - $(Q)mv $(TMPDIR)/$(AC_ID)_fp.h $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_flight_plan.out $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(Q)cp $< $(AIRCRAFT_CONF_DIR)/flight_plans $(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out - @echo BUILD $@ - $(Q)$(TOOLS)/gen_flight_plan.out -dump $< > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_flight_plan.out -dump $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(SETTINGS_H) : $(SETTINGS_XMLS) $(CONF_XML) $(SETTINGS_MODULES) $(SETTINGS_TELEMETRY) $(TOOLS)/gen_settings.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_TELEMETRY) $(SETTINGS_XMLS) $(SETTINGS_MODULES) > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_TELEMETRY) $(SETTINGS_XMLS) $(SETTINGS_MODULES) > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(Q)cp $(SETTINGS_XMLS) $(AIRCRAFT_CONF_DIR)/settings $(MODULES_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_modules.out $(CONF)/modules/*.xml $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_modules.out $(SETTINGS_MODULES) $< > $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_modules.out $(SETTINGS_MODULES) $< > $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(AUTOPILOT_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_autopilot.out $(CONF)/autopilot/*.xml $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) - @echo BUILD $@ - $(Q)$(TOOLS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $@ + @echo GENERATE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)$(TOOLS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $($@_TMP) + $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(SETTINGS_MODULES) : $(MODULES_H) diff --git a/data/maps/Makefile b/data/maps/Makefile index a2cd1e6bc1..2fe5289a7c 100644 --- a/data/maps/Makefile +++ b/data/maps/Makefile @@ -3,9 +3,6 @@ DATADIR = $(PAPARAZZI_HOME)/conf/maps_data Q=@ -# default directory for temporary files -TMPDIR ?= /tmp - all: $(PAPARAZZI_HOME)/conf/maps.xml clean: @@ -25,13 +22,15 @@ $(DATADIR)/maps.google.com: $(DATADIR) FORCE $(PAPARAZZI_HOME)/conf/maps.xml: $(DATADIR)/maps.google.com $(eval GOOGLE_VERSION := $(shell grep -E "http://khm[0-9]+.google.com/kh/v=[0-9]+.x26" $(DATADIR)/maps.google.com | sed -E 's#.*http://khm[0-9]+.google.com/kh/v=##;s#.x26.*##')) + $(eval $@_TMP := $(shell mktemp)) @echo "Updated google maps version to $(GOOGLE_VERSION)" @echo "-----------------------------------------------" - $(Q)echo "" > $(TMPDIR)/maps.xml - $(Q)echo "" >> $(TMPDIR)/maps.xml - $(Q)echo "" >> $(TMPDIR)/maps.xml - $(Q)echo "" >> $(TMPDIR)/maps.xml - $(Q)mv $(TMPDIR)/maps.xml $@ + $(Q)echo "" > $($@_TMP) + $(Q)echo "" >> $($@_TMP) + $(Q)echo "" >> $($@_TMP) + $(Q)echo "" >> $($@_TMP) + $(Q)mv $($@_TMP) $@ + $(Q)chmod a+r $@ FORCE: .PHONY: all clean diff --git a/sw/in_progress/button/Makefile b/sw/in_progress/button/Makefile index f655b57a5d..93edc272b0 100644 --- a/sw/in_progress/button/Makefile +++ b/sw/in_progress/button/Makefile @@ -27,10 +27,6 @@ OCAMLC = ocamlc OCAMLOPT = ocamlopt INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format lablgtk2) -I ../../lib/ocaml -# default directory for temporary files -TMPDIR ?= /tmp - - all: panic $^ @@ -58,8 +54,11 @@ export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx gtk_export.ml : export.glade - grep -v invisible_char $< > $(TMPDIR)/$< - lablgladecc2 -root export -hide-default $(TMPDIR)/$< | grep -B 1000000 " end" > $@ + @echo GLADE $@ + $(eval $@_TMP := $(shell mktemp)) + $(Q)grep -v invisible_char $< > $($@_TMP) + $(Q)lablgladecc2 -root export -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ + $(Q)rm -f $($@_TMP) pt : ahrsview imuview ahrs2fg diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 7594894388..daa0dbf66a 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -32,9 +32,6 @@ OCAMLYACC=ocamlyacc OCAMLMKLIB=ocamlmklib OCAMLLIBDIR=$(shell $(OCAMLC) -where) -# default directory for temporary files -TMPDIR ?= /tmp - # verbose ocamlmklib: Print commands before executing them #VERBOSITY = -verbose VERBOSITY = @@ -153,27 +150,31 @@ expr_syntax.cmo : expr_syntax.cmi gtk_papget_editor.ml : widgets.glade @echo GLADE $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< - $(Q)lablgladecc2 -root papget_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$@_$< + $(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 $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< - $(Q)lablgladecc2 -root table_text_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$@_$< + $(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 $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< - $(Q)lablgladecc2 -root table_gauge_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$@_$< + $(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 $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$@_$< - $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $(TMPDIR)/$@_$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$@_$< + $(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) clean : diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index 7eff8b6343..c4e4b38b02 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -30,9 +30,6 @@ LINKPKG = $(PKG) -linkpkg -dllpath-pkg pprz XPKG = -package pprz.xlib XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib -# default directory for temporary files -TMPDIR ?= /tmp - all: play plotter plot sd2log plotprofile openlog2tlm play : log_file.cmo play_core.cmo play.cmo @@ -83,9 +80,10 @@ export.cmx : gtk_export.cmx gtk_export.ml : export.glade @echo GLADE $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$< - $(Q)lablgladecc2 -root export -hide-default $(TMPDIR)/$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$< + $(eval $@_TMP := $(shell mktemp)) + $(Q)grep -v invisible_char $< > $($@_TMP) + $(Q)lablgladecc2 -root export -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ + $(Q)rm -f $($@_TMP) pt : ahrsview imuview ahrs2fg diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 931ce1af44..92f8bbb95b 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -31,9 +31,6 @@ XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo -# default directory for temporary files -TMPDIR ?= /tmp - all: paparazzicenter paparazzicenter : $(PAPARAZZICENTERCMO) @@ -42,15 +39,17 @@ paparazzicenter : $(PAPARAZZICENTERCMO) gtk_pc.ml : paparazzicenter.glade @echo GLADE $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$< - $(Q)lablgladecc2 -hide-default -root window $(TMPDIR)/$< > $@ - $(Q)rm $(TMPDIR)/$< + $(eval $@_TMP := $(shell mktemp)) + $(Q)grep -v invisible_char $< > $($@_TMP) + $(Q)lablgladecc2 -hide-default -root window $($@_TMP) > $@ + $(Q)rm -f $($@_TMP) gtk_process.ml : paparazzicenter.glade @echo GLADE $@ - $(Q)grep -v invisible_char $< > $(TMPDIR)/$< - $(Q)lablgladecc2 -hide-default -root hbox_program $(TMPDIR)/$< | grep -B 1000000 " end" > $@ - $(Q)rm $(TMPDIR)/$< + $(eval $@_TMP := $(shell mktemp)) + $(Q)grep -v invisible_char $< > $($@_TMP) + $(Q)lablgladecc2 -hide-default -root hbox_program $($@_TMP) | grep -B 1000000 " end" > $@ + $(Q)rm -f $($@_TMP) %.cmo : %.ml @echo OC $< From 0f70beafc47f990a48ac5768b3793d6278094911 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Thu, 21 Mar 2013 17:46:53 +0100 Subject: [PATCH 069/109] [makefile] libpprz: remove double cmi target --- sw/lib/ocaml/Makefile | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index daa0dbf66a..bd8ed60744 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -126,10 +126,6 @@ caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o @echo OC $< $(Q)$(OCAMLC) $(XINCLUDES) $(INCLUDES) -package $(PKGCOMMON),$(XPKGCOMMON) $< -%.cmi : %.ml - @echo OC $< - $(Q)$(OCAMLC) $(XINCLUDES) -package $(PKGCOMMON) -c $< - %.ml : %.mll @echo OCL $< $(Q)$(OCAMLLEX) $< @@ -138,8 +134,8 @@ caml_from_c_example : cserial.o convert.o caml_from_c_example.o camltm.o @echo OCY $< $(Q)$(OCAMLYACC) $< -# these deps *should* be generated correctly by ocamldep -# somehow this is not the case for all +# dependencies not covered by ocamldep +# since these files are generated expr_parser.cmo expr_parser.cmx : expr_parser.cmi expr_syntax.cmi expr_parser.cmi : expr_parser.ml expr_syntax.cmi expr_lexer.ml : expr_parser.ml From d9f86b8051d7d71b83c213f5973b67ae3284eb25 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 21 Mar 2013 18:01:26 +0100 Subject: [PATCH 070/109] [maps] add support for multiple resolution tiles If available in cache, the highest resolution is displayed. Lower resolution are displayed behind higher resolution. TODO: change the max resolution for download at runtime in gcs (startup parameter for now) This should fix #277 and close #364 --- sw/lib/ocaml/gm.ml | 3 +++ sw/lib/ocaml/gm.mli | 2 ++ sw/lib/ocaml/mapCanvas.ml | 16 ++++++++++++++-- sw/lib/ocaml/mapCanvas.mli | 2 ++ sw/lib/ocaml/mapGoogle.ml | 10 ++++++---- 5 files changed, 27 insertions(+), 6 deletions(-) diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 3a92869d0c..789b2db1bd 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -29,6 +29,7 @@ open Printf let tile_size = 256, 256 let zoom_max = 22 +let zoom_min = 18 let cache_path = ref "/var/tmp" @@ -150,6 +151,8 @@ let is_prefix = fun a b -> (** Get the tile or one which contains it from the cache *) let get_from_cache = fun dir f -> let files = Sys.readdir dir in + (* sort files to have the longest names first *) + Array.sort (fun a b -> String.length b - String.length a) files; let rec loop = fun i -> if i < Array.length files then let fi = files.(i) in diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index 7be6cbddaf..008c02243e 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -23,6 +23,8 @@ *) val tile_size : int * int +val zoom_max : int +val zoom_min : int val tile_coverage : float -> int -> float * float (** [tile_coverage wgs84_lat zoom] Returns (width,height) *) diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 82dc10e217..06ba68f4e2 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -152,6 +152,8 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( let canvas = GnoCanvas.canvas ~packing:(frame#pack ~expand:true) () in let background = GnoCanvas.group canvas#root and still = GnoCanvas.group canvas#root in + (* create several layers of canvas group to display the map in correct order *) + let maps = Array.init (Gm.zoom_max - Gm.zoom_min + 1) (fun _ -> GnoCanvas.group background) in let view_cbs = Hashtbl.create 3 in (* Store for view event callback *) let region_rectangle = GnoCanvas.rect canvas#root ~props:[`WIDTH_PIXELS 2; `OUTLINE_COLOR "red"] in @@ -184,6 +186,7 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( method toolbar = toolbar method background = background method still = still + method maps = maps method top_still = 3.5*.s method utc_time = utc_time method set_utc_time = fun h m s -> @@ -373,14 +376,23 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( self#of_world (xw, yw) - method display_pixbuf = fun ?opacity ((x1,y1), geo1) ((x2,y2), geo2) image -> + method display_pixbuf = fun ?opacity ?level ((x1,y1), geo1) ((x2,y2), geo2) image -> let x1 = float x1 and x2 = float x2 and y1 = float y1 and y2 = float y2 in let image = match opacity with None -> image | Some o -> set_opacity image o in - let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1)~pixbuf:image ~props:[`ANCHOR `NW] background in + let map_layer = match level with + | None -> 0 + | Some l -> + if l > Gm.zoom_max then + Array.length maps - 1 + else if l < Gm.zoom_min then + 0 + else l - Gm.zoom_min + in + let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1) ~pixbuf:image ~props:[`ANCHOR `NW] maps.(map_layer) in let xw1, yw1 = self#world_of geo1 and xw2, yw2 = self#world_of geo2 in diff --git a/sw/lib/ocaml/mapCanvas.mli b/sw/lib/ocaml/mapCanvas.mli index 5259c7700d..dc95020615 100644 --- a/sw/lib/ocaml/mapCanvas.mli +++ b/sw/lib/ocaml/mapCanvas.mli @@ -43,6 +43,7 @@ class widget : 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 : @@ -57,6 +58,7 @@ class widget : 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 diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 874b2c15e5..28a6e591e8 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -72,7 +72,7 @@ let add_tile = fun tile_key -> loop 0 [|gm_tiles|] 0 -let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file -> +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 @@ -83,7 +83,7 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file -> 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 in + 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 @@ -103,7 +103,8 @@ let display_tile = fun (geomap:MapCanvas.widget) wgs84 -> let key = desired_tile.Gm.key in if not (mem_tile key) then let (tile, jpg_file) = Gm.get_tile wgs84 1 in - display_the_tile geomap tile jpg_file + let level = String.length tile.Gm.key in + display_the_tile geomap tile jpg_file level exception New_displayed of int @@ -135,7 +136,8 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> | Empty -> if zoom = 1 then let tile, image = Gm.get_image key in - display_the_tile geomap tile image; + 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.create 4 Empty); From b278f9b064cd09d423dfa14886d84c8939e7c202 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 23 Mar 2013 19:25:48 +0100 Subject: [PATCH 071/109] [gcs] minor change on load tile text --- sw/ground_segment/cockpit/gcs.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 4ef18fbaea..7714c42303 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -287,7 +287,7 @@ let button_press = fun (geomap:G.widget) ev -> (`I ("Load BDORTHO", display_bdortho geomap wgs84))::m else m in - GToolbox.popup_menu ~entries:([`I ("Load Google tile", display_gm)]@m) + GToolbox.popup_menu ~entries:([`I ("Load background tile", display_gm)]@m) ~button:3 ~time:(Int32.of_int 0); true end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then From 871a0ca71aec88fdc1ecc85e1eec4d6be6bd90a4 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sat, 23 Mar 2013 23:43:35 +0100 Subject: [PATCH 072/109] [maps] add MapQuest OSM and Open Aerial sources --- sw/lib/ocaml/gm.ml | 10 +++++++--- sw/lib/ocaml/gm.mli | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 789b2db1bd..627a4eca21 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -40,10 +40,10 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM | MS -let maps_sources = [Google; OSM; MS] +type maps_source = Google | OSM | MS | MQ | MQ_Aerial +let maps_sources = [Google; OSM; MS; MQ; MQ_Aerial] let string_of_maps_source = function - Google -> "Google" | OSM -> "OSM" | MS -> "MS" + Google -> "Google" | OSM -> "OpenStreetMap" | MS -> "Bing" | MQ -> "MapQuest OSM" | MQ_Aerial -> "MapQuest Open Aerial" let maps_source = ref Google let set_maps_source = fun s -> maps_source := s @@ -205,6 +205,8 @@ let url_of_tile_key = fun maps_source s -> match maps_source with Google -> sprintf "http://khm0.google.com/kh/v=%d&x=%d&s=&y=%d&z=%d" google_version x y z | OSM -> sprintf "http://tile.openstreetmap.org/%d/%d/%d.png" z x y + | MQ -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/osm/%d/%d/%d.png" z x y + | MQ_Aerial -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/sat/%d/%d/%d.png" z x y | MS -> let (key, last_char) = ms_key s in (* That's the old naming scheme, that still works as of 1st August 2010 @@ -218,6 +220,8 @@ let url_of_tile_key = fun maps_source s -> let get_cache_dir = function Google -> !cache_path (* Historic ! Should be // Google *) | OSM -> !cache_path // "OSM" + | MQ -> !cache_path // "MapQuest" + | MQ_Aerial -> !cache_path // "MapQuestAerial" | MS -> !cache_path // "MS" diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index 008c02243e..a7aa3403af 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -35,7 +35,7 @@ type tile_t = { height : float (* Latitude difference *) } -type maps_source = Google | OSM | MS +type maps_source = Google | OSM | MS | MQ | MQ_Aerial val string_of_maps_source : maps_source -> string val maps_sources : maps_source list val set_maps_source : maps_source -> unit From 2ca78d11bed196ceb3888cadcfd2337fbf6e64e9 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Sun, 24 Mar 2013 00:21:18 +0100 Subject: [PATCH 073/109] [zoom] fix zoom level bound tiles to maps_zoom (cache or http) if lower res available in cache try http according to policy --- sw/ground_segment/cockpit/gcs.ml | 2 +- sw/lib/ocaml/gm.ml | 63 +++++++++++++++++++------------- sw/lib/ocaml/gm.mli | 2 +- sw/lib/ocaml/mapGoogle.ml | 57 ++++++++++++++--------------- sw/lib/ocaml/mapGoogle.mli | 4 +- 5 files changed, 69 insertions(+), 59 deletions(-) diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 7714c42303..75e1d87e54 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -278,7 +278,7 @@ let button_press = fun (geomap:G.widget) ev -> and display_gm = fun () -> TodoList.add (fun () -> - try ignore (MapGoogle.display_tile geomap wgs84) with + try ignore (MapGoogle.display_tile geomap wgs84 !GM.zoomlevel) with Gm.Not_available -> ()) in let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 627a4eca21..737f7fe0c3 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -79,8 +79,12 @@ let gm_pos_and_scale = fun keyholeString tLat latHeight tLon lonWidth -> (** Returns a keyhole string for a longitude (x), latitude (y), and zoom for Google Maps (http://www.ponies.me.uk/maps/GoogleTileUtils.java) *) -let tile_of_geo = fun wgs84 zoom -> - let zoom = zoom_max - zoom in +let tile_of_geo = fun ?level wgs84 zoom -> + let max = match level with + | None -> zoom_max + | Some l -> if l < zoom_min then zoom_min else if l > zoom_max then zoom_max else l + in + let zoom = max - zoom in (* first convert the lat lon to transverse mercator coordinates *) let lon = (Rad>>Deg)wgs84.posn_long in @@ -157,12 +161,14 @@ let get_from_cache = fun dir f -> if i < Array.length files then let fi = files.(i) in let fi_key = try Filename.chop_extension fi with _ -> fi in + (* is it a valid substring ? *) if fi_key <> "" && is_prefix fi_key f then - (tile_of_key fi_key, dir // fi) + (tile_of_key fi_key, dir // fi) else - loop (i+1) + loop (i+1) else - raise Not_found in + raise Not_found + in loop 0 (** Translate the old quadtree naming policy into new (x,y) coordinates @@ -245,30 +251,35 @@ let remove_last_char = fun s -> String.sub s 0 (String.length s - 1) let get_image = fun key -> let cache_dir = get_cache_dir !maps_source in mkdir cache_dir; + let rec get_from_http = fun k -> + if String.length k >= 1 then + let url = url_of_tile_key !maps_source k in + let jpg_file = cache_dir // (k ^ ".jpg") in + try + ignore (Http.file_of_url ~dest:jpg_file url); + tile_of_key k, jpg_file + with + Http.Not_Found _ -> get_from_http (remove_last_char k) + | Http.Blocked _ -> + begin + prerr_endline (Printf.sprintf "Seem to be temporarily blocked, '%s'" url); + raise Not_available + end + | _ -> raise Not_available + else + raise Not_available + in try if !policy = NoCache then raise Not_found; - get_from_cache cache_dir key + let (t, f) = get_from_cache cache_dir key in + (* if not exact match from cache, try http if CacheOrHttp policy *) + if !policy = CacheOrHttp && (String.length t.key < String.length key) then + try get_from_http key with _ -> (t, f) + else (t, f) with - Not_found -> - if !policy = NoHttp then raise Not_available; - let rec loop = fun k -> - if String.length k >= 1 then - let url = url_of_tile_key !maps_source k in - let jpg_file = cache_dir // (k ^ ".jpg") in - try - ignore (Http.file_of_url ~dest:jpg_file url); - tile_of_key k, jpg_file - with - Http.Not_Found _ -> loop (remove_last_char k) - | Http.Blocked _ -> - begin - prerr_endline (Printf.sprintf "Seem to be temporarily blocked, '%s'" url); - raise Not_available - end - | _ -> raise Not_available - else - raise Not_available in - loop key + | Not_found -> + if !policy = NoHttp then raise Not_available; + get_from_http key let rec get_tile = fun wgs84 zoom -> diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index a7aa3403af..80bc47173e 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -42,7 +42,7 @@ val set_maps_source : maps_source -> unit val get_maps_source : unit -> maps_source (** Initialized to Google *) -val tile_of_geo : Latlong.geographic -> int -> tile_t +val tile_of_geo : ?level:int -> Latlong.geographic -> int -> tile_t (** [tile_string geo zoom] Returns the tile description containing a given point with a the smallest available zoom greater or equal to [zoom]. *) diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 28a6e591e8..5c74903f6f 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -97,14 +97,13 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level -> (** Displaying the tile around the given point *) -let display_tile = fun (geomap:MapCanvas.widget) wgs84 -> - let desired_tile = Gm.tile_of_geo wgs84 1 in +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_tile wgs84 1 in - let level = String.length tile.Gm.key in - display_the_tile geomap tile jpg_file level + 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 @@ -131,34 +130,34 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> 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 key in + match trees.(i) with + Tile -> () + | Empty -> + if zoom = 1 then + let tile, image = Gm.get_image 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.create 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 + display_the_tile geomap tile image level; + raise (New_displayed (zoomlevel+1-String.length tile.Gm.key)) + else begin + trees.(i) <- Node (Array.create 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; + 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 + (* 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 + New_displayed z when z = zoom -> + trees.(i) <- Tile | Gm.Not_available -> () in loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t" diff --git a/sw/lib/ocaml/mapGoogle.mli b/sw/lib/ocaml/mapGoogle.mli index 398b38bf24..8bb42f0dc9 100644 --- a/sw/lib/ocaml/mapGoogle.mli +++ b/sw/lib/ocaml/mapGoogle.mli @@ -22,8 +22,8 @@ * *) -val display_tile : MapCanvas.widget -> Latlong.geographic -> unit -(** Displaying the Google Maps tile around the given point (zoom=1) *) +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*) From 9fbac4faa77bd0c652a24bff8b9211628b6e98fa Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Sun, 24 Mar 2013 13:23:21 +0100 Subject: [PATCH 074/109] [supervision] don't launch sitl if popup was canceled --- sw/supervision/pc_control_panel.ml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/sw/supervision/pc_control_panel.ml b/sw/supervision/pc_control_panel.ml index 5b5d4cf03d..2cbfe9b0cf 100644 --- a/sw/supervision/pc_control_panel.ml +++ b/sw/supervision/pc_control_panel.ml @@ -161,17 +161,21 @@ let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo : run_and_monitor ?file gui log "GCS" "" and run_server = fun args -> run_and_monitor ?file gui log "Server" args - and run_sitl = fun ac_name -> + and choose_and_run_sitl = fun ac_name -> let get_args = fun simtype ac_name -> match simtype with "sim" -> sprintf "-a %s -t %s --boot --norc" ac_name simtype | "jsbsim" -> sprintf "-a %s -t %s" ac_name simtype | "nps" -> sprintf "-a %s -t %s" ac_name simtype - | _ -> sprintf "-a %s" ac_name + | _ -> "none" in let sim_type = get_simtype target_combo in let args = get_args sim_type ac_name in - run_and_monitor ?file gui log "Simulator" args + if args <> "none" then begin + run_and_monitor ?file gui log "Simulator" args; + run_and_monitor ?file gui log "GCS" ""; + run_and_monitor ?file gui log "Server" "-n" + end in (* Sessions *) @@ -219,9 +223,7 @@ let supervision = fun ?file gui log (ac_combo : Gtk_tools.combo) (target_combo : (* Simulations *) let simulation = fun () -> - run_sitl (Gtk_tools.combo_value ac_combo); - run_gcs (); - run_server "-n" in + choose_and_run_sitl (Gtk_tools.combo_value ac_combo) in (* Run session *) let callback = fun () -> From 68af55f0b9b68c09dab48b86bd57d4f29a14f48c Mon Sep 17 00:00:00 2001 From: MavLab Date: Thu, 21 Mar 2013 13:34:03 +0100 Subject: [PATCH 075/109] XSens does not propagate GPS altitude to state --- sw/airborne/modules/ins/ins_xsens.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/sw/airborne/modules/ins/ins_xsens.c b/sw/airborne/modules/ins/ins_xsens.c index 13fd1c0e90..af9fd8a545 100644 --- a/sw/airborne/modules/ins/ins_xsens.c +++ b/sw/airborne/modules/ins/ins_xsens.c @@ -248,6 +248,10 @@ void imu_periodic(void) { #if USE_INS_MODULE void ins_init(void) { + struct UtmCoor_f utm0 = { nav_utm_north0, nav_utm_east0, 0., nav_utm_zone0 }; + stateSetLocalUtmOrigin_f(&utm0); + stateSetPositionUtm_f(&utm0); + xsens_init(); } @@ -256,6 +260,22 @@ void ins_periodic(void) { } void ins_update_gps(void) { + struct UtmCoor_f utm; + utm.east = gps.utm_pos.east / 100.; + utm.north = gps.utm_pos.north / 100.; + utm.zone = nav_utm_zone0; + utm.alt = gps.hmsl / 1000.; + + // set position + stateSetPositionUtm_f(&utm); + + struct NedCoor_f ned_vel = { + gps.ned_vel.x / 100., + gps.ned_vel.y / 100., + gps.ned_vel.z / 100. + }; + // set velocity + stateSetSpeedNed_f(&ned_vel); } #endif From d1a78516d1945e195675c45597ca133397196db8 Mon Sep 17 00:00:00 2001 From: Christophe De Wagter Date: Sun, 24 Mar 2013 13:43:49 +0100 Subject: [PATCH 076/109] [telemetry][gps] Downlink which channels the GPS receiver is tuned to when no 3D fix --- sw/airborne/firmwares/fixedwing/ap_downlink.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/airborne/firmwares/fixedwing/ap_downlink.h b/sw/airborne/firmwares/fixedwing/ap_downlink.h index 7034487bc5..c22d64d773 100644 --- a/sw/airborne/firmwares/fixedwing/ap_downlink.h +++ b/sw/airborne/firmwares/fixedwing/ap_downlink.h @@ -230,7 +230,7 @@ DOWNLINK_SEND_GPS(_trans, _dev, &gps.fix, &gps.utm_pos.east, &gps.utm_pos.north, &course, &gps.hmsl, &gps.gspeed, &climb, &gps.week, &gps.tow, &gps.utm_pos.zone, &i); \ if ((gps.fix != GPS_FIX_3D) && (i >= gps.nb_channels)) i = 0; \ if (i >= gps.nb_channels * 2) i = 0; \ - if (i < gps.nb_channels && gps.svinfos[i].cno > 0) { \ + if (i < gps.nb_channels && ((gps.fix != GPS_FIX_3D) || (gps.svinfos[i].cno > 0))) { \ DOWNLINK_SEND_SVINFO(_trans, _dev, &i, &gps.svinfos[i].svid, &gps.svinfos[i].flags, &gps.svinfos[i].qi, &gps.svinfos[i].cno, &gps.svinfos[i].elev, &gps.svinfos[i].azim); \ } \ i++; \ From 68d07e6128eb61bffa1278fd51c5c69c1e3ffc8a Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 25 Mar 2013 13:38:13 +0100 Subject: [PATCH 077/109] [rotorcraft] horizontal guidance fixedpoint fixes Significantly reduce the quantization error of the horizontal guidance cmds. This should result in nicer position hold and better trajectory tracking. Verified in NPS sim. --- .../firmwares/rotorcraft/guidance/guidance_h.c | 16 ++++++++-------- .../firmwares/rotorcraft/guidance/guidance_h.h | 6 +++--- .../rotorcraft/guidance/guidance_h_ref.h | 3 ++- sw/airborne/firmwares/rotorcraft/navigation.c | 2 ++ 4 files changed, 15 insertions(+), 12 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c index 75c60529a6..8e72a4899f 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c @@ -288,15 +288,15 @@ static inline void guidance_h_traj_run(bool_t in_flight) { /* run PID */ guidance_h_command_earth.x = - guidance_h_pgain * (guidance_h_pos_err.x >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + - guidance_h_dgain * (guidance_h_speed_err.x >> (INT32_SPEED_FRAC - GH_GAIN_SCALE)) + - guidance_h_igain * (guidance_h_pos_err_sum.x >> (12 + INT32_POS_FRAC - GH_GAIN_SCALE)) + - guidance_h_again * (guidance_h_accel_ref.x >> 8); /* feedforward gain */ + ((guidance_h_pgain * guidance_h_pos_err.x) >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + + ((guidance_h_dgain * (guidance_h_speed_err.x >> 2)) >> (INT32_SPEED_FRAC - GH_GAIN_SCALE - 2)) + + ((guidance_h_igain * (guidance_h_pos_err_sum.x >> 12)) >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + + ((guidance_h_again * guidance_h_accel_ref.x) >> 8); /* feedforward gain */ guidance_h_command_earth.y = - guidance_h_pgain * (guidance_h_pos_err.y >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + - guidance_h_dgain * (guidance_h_speed_err.y >> (INT32_SPEED_FRAC - GH_GAIN_SCALE)) + - guidance_h_igain * (guidance_h_pos_err_sum.y >> (12 + INT32_POS_FRAC - GH_GAIN_SCALE)) + - guidance_h_again * (guidance_h_accel_ref.y >> 8); /* feedforward gain */ + ((guidance_h_pgain * guidance_h_pos_err.y) >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + + ((guidance_h_dgain * (guidance_h_speed_err.y >> 2)) >> (INT32_SPEED_FRAC - GH_GAIN_SCALE - 2)) + + ((guidance_h_igain * (guidance_h_pos_err_sum.y >> 12)) >> (INT32_POS_FRAC - GH_GAIN_SCALE)) + + ((guidance_h_again * guidance_h_accel_ref.y) >> 8); /* feedforward gain */ VECT2_STRIM(guidance_h_command_earth, -TRAJ_MAX_BANK, TRAJ_MAX_BANK); diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h index aec9bcf361..7bcbdda2c4 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.h @@ -49,9 +49,9 @@ extern uint8_t guidance_h_mode; */ extern struct Int32Vect2 guidance_h_pos_sp; -extern struct Int32Vect2 guidance_h_pos_ref; -extern struct Int32Vect2 guidance_h_speed_ref; -extern struct Int32Vect2 guidance_h_accel_ref; +extern struct Int32Vect2 guidance_h_pos_ref; ///< with #INT32_POS_FRAC +extern struct Int32Vect2 guidance_h_speed_ref; ///< with #INT32_SPEED_FRAC +extern struct Int32Vect2 guidance_h_accel_ref; ///< with #INT32_ACCEL_FRAC extern struct Int32Vect2 guidance_h_pos_err; extern struct Int32Vect2 guidance_h_speed_err; diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h index e3cfa1fa5c..868e2b4026 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h @@ -54,7 +54,8 @@ extern struct Int64Vect2 b2_gh_pos_ref; /* Saturations definition */ #ifndef GUIDANCE_H_REF_MAX_ACCEL -#define GUIDANCE_H_REF_MAX_ACCEL ( tanf(RadOfDeg(30.))*9.81 ) +/* tanf(RadOfDeg(30.))*9.81 = 5.66 */ +#define GUIDANCE_H_REF_MAX_ACCEL 5.66 #endif #define B2_GH_MAX_ACCEL BFP_OF_REAL(GUIDANCE_H_REF_MAX_ACCEL, B2_GH_ACCEL_REF_FRAC) diff --git a/sw/airborne/firmwares/rotorcraft/navigation.c b/sw/airborne/firmwares/rotorcraft/navigation.c index 5166996b58..ba42fb0009 100644 --- a/sw/airborne/firmwares/rotorcraft/navigation.c +++ b/sw/airborne/firmwares/rotorcraft/navigation.c @@ -123,6 +123,7 @@ void nav_run(void) { VECT2_STRIM(path_to_waypoint, -(1<<15), (1<<15)); #if !GUIDANCE_H_USE_REF + PRINT_CONFIG_MSG("NOT using horizontal guidance reference :-(") int32_t dist_to_waypoint; INT32_VECT2_NORM(dist_to_waypoint, path_to_waypoint); @@ -136,6 +137,7 @@ void nav_run(void) { VECT2_SUM(navigation_carrot, path_to_carrot, *stateGetPositionEnu_i()); } #else + PRINT_CONFIG_MSG("Using horizontal guidance reference :-)") // if H_REF is used, CARROT_DIST is not used VECT2_COPY(navigation_carrot, navigation_target); #endif From e43b35b9eb7fa384ce363be9abcbf0b950b78dec Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 25 Mar 2013 17:22:44 +0100 Subject: [PATCH 078/109] [modules] gps_ubx_ucenter: only send DEBUG message if DEBUG_GPS_UBX_UCENTER --- sw/airborne/modules/gps/gps_ubx_ucenter.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/sw/airborne/modules/gps/gps_ubx_ucenter.c b/sw/airborne/modules/gps/gps_ubx_ucenter.c index 36bb492203..8a4e254029 100644 --- a/sw/airborne/modules/gps/gps_ubx_ucenter.c +++ b/sw/airborne/modules/gps/gps_ubx_ucenter.c @@ -359,7 +359,9 @@ static bool_t gps_ubx_ucenter_configure(uint8_t nr) gps_ubx_ucenter.replies[3] = gps_ubx_ucenter.sw_ver_l; gps_ubx_ucenter.replies[4] = gps_ubx_ucenter.hw_ver_h; gps_ubx_ucenter.replies[5] = gps_ubx_ucenter.hw_ver_l; +#if DEBUG_GPS_UBX_UCENTER DOWNLINK_SEND_DEBUG(DefaultChannel, DefaultDevice,6,gps_ubx_ucenter.replies); +#endif ////////////////////////////////// // Actual configuration start @@ -407,8 +409,10 @@ static bool_t gps_ubx_ucenter_configure(uint8_t nr) UbxSend_CFG_CFG(0x00000000,0xffffffff,0x00000000); break; case 16: +#if DEBUG_GPS_UBX_UCENTER // Debug Downlink the result of all configuration steps: see messages DOWNLINK_SEND_DEBUG(DefaultChannel, DefaultDevice,GPS_UBX_UCENTER_CONFIG_STEPS,gps_ubx_ucenter.replies); +#endif return FALSE; default: break; From 8162a35dce25cdb4607389465a3a6e7fe16524ed Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 25 Mar 2013 22:18:04 +0100 Subject: [PATCH 079/109] [python] pep8: 4 spaces, print_function --- .../python/messages_app/messagesframe.py | 186 +++++++++--------- sw/lib/python/messages_tool.py | 92 ++++----- sw/lib/python/messages_xml_map.py | 102 +++++----- sw/lib/python/settings_tool.py | 92 ++++----- sw/lib/python/settings_xml_parse.py | 183 ++++++++--------- 5 files changed, 331 insertions(+), 324 deletions(-) diff --git a/sw/ground_segment/python/messages_app/messagesframe.py b/sw/ground_segment/python/messages_app/messagesframe.py index a0cff926aa..7b3308ff62 100644 --- a/sw/ground_segment/python/messages_app/messagesframe.py +++ b/sw/ground_segment/python/messages_app/messagesframe.py @@ -18,120 +18,120 @@ HEIGHT = 800 BORDER = 1 class MessagesFrame(wx.Frame): - def message_recv(self, ac_id, name, values): - if self.aircrafts.has_key(ac_id): - if self.aircrafts[ac_id].messages.has_key(name): - if time.time() - self.aircrafts[ac_id].messages[name].last_seen < 0.2: - return + def message_recv(self, ac_id, name, values): + if self.aircrafts.has_key(ac_id) and self.aircrafts[ac_id].messages.has_key(name): + if time.time() - self.aircrafts[ac_id].messages[name].last_seen < 0.2: + return - wx.CallAfter(self.gui_update, ac_id, name, values) + wx.CallAfter(self.gui_update, ac_id, name, values) - def find_page(self, book, name): - if book.GetPageCount() < 1: - return 0 - start = 0 - end = book.GetPageCount() + def find_page(self, book, name): + if book.GetPageCount() < 1: + return 0 + start = 0 + end = book.GetPageCount() + + while (start < end): + if book.GetPageText(start) > name: + return start + start = start + 1 - while (start < end): - if book.GetPageText(start) > name: return start - start = start + 1 - return start + def update_leds(self): + wx.CallAfter(self.update_leds_real) - def update_leds(self): - wx.CallAfter(self.update_leds_real) + def update_leds_real(self): + for ac_id in self.aircrafts: + aircraft = self.aircrafts[ac_id] + for msg_str in aircraft.messages: + message = aircraft.messages[msg_str] + if message.last_seen + 0.2 < time.time(): + aircraft.messages_book.SetPageImage(message.index, 0) - def update_leds_real(self): - for ac_id in self.aircrafts: - aircraft = self.aircrafts[ac_id] - for msg_str in aircraft.messages: - message = aircraft.messages[msg_str] - if message.last_seen + 0.2 < time.time(): - aircraft.messages_book.SetPageImage(message.index, 0) + self.timer = threading.Timer(0.1, self.update_leds) + self.timer.start() - self.timer = threading.Timer(0.1, self.update_leds) - self.timer.start() + def setup_image_list(self, notebook): + imageList = wx.ImageList(24,24) - def setup_image_list(self, notebook): - imageList = wx.ImageList(24,24) + image = wx.Image(PPRZ_HOME + "/data/pictures/gray_led24.png") + bitmap = wx.BitmapFromImage(image) + imageList.Add(bitmap) - image = wx.Image(PPRZ_HOME + "/data/pictures/gray_led24.png") - bitmap = wx.BitmapFromImage(image) - imageList.Add(bitmap) + image = wx.Image(PPRZ_HOME + "/data/pictures/green_led24.png") + bitmap = wx.BitmapFromImage(image) + imageList.Add(bitmap) - image = wx.Image(PPRZ_HOME + "/data/pictures/green_led24.png") - bitmap = wx.BitmapFromImage(image) - imageList.Add(bitmap) + notebook.AssignImageList(imageList) - notebook.AssignImageList(imageList) + def add_new_aircraft(self, ac_id): + self.aircrafts[ac_id] = messages_tool.Aircraft(ac_id) + ac_panel = wx.Panel(self.notebook, -1) + self.notebook.AddPage(ac_panel, str(ac_id)) + messages_book = wx.Notebook(ac_panel, style=wx.NB_LEFT) + self.setup_image_list(messages_book) + sizer = wx.BoxSizer(wx.VERTICAL) + sizer.Add(messages_book, 1, wx.EXPAND) + ac_panel.SetSizer(sizer) + sizer.Layout() + self.aircrafts[ac_id].messages_book = messages_book - def add_new_aircraft(self, ac_id): - self.aircrafts[ac_id] = messages_tool.Aircraft(ac_id) - ac_panel = wx.Panel(self.notebook, -1) - self.notebook.AddPage(ac_panel, str(ac_id)) - messages_book = wx.Notebook(ac_panel, style=wx.NB_LEFT) - self.setup_image_list(messages_book) - sizer = wx.BoxSizer(wx.VERTICAL) - sizer.Add(messages_book, 1, wx.EXPAND) - ac_panel.SetSizer(sizer) - sizer.Layout() - self.aircrafts[ac_id].messages_book = messages_book + def add_new_message(self, aircraft, name): + messages_book = aircraft.messages_book + aircraft.messages[name] = messages_tool.Message("telemetry", name) + field_panel = wx.Panel(messages_book) + grid_sizer = wx.FlexGridSizer(len(aircraft.messages[name].field_names), 2) - def add_new_message(self, aircraft, name): - messages_book = aircraft.messages_book - aircraft.messages[name] = messages_tool.Message("telemetry", name) - field_panel = wx.Panel(messages_book) - grid_sizer = wx.FlexGridSizer(len(aircraft.messages[name].field_names), 2) + index = self.find_page(messages_book, name) + messages_book.InsertPage(index, field_panel, name, imageId = 1) + aircraft.messages[name].index = index - index = self.find_page(messages_book, name) - messages_book.InsertPage(index, field_panel, name, imageId = 1) - aircraft.messages[name].index = index + # update indexes of pages which are to be moved + for message_name in aircraft.messages: + aircraft.messages[message_name].index = self.find_page(messages_book, message_name) - # update indexes of pages which are to be moved - for message_name in aircraft.messages: - aircraft.messages[message_name].index = self.find_page(messages_book, message_name) + for field_name in aircraft.messages[name].field_names: + name_text = wx.StaticText(field_panel, -1, field_name) + size = name_text.GetSize() + size.x = LABEL_WIDTH + name_text.SetMinSize(size) + grid_sizer.Add(name_text, 1, wx.ALL, BORDER) + value_control = wx.StaticText(field_panel, -1, "42", style=wx.ST_NO_AUTORESIZE) + size = value_control.GetSize() + size.x = LABEL_WIDTH + value_control.SetMinSize(size) + grid_sizer.Add(value_control, 1, wx.ALL, BORDER) + aircraft.messages[name].field_controls.append(value_control) - for field_name in aircraft.messages[name].field_names: - name_text = wx.StaticText(field_panel, -1, field_name) - size = name_text.GetSize() - size.x = LABEL_WIDTH - name_text.SetMinSize(size) - grid_sizer.Add(name_text, 1, wx.ALL, BORDER) - value_control = wx.StaticText(field_panel, -1, "42", style=wx.ST_NO_AUTORESIZE) - size = value_control.GetSize() - size.x = LABEL_WIDTH - value_control.SetMinSize(size) - grid_sizer.Add(value_control, 1, wx.ALL, BORDER) - aircraft.messages[name].field_controls.append(value_control) - field_panel.SetAutoLayout(True) - field_panel.SetSizer(grid_sizer) - field_panel.Layout() + field_panel.SetAutoLayout(True) + field_panel.SetSizer(grid_sizer) + field_panel.Layout() - def gui_update(self, ac_id, name, values): - if not self.aircrafts.has_key(ac_id): - self.add_new_aircraft(ac_id) + def gui_update(self, ac_id, name, values): + if not self.aircrafts.has_key(ac_id): + self.add_new_aircraft(ac_id) - aircraft = self.aircrafts[ac_id] + aircraft = self.aircrafts[ac_id] - if not aircraft.messages.has_key(name): - self.add_new_message(aircraft, name) + if not aircraft.messages.has_key(name): + self.add_new_message(aircraft, name) - aircraft.messages_book.SetPageImage(aircraft.messages[name].index, 1) - self.aircrafts[ac_id].messages[name].last_seen = time.time() + aircraft.messages_book.SetPageImage(aircraft.messages[name].index, 1) + self.aircrafts[ac_id].messages[name].last_seen = time.time() - for index in range(0, len(values)): - aircraft.messages[name].field_controls[index].SetLabel(values[index]) + for index in range(0, len(values)): + aircraft.messages[name].field_controls[index].SetLabel(values[index]) - def __init__(self): - wx.Frame.__init__(self, id=-1, parent=None, name=u'MessagesFrame', size=wx.Size(WIDTH, HEIGHT), style=wx.DEFAULT_FRAME_STYLE, title=u'Messages') - self.notebook = wx.Notebook(self) - self.aircrafts = {} + def __init__(self): + wx.Frame.__init__(self, id=-1, parent=None, name=u'MessagesFrame', size=wx.Size(WIDTH, HEIGHT), style=wx.DEFAULT_FRAME_STYLE, title=u'Messages') + self.notebook = wx.Notebook(self) + self.aircrafts = {} - sizer = wx.BoxSizer(wx.HORIZONTAL) - sizer.Add(self.notebook, 1, wx.EXPAND) - self.SetSizer(sizer) - sizer.Layout() - self.timer = threading.Timer(0.1, self.update_leds) - self.timer.start() - self.interface = messages_tool.IvyMessagesInterface(self.message_recv) + sizer = wx.BoxSizer(wx.HORIZONTAL) + sizer.Add(self.notebook, 1, wx.EXPAND) + self.SetSizer(sizer) + sizer.Layout() + self.timer = threading.Timer(0.1, self.update_leds) + self.timer.start() + self.interface = messages_tool.IvyMessagesInterface(self.message_recv) diff --git a/sw/lib/python/messages_tool.py b/sw/lib/python/messages_tool.py index e0fa2ed85e..313909c3f1 100644 --- a/sw/lib/python/messages_tool.py +++ b/sw/lib/python/messages_tool.py @@ -1,3 +1,5 @@ +from __future__ import print_function + import messages_xml_map from ivy.std_api import * import logging @@ -5,59 +7,59 @@ import time import os class Message: - def __init__(self, class_name, name): - messages_xml_map.ParseMessages() - self.field_value = [] - self.field_names = messages_xml_map.message_dictionary[class_name][name] - self.field_controls = [] - self.index = None - self.last_seen = time.clock() - self.name = name + def __init__(self, class_name, name): + messages_xml_map.ParseMessages() + self.field_value = [] + self.field_names = messages_xml_map.message_dictionary[class_name][name] + self.field_controls = [] + self.index = None + self.last_seen = time.clock() + self.name = name class Aircraft: - def __init__(self, id): - self.ac_id = id - self.messages = {} - self.messages_book = None + def __init__(self, id): + self.ac_id = id + self.messages = {} + self.messages_book = None class IvyMessagesInterface(): - def __init__(self, callback, initIvy = True): - self.callback = callback - self.ivy_id = 0 - self.InitIvy(initIvy) + def __init__(self, callback, initIvy = True): + self.callback = callback + self.ivy_id = 0 + self.InitIvy(initIvy) - def Stop(self): - IvyUnBindMsg(self.ivy_id) + def Stop(self): + IvyUnBindMsg(self.ivy_id) - def __del__(self): - try: - IvyUnBindMsg(self.ivy_id) - except: - pass + def __init__del__(self): + try: + IvyUnBindMsg(self.ivy_id) + except: + pass - def InitIvy(self, initIvy): - if initIvy: - IvyInit("Messages %i" % os.getpid(), "READY", 0, lambda x,y: y, lambda x,y: y) - logging.getLogger('Ivy').setLevel(logging.WARN) - IvyStart("") - self.ivy_id = IvyBindMsg(self.OnIvyMsg, "(.*)") + def InitIvy(self, initIvy): + if initIvy: + IvyInit("Messages %i" % os.getpid(), "READY", 0, lambda x,y: y, lambda x,y: y) + logging.getLogger('Ivy').setLevel(logging.WARN) + IvyStart("") + self.ivy_id = IvyBindMsg(self.OnIvyMsg, "(.*)") - def OnIvyMsg(self, agent, *larg): - data = larg[0].split(' ') - try: - ac_id = int(data[0]) - name = data[1] - values = data[2:] - self.callback(ac_id, name, values) - except ValueError: - pass - except: - raise + def OnIvyMsg(self, agent, *larg): + data = larg[0].split(' ') + try: + ac_id = int(data[0]) + name = data[1] + values = data[2:] + self.callback(ac_id, name, values) + except ValueError: + pass + except: + raise def test(): - message = Message("WHIRLY") - print message - print message.field_names - + message = Message("WHIRLY") + print(message) + print(message.field_names) + if __name__ == '__main__': - test() + test() diff --git a/sw/lib/python/messages_xml_map.py b/sw/lib/python/messages_xml_map.py index b07975823d..91c4c4f90b 100755 --- a/sw/lib/python/messages_xml_map.py +++ b/sw/lib/python/messages_xml_map.py @@ -1,5 +1,7 @@ #!/usr/bin/env python +from __future__ import print_function + import os import sys import getopt @@ -12,67 +14,65 @@ message_dictionary_id_name = {} message_dictionary_name_id = {} def Usage(scmd): - lpathitem = scmd.split('/') - fmt = '''Usage: %s [-h | --help] [-f FILE | --file=FILE] + lpathitem = scmd.split('/') + fmt = '''Usage: %s [-h | --help] [-f FILE | --file=FILE] where \t-h | --help print this message -\t-f FILE | --file=FILE where FILE is path to messages.xml +\t-f FILE | --file=FILE where FILE is path to messages.xml ''' - print fmt % lpathitem[-1] + print(fmt % lpathitem[-1]) def GetOptions(): - try: - optlist, left_args = getopt.getopt(sys.argv[1:],'hf:', ['help','file=']) - except getopt.GetoptError: - # print help information and exit: - Usage(sys.argv[0]) - sys.exit(2) - for o, a in optlist: - if o in ("-h", "--help"): - Usage(sys.argv[0]) - sys.exit() - elif o in ("-f", "--file"): - messages_path = a + try: + optlist, left_args = getopt.getopt(sys.argv[1:],'hf:', ['help','file=']) + except getopt.GetoptError: + # print help information and exit: + Usage(sys.argv[0]) + sys.exit(2) + for o, a in optlist: + if o in ("-h", "--help"): + Usage(sys.argv[0]) + sys.exit() + elif o in ("-f", "--file"): + messages_path = a def ParseMessages(): - from lxml import etree - tree = etree.parse( messages_path) - for the_class in tree.xpath("//class[@name]"): - class_name = the_class.attrib['name'] - if not message_dictionary.has_key(class_name): - message_dictionary_id_name[class_name] = {} - message_dictionary_name_id[class_name] = {} - message_dictionary[class_name] = {} - message_dictionary_types[class_name] = {} - for the_message in the_class.xpath("message[@name]"): - message_name = the_message.attrib['name'] - if the_message.attrib.has_key('id'): - message_id = the_message.attrib['id'] - else: - message_id = the_message.attrib['ID'] - if (message_id[0:2] == "0x"): - message_id = int(message_id, 16) - else: - message_id = int(message_id) + from lxml import etree + tree = etree.parse( messages_path) + for the_class in tree.xpath("//class[@name]"): + class_name = the_class.attrib['name'] + if not message_dictionary.has_key(class_name): + message_dictionary_id_name[class_name] = {} + message_dictionary_name_id[class_name] = {} + message_dictionary[class_name] = {} + message_dictionary_types[class_name] = {} + for the_message in the_class.xpath("message[@name]"): + message_name = the_message.attrib['name'] + if the_message.attrib.has_key('id'): + message_id = the_message.attrib['id'] + else: + message_id = the_message.attrib['ID'] + if (message_id[0:2] == "0x"): + message_id = int(message_id, 16) + else: + message_id = int(message_id) - message_dictionary_id_name[class_name][message_id] = message_name - message_dictionary_name_id[class_name][message_name] = message_id + message_dictionary_id_name[class_name][message_id] = message_name + message_dictionary_name_id[class_name][message_name] = message_id - # insert this message into our dictionary as a list with room for the fields - message_dictionary[class_name][message_name] = [] - message_dictionary_types[class_name][message_id] = [] + # insert this message into our dictionary as a list with room for the fields + message_dictionary[class_name][message_name] = [] + message_dictionary_types[class_name][message_id] = [] + + for the_field in the_message.xpath('field[@name]'): + # for now, just save the field names -- in the future maybe expand this to save a struct? + message_dictionary[class_name][message_name].append( the_field.attrib['name']) + message_dictionary_types[class_name][message_id].append( the_field.attrib['type']) - for the_field in the_message.xpath('field[@name]'): - # for now, just save the field names -- in the future maybe expand this to save a struct? - message_dictionary[class_name][message_name].append( the_field.attrib['name']) - message_dictionary_types[class_name][message_id].append( the_field.attrib['type']) - def test(): - GetOptions() - ParseMessages() - + GetOptions() + ParseMessages() + if __name__ == '__main__': - test() - - + test() diff --git a/sw/lib/python/settings_tool.py b/sw/lib/python/settings_tool.py index b8b67c1b5f..54c004dbbe 100755 --- a/sw/lib/python/settings_tool.py +++ b/sw/lib/python/settings_tool.py @@ -1,5 +1,7 @@ #!/usr/bin/env python +from __future__ import print_function + from ivy.std_api import * import os import logging @@ -12,73 +14,73 @@ _SHOW_IVY_MSGS_ = False class IvySettingsInterface(PaparazziACSettings): def __init__(self, ac_ids): - PaparazziACSettings.__init__(self, ac_ids[0]) - self.update_callback = None - self.InitIvy() - self.ac_ids = ac_ids + PaparazziACSettings.__init__(self, ac_ids[0]) + self.update_callback = None + self.InitIvy() + self.ac_ids = ac_ids def ProcessMessage(self, message_values, fromRemote): - # Extract aircraft id from message and ignore if not matching - msg_ac_id = int(message_values[0]) - if (msg_ac_id != self.ac_ids[0]): - return + # Extract aircraft id from message and ignore if not matching + msg_ac_id = int(message_values[0]) + if (msg_ac_id != self.ac_ids[0]): + return - # Extract setting value - setting_index = int(message_values[1]) - setting_value = message_values[2] + # Extract setting value + setting_index = int(message_values[1]) + setting_value = message_values[2] - # Store value from message - self.lookup[setting_index].value = setting_value + # Store value from message + self.lookup[setting_index].value = setting_value - # Callback (if present) - if self.update_callback != None: - self.update_callback(setting_index, setting_value, fromRemote) + # Callback (if present) + if self.update_callback != None: + self.update_callback(setting_index, setting_value, fromRemote) - if _SHOW_IVY_MSGS_: - print "index: %s value %s " % (setting_index, setting_value) + if _SHOW_IVY_MSGS_: + print("index: %s value %s " % (setting_index, setting_value)) # Called for DL_VALUE (from aircraft) def OnValueMsg(self, agent, *larg): - # Extract field values - message_values = larg[0].split(' ') - message_values = message_values[0:1] + message_values[2:] - self.ProcessMessage(message_values, True) + # Extract field values + message_values = larg[0].split(' ') + message_values = message_values[0:1] + message_values[2:] + self.ProcessMessage(message_values, True) # Called for DL_SETTING (from ground) def OnSettingMsg(self, agent, *larg): - # Extract field values - message_values = larg[0].split(' ') - self.ProcessMessage(message_values, False) + # Extract field values + message_values = larg[0].split(' ') + self.ProcessMessage(message_values, False) def RegisterCallback(self, callback_function): - self.update_callback = callback_function - - def InitIvy(self): - # initialising the bus - IvyInit("settings_app", # application name for Ivy - "", # ready message - 0, # main loop is local (ie. using IvyMainloop) - lambda x,y: y, # handler called on connection/deconnection - lambda x,y: y # handler called when a diemessage is received - ) + self.update_callback = callback_function - # starting the bus - logging.getLogger('Ivy').setLevel(logging.WARN) - IvyStart("") - IvyBindMsg(self.OnValueMsg, "(^.* DL_VALUE .*)") - IvyBindMsg(self.OnSettingMsg, "dl DL_SETTING (.*)") + def InitIvy(self): + # initialising the bus + IvyInit("settings_app", # application name for Ivy + "", # ready message + 0, # main loop is local (ie. using IvyMainloop) + lambda x,y: y, # handler called on connection/deconnection + lambda x,y: y # handler called when a diemessage is received + ) + + # starting the bus + logging.getLogger('Ivy').setLevel(logging.WARN) + IvyStart("") + IvyBindMsg(self.OnValueMsg, "(^.* DL_VALUE .*)") + IvyBindMsg(self.OnSettingMsg, "dl DL_SETTING (.*)") def SendSetting(self, setting_index): - for ac_id in self.ac_ids: - IvySendMsg("dl DL_SETTING %s %s %s" % (ac_id, setting_index, self.lookup[setting_index].value)) + for ac_id in self.ac_ids: + IvySendMsg("dl DL_SETTING %s %s %s" % (ac_id, setting_index, self.lookup[setting_index].value)) def OnClose(self): IvyStop() def main(): - ac_id = [ 11 ] - ivy_interface = IvySettingsInterface(ac_id) + ac_id = [ 11 ] + ivy_interface = IvySettingsInterface(ac_id) if __name__ == '__main__': - main() + main() diff --git a/sw/lib/python/settings_xml_parse.py b/sw/lib/python/settings_xml_parse.py index db8d064278..b7000578d8 100755 --- a/sw/lib/python/settings_xml_parse.py +++ b/sw/lib/python/settings_xml_parse.py @@ -1,115 +1,118 @@ #!/usr/bin/env python +from __future__ import print_function + import os import sys from lxml import etree # Class for all settings class PaparazziACSettings: - "Paparazzi Settings Class" - ac_id = 0 - groups = [] - lookup = [] - name_lookup = {} - # Takes a string file path for settings XML file and - # returns a settings AC object + "Paparazzi Settings Class" + ac_id = 0 + groups = [] + lookup = [] + name_lookup = {} + # Takes a string file path for settings XML file and + # returns a settings AC object - def __init__(self, ac_id): - self.ac_id = ac_id - paparazzi_home = os.getenv("PAPARAZZI_HOME") - conf_xml_path = "%s/conf/conf.xml" % paparazzi_home - conf_tree = etree.parse(conf_xml_path) - # extract aircraft node from conf.xml file - ac_node = conf_tree.xpath('/conf/aircraft[@ac_id=%i]' % ac_id) - if (len(ac_node) != 1): - print "Aircraft ID %i not found." % ac_id + def __init__(self, ac_id): + self.ac_id = ac_id + paparazzi_home = os.getenv("PAPARAZZI_HOME") + conf_xml_path = "%s/conf/conf.xml" % paparazzi_home + conf_tree = etree.parse(conf_xml_path) + # extract aircraft node from conf.xml file + ac_node = conf_tree.xpath('/conf/aircraft[@ac_id=%i]' % ac_id) + if (len(ac_node) != 1): + print("Aircraft ID %i not found." % ac_id) - # get settings file path from aircraft xml node - settings_xml_path = "%s/conf/%s" % (paparazzi_home, ac_node[0].attrib['settings']) + # get settings file path from aircraft xml node + settings_xml_path = "%s/conf/%s" % (paparazzi_home, ac_node[0].attrib['settings']) - # save AC name for reference - self.name = ac_node[0].attrib['name'] + # save AC name for reference + self.name = ac_node[0].attrib['name'] - tree = etree.parse(settings_xml_path) - - index = 0 # keep track of index/id of setting starting at 0 - for the_tab in tree.xpath("//dl_settings"): - if the_tab.attrib.has_key('NAME'): - setting_group = PaparazziSettingsGroup(the_tab.attrib['NAME']) - elif the_tab.attrib.has_key('NAME'): - setting_group = PaparazziSettingsGroup(the_tab.attrib['name']) - else: - continue - - for the_setting in the_tab.xpath('dl_setting'): - if the_setting.attrib.has_key('shortname'): - name = the_setting.attrib['shortname'] - elif the_setting.attrib.has_key('VAR'): - name = the_setting.attrib['VAR'] - else: - name = the_setting.attrib['var'] - settings = PaparazziSetting(name) - settings.index = index - if the_setting.attrib.has_key('MIN'): - settings.min_value = float(the_setting.attrib['MIN']) - else: - settings.min_value = float(the_setting.attrib['min']) - if the_setting.attrib.has_key('MAX'): - settings.max_value = float(the_setting.attrib['MAX']) - else: - settings.max_value = float(the_setting.attrib['max']) - if the_setting.attrib.has_key('STEP'): - settings.step = float(the_setting.attrib['STEP']) - else: - settings.step = float(the_setting.attrib['step']) - if (the_setting.attrib.has_key('values')): - settings.values = the_setting.attrib['values'].split('|') - count = int((settings.max_value - settings.min_value + settings.step) / settings.step) - if (len(settings.values) != count): - print "Warning: wrong number of values (%i) for %s (expected %i)" % (len(settings.values), name, count) - - setting_group.member_list.append(settings) - self.lookup.append(settings) - self.name_lookup[name] = settings - index = index + 1 - - self.groups.append(setting_group) - def GetACName(self): - return self.name + tree = etree.parse(settings_xml_path) + + index = 0 # keep track of index/id of setting starting at 0 + for the_tab in tree.xpath("//dl_settings"): + if the_tab.attrib.has_key('NAME'): + setting_group = PaparazziSettingsGroup(the_tab.attrib['NAME']) + elif the_tab.attrib.has_key('NAME'): + setting_group = PaparazziSettingsGroup(the_tab.attrib['name']) + else: + continue + + for the_setting in the_tab.xpath('dl_setting'): + if the_setting.attrib.has_key('shortname'): + name = the_setting.attrib['shortname'] + elif the_setting.attrib.has_key('VAR'): + name = the_setting.attrib['VAR'] + else: + name = the_setting.attrib['var'] + settings = PaparazziSetting(name) + settings.index = index + if the_setting.attrib.has_key('MIN'): + settings.min_value = float(the_setting.attrib['MIN']) + else: + settings.min_value = float(the_setting.attrib['min']) + if the_setting.attrib.has_key('MAX'): + settings.max_value = float(the_setting.attrib['MAX']) + else: + settings.max_value = float(the_setting.attrib['max']) + if the_setting.attrib.has_key('STEP'): + settings.step = float(the_setting.attrib['STEP']) + else: + settings.step = float(the_setting.attrib['step']) + + if (the_setting.attrib.has_key('values')): + settings.values = the_setting.attrib['values'].split('|') + count = int((settings.max_value - settings.min_value + settings.step) / settings.step) + if (len(settings.values) != count): + print("Warning: wrong number of values (%i) for %s (expected %i)" % (len(settings.values), name, count)) + + setting_group.member_list.append(settings) + self.lookup.append(settings) + self.name_lookup[name] = settings + index = index + 1 + + self.groups.append(setting_group) + + def GetACName(self): + return self.name # Class for named group of settings class PaparazziSettingsGroup: - "Paparazzi Setting Group Class" - name = 0 - member_list = [] + "Paparazzi Setting Group Class" + name = 0 + member_list = [] - def __init__(self, name): - self.name = name - self.member_list = [] + def __init__(self, name): + self.name = name + self.member_list = [] # Class for a single paparazzi setting class PaparazziSetting: - "Paparazzi Setting Class" - shortname = "" - min_value = 0 - max_value = 1 - step = 1 - index = 0 - value = None - values = None - def __init__(self, shortname): - self.shortname = shortname + "Paparazzi Setting Class" + shortname = "" + min_value = 0 + max_value = 1 + step = 1 + index = 0 + value = None + values = None + + def __init__(self, shortname): + self.shortname = shortname def test(): - ac_id = 164 - ac_settings = PaparazziACSettings(ac_id) - for setting_group in ac_settings.groups: - print setting_group.name + ac_id = 164 + ac_settings = PaparazziACSettings(ac_id) + for setting_group in ac_settings.groups: + print(setting_group.name) for setting in setting_group.member_list: - print " " + setting.shortname + print(" " + setting.shortname) if __name__ == '__main__': - test() - - + test() From e708b14f4a29df8470c9232f8562c5fa3db45f2a Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 25 Mar 2013 23:30:25 +0100 Subject: [PATCH 080/109] [python] fix messages_tool Don't put empty strings in values. This was a problem if IVY messages have a trailing whitespace, should be fixed where the bogus messages are generated as well... --- sw/lib/python/messages_tool.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/lib/python/messages_tool.py b/sw/lib/python/messages_tool.py index 313909c3f1..64b69a8525 100644 --- a/sw/lib/python/messages_tool.py +++ b/sw/lib/python/messages_tool.py @@ -49,7 +49,7 @@ class IvyMessagesInterface(): try: ac_id = int(data[0]) name = data[1] - values = data[2:] + values = filter(None, data[2:]) self.callback(ac_id, name, values) except ValueError: pass From 0bef5c0a6d2a000928c4a0b0a8e4908387006922 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Mon, 25 Mar 2013 23:40:18 +0100 Subject: [PATCH 081/109] [ocaml] untabify, indentation --- sw/ground_segment/cockpit/compass.ml | 72 +- sw/ground_segment/cockpit/editFP.ml | 208 +-- sw/ground_segment/cockpit/gcs.ml | 392 ++--- sw/ground_segment/cockpit/horizon.ml | 120 +- sw/ground_segment/cockpit/live.ml | 698 ++++----- sw/ground_segment/cockpit/map2d.ml | 48 +- sw/ground_segment/cockpit/page_settings.ml | 52 +- sw/ground_segment/cockpit/pages.ml | 220 +-- sw/ground_segment/cockpit/papgets.ml | 220 +-- sw/ground_segment/cockpit/particules.ml | 26 +- sw/ground_segment/cockpit/saveSettings.ml | 10 +- sw/ground_segment/cockpit/sectors.ml | 30 +- sw/ground_segment/cockpit/speech.ml | 4 +- sw/ground_segment/cockpit/strip.ml | 440 +++--- sw/ground_segment/joystick/input2ivy.ml | 272 ++-- sw/ground_segment/multimon/test_gen_hdlc.ml | 4 +- sw/ground_segment/tmtc/150m.ml | 18 +- sw/ground_segment/tmtc/aircraft.ml | 182 +-- sw/ground_segment/tmtc/airprox.ml | 6 +- sw/ground_segment/tmtc/broadcaster.ml | 16 +- sw/ground_segment/tmtc/dia.ml | 30 +- sw/ground_segment/tmtc/diadec.ml | 4 +- sw/ground_segment/tmtc/fw_server.ml | 194 +-- sw/ground_segment/tmtc/ihm.ml | 108 +- sw/ground_segment/tmtc/ivy2udp.ml | 22 +- sw/ground_segment/tmtc/ivy_tcp_aircraft.ml | 22 +- sw/ground_segment/tmtc/ivy_tcp_controller.ml | 24 +- sw/ground_segment/tmtc/kml.ml | 80 +- sw/ground_segment/tmtc/link.ml | 274 ++-- sw/ground_segment/tmtc/messages.ml | 18 +- sw/ground_segment/tmtc/modem.ml | 48 +- sw/ground_segment/tmtc/rotorcraft_server.ml | 140 +- sw/ground_segment/tmtc/server.ml | 332 ++--- sw/ground_segment/tmtc/settings.ml | 2 +- sw/ground_segment/tmtc/stereo_demod.ml | 34 +- sw/ground_segment/tmtc/wind.ml | 100 +- sw/lib/ocaml/base64.ml | 94 +- sw/lib/ocaml/debug.ml | 14 +- sw/lib/ocaml/defivybus.ml | 6 +- sw/lib/ocaml/editAirframe.ml | 52 +- sw/lib/ocaml/env.ml | 18 +- sw/lib/ocaml/expr_syntax.ml | 32 +- sw/lib/ocaml/extXml.ml | 186 +-- sw/lib/ocaml/fig.ml | 654 ++++---- sw/lib/ocaml/geometry_2d.ml | 532 +++---- sw/lib/ocaml/geometry_3d.ml | 312 ++-- sw/lib/ocaml/gm.ml | 68 +- sw/lib/ocaml/gm.mli | 14 +- sw/lib/ocaml/gtk_3d.ml | 1398 +++++++++--------- sw/lib/ocaml/gtk_draw.ml | 20 +- sw/lib/ocaml/gtk_image.ml | 226 +-- sw/lib/ocaml/gtk_tools.ml | 78 +- sw/lib/ocaml/gtk_tools.mli | 24 +- sw/lib/ocaml/gtk_tools_GL.ml | 16 +- sw/lib/ocaml/gtk_tools_icons.ml | 408 ++--- sw/lib/ocaml/gtkgl_Hack.ml | 52 +- sw/lib/ocaml/http.ml | 4 +- sw/lib/ocaml/iGN.ml | 8 +- sw/lib/ocaml/latlong.ml | 234 +-- sw/lib/ocaml/logpprz.ml | 8 +- sw/lib/ocaml/mapCanvas.ml | 870 +++++------ sw/lib/ocaml/mapFP.ml | 306 ++-- sw/lib/ocaml/mapGoogle.ml | 92 +- sw/lib/ocaml/mapTrack.ml | 416 +++--- sw/lib/ocaml/mapWaypoints.ml | 418 +++--- sw/lib/ocaml/ocaml_tools.ml | 48 +- sw/lib/ocaml/os_calls.ml | 8 +- sw/lib/ocaml/papget.ml | 498 +++---- sw/lib/ocaml/papget_common.ml | 2 +- sw/lib/ocaml/papget_renderer.ml | 362 ++--- sw/lib/ocaml/pprz.ml | 326 ++-- sw/lib/ocaml/serial.ml | 72 +- sw/lib/ocaml/srtm.ml | 74 +- sw/lib/ocaml/ubx.ml | 60 +- sw/lib/ocaml/wind_sock.ml | 118 +- sw/lib/ocaml/xbee.ml | 30 +- sw/lib/ocaml/xml2h.ml | 2 +- sw/lib/ocaml/xmlCom.ml | 32 +- sw/lib/ocaml/xmlEdit.ml | 296 ++-- sw/lib/ocaml/xml_get.ml | 6 +- sw/tools/find_free_msg_id.ml | 56 +- sw/tools/fp_proc.ml | 222 +-- sw/tools/gen_abi.ml | 24 +- sw/tools/gen_aircraft.ml | 180 +-- sw/tools/gen_airframe.ml | 152 +- sw/tools/gen_autopilot.ml | 82 +- sw/tools/gen_common.ml | 82 +- sw/tools/gen_flight_plan.ml | 684 ++++----- sw/tools/gen_messages.ml | 138 +- sw/tools/gen_messages2.ml | 176 +-- sw/tools/gen_modules.ml | 148 +- sw/tools/gen_mtk.ml | 98 +- sw/tools/gen_periodic.ml | 16 +- sw/tools/gen_radio.ml | 18 +- sw/tools/gen_settings.ml | 30 +- sw/tools/gen_srtm.ml | 14 +- sw/tools/gen_ubx.ml | 86 +- sw/tools/gen_xsens.ml | 148 +- 98 files changed, 7658 insertions(+), 7660 deletions(-) diff --git a/sw/ground_segment/cockpit/compass.ml b/sw/ground_segment/cockpit/compass.ml index cc666c796d..a83b68c790 100644 --- a/sw/ground_segment/cockpit/compass.ml +++ b/sw/ground_segment/cockpit/compass.ml @@ -1,26 +1,26 @@ (* -* Compass display for a manned vehicle -* -* Copyright (C) 2004-2009 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. -* -*) + * Compass display for a manned vehicle + * + * Copyright (C) 2004-2009 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 @@ -45,9 +45,9 @@ let n = 100 let circle = fun (dr:GDraw.pixmap) (x,y) r -> let r = float r in let points = Array.init n - (fun i -> - let a = float i /. float n *. 2.*.pi in - (x + truncate (r*.cos a), y + truncate (r*.sin a))) in + (fun i -> + let a = float i /. float n *. 2.*.pi in + (x + truncate (r*.cos a), y + truncate (r*.sin a))) in dr#polygon (Array.to_list points) let draw = fun (da_object:Gtk_tools.pixmap_in_drawin_area) desired_course course_opt distance -> @@ -79,14 +79,14 @@ let draw = fun (da_object:Gtk_tools.pixmap_in_drawin_area) desired_course course (* Arrow *) if distance > 5. then match course_opt with - None -> - print_string (4*s) (4*s) "?" - | Some _ -> - let points = List.map (fun (x, y) -> translate (rotation (x*s/2,y*s/2))) arrow in - dr#set_foreground fore; - dr#polygon ~filled:true points; - circle dr (4*s,4*s) (2*s); - circle dr (4*s,4*s) (3*s) + None -> + print_string (4*s) (4*s) "?" + | Some _ -> + let points = List.map (fun (x, y) -> translate (rotation (x*s/2,y*s/2))) arrow in + dr#set_foreground fore; + dr#polygon ~filled:true points; + circle dr (4*s,4*s) (2*s); + circle dr (4*s,4*s) (3*s) else print_string (4*s) (4*s) "STOP"; @@ -101,7 +101,7 @@ let draw = fun (da_object:Gtk_tools.pixmap_in_drawin_area) desired_course course (* Cardinal points *) let rotation = rot (-. course) in let cards = [(0, 10, "N"); (0, -10, "S"); (10, 0, "E"); (-10, 0, "W"); - (7, 7, "NE"); (7, -7, "SE");(-7,-7,"SW");(-7,7,"NW")] in + (7, 7, "NE"); (7, -7, "SE");(-7,-7,"SW");(-7,7,"NW")] in List.iter (fun (x,y,string)-> let (x,y) = translate (rotation ((x*5*s)/20, (y*5*s)/20)) in print_string x y string) @@ -141,9 +141,9 @@ let _ = (* if speed < 1m/s, the course information is not relevant *) course := if Pprz.int_assoc "speed" values > 100 then - Some (float (Pprz.int_assoc "course" values) /. 10.) + Some (float (Pprz.int_assoc "course" values) /. 10.) else - None in + None in ignore (Tm_Pprz.message_bind "GPS" get_gps); let get_desired = fun _ values -> desired_course := (Rad>>Deg) (Pprz.float_assoc "course" values) in diff --git a/sw/ground_segment/cockpit/editFP.ml b/sw/ground_segment/cockpit/editFP.ml index 4d2d4a8c86..6b87f0c156 100644 --- a/sw/ground_segment/cockpit/editFP.ml +++ b/sw/ground_segment/cockpit/editFP.ml @@ -11,12 +11,12 @@ let default_path_maps = Env.paparazzi_home // "data" // "maps" (** Dummy flight plan (for map calibration) *) let dummy_fp = fun latlong -> Xml.Element("flight_plan", - ["lat0", string_of_float ((Rad>>Deg)latlong.posn_lat); - "lon0", string_of_float ((Rad>>Deg)latlong.posn_long); - "alt", "42."; - "MAX_DIST_FROM_HOME", "1000."], - [Xml.Element("waypoints", [],[]); - Xml.Element("blocks", [],[])]) + ["lat0", string_of_float ((Rad>>Deg)latlong.posn_lat); + "lon0", string_of_float ((Rad>>Deg)latlong.posn_long); + "alt", "42."; + "MAX_DIST_FROM_HOME", "1000."], + [Xml.Element("waypoints", [],[]); + Xml.Element("blocks", [],[])]) @@ -25,49 +25,49 @@ let current_fp = ref None (** Wrapper checking there is currently no flight plan loaded *) let if_none = fun f -> match !current_fp with - Some _ -> - GToolbox.message_box "Error" "Only one editable flight plan at a time" - | None -> + Some _ -> + GToolbox.message_box "Error" "Only one editable flight plan at a time" + | None -> f () let set_window_title = fun geomap -> let title_suffix = match !current_fp with - None -> "" - | Some (_fp, xml_file) -> sprintf " (%s)" (Filename.basename xml_file) in + None -> "" + | Some (_fp, xml_file) -> sprintf " (%s)" (Filename.basename xml_file) in match GWindow.toplevel geomap#canvas with - Some w -> - w#set_title (sprintf "Flight Plan Editor%s" title_suffix) - | None -> () + Some w -> + w#set_title (sprintf "Flight Plan Editor%s" title_suffix) + | None -> () let save_fp = fun geomap -> match !current_fp with - None -> () (* Nothing to save *) - | Some (fp, filename) -> + None -> () (* Nothing to save *) + | Some (fp, filename) -> match GToolbox.select_file ~title:"Save Flight Plan" ~filename () with - None -> () - | Some file -> - let f = open_out file in - fprintf f "\n\n"; - fprintf f "%s\n" (ExtXml.to_string_fmt fp#xml); - close_out f; - current_fp := Some (fp, file); - set_window_title geomap + None -> () + | Some file -> + let f = open_out file in + fprintf f "\n\n"; + fprintf f "%s\n" (ExtXml.to_string_fmt fp#xml); + close_out f; + current_fp := Some (fp, file); + set_window_title geomap let close_fp = fun geomap -> match !current_fp with - None -> () (* Nothing to close *) - | Some (fp, _filename) -> + None -> () (* Nothing to close *) + | Some (fp, _filename) -> let close = fun () -> - fp#destroy (); - current_fp := None in + fp#destroy (); + current_fp := None in match GToolbox.question_box ~title:"Closing flight plan" ~buttons:["Close"; "Save&Close"; "Cancel"] "Do you want to save/close ?" with - 2 -> save_fp geomap; close () - | 1 -> close () - | _ -> () + 2 -> save_fp geomap; close () + | 1 -> close () + | _ -> () let load_xml_fp = fun geomap editor_frame _accel_group ?(xml_file=Env.flight_plans_path) xml -> Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml); @@ -75,8 +75,8 @@ let load_xml_fp = fun geomap editor_frame _accel_group ?(xml_file=Env.flight_pla editor_frame#add fp#window; current_fp := Some (fp,xml_file); - (** Add waypoints as geo references *) - List.iter + (** Add waypoints as geo references *) + List.iter (fun w -> let (_i, w) = fp#index w in geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : Latlong.geographic >)) @@ -95,8 +95,8 @@ let new_fp = fun geomap editor_frame accel_group () -> let h = GPack.hbox ~packing:dvbx#pack () in let default_latlong = match geomap#georef with - None -> "WGS84 37.21098 -113.45678" - | Some geo -> Latlong.string_of geo in + None -> "WGS84 37.21098 -113.45678" + | Some geo -> Latlong.string_of geo in let latlong = labelled_entry ~width_chars:25 "Geographic Reference" default_latlong h in let alt0 = labelled_entry ~width_chars:4 "Ground Alt" "380" h in let h = GPack.hbox ~packing:dvbx#pack () in @@ -114,20 +114,20 @@ let new_fp = fun geomap editor_frame accel_group () -> let createfp = GButton.button ~stock:`OK ~packing: h#add () in createfp#grab_default (); ignore(createfp#connect#clicked ~callback: - begin fun _ -> - let xml = Xml.parse_file fp_example in - let s = ExtXml.subst_attrib in - let wgs84 = Latlong.of_string latlong#text in - let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in - let xml = s "lon0" (deg_string_of_rad wgs84.posn_long) xml in - let xml = s "ground_alt" alt0#text xml in - let xml = s "qfu" qfu#text xml in - let xml = s "alt" alt#text xml in - let xml = s "max_dist_from_home" mdfh#text xml in - let xml = s "name" name#text xml in - ignore (load_xml_fp geomap editor_frame accel_group xml); - dialog#destroy () - end); + begin fun _ -> + let xml = Xml.parse_file fp_example in + let s = ExtXml.subst_attrib in + let wgs84 = Latlong.of_string latlong#text in + let xml = s "lat0" (deg_string_of_rad wgs84.posn_lat) xml in + let xml = s "lon0" (deg_string_of_rad wgs84.posn_long) xml in + let xml = s "ground_alt" alt0#text xml in + let xml = s "qfu" qfu#text xml in + let xml = s "alt" alt#text xml in + let xml = s "max_dist_from_home" mdfh#text xml in + let xml = s "name" name#text xml in + ignore (load_xml_fp geomap editor_frame accel_group xml); + dialog#destroy () + end); dialog#show ()) @@ -144,9 +144,9 @@ let load_xml_file = fun geomap editor_frame accel_group xml_file -> geomap#fit_to_window (); set_window_title geomap with - Dtd.Prove_error(e) -> loading_error xml_file (Dtd.prove_error e) - | Dtd.Check_error(e) -> loading_error xml_file (Dtd.check_error e) - | Xml.Error e -> loading_error xml_file (Xml.error e) + Dtd.Prove_error(e) -> loading_error xml_file (Dtd.prove_error e) + | Dtd.Check_error(e) -> loading_error xml_file (Dtd.check_error e) + | Xml.Error e -> loading_error xml_file (Xml.error e) @@ -154,15 +154,15 @@ let load_xml_file = fun geomap editor_frame accel_group xml_file -> let load_fp = fun geomap editor_frame accel_group () -> if_none (fun () -> match GToolbox.select_file ~title:"Open flight plan" ~filename:(Env.flight_plans_path // "*.xml") () with - None -> () - | Some xml_file -> load_xml_file geomap editor_frame accel_group xml_file) + None -> () + | Some xml_file -> load_xml_file geomap editor_frame accel_group xml_file) let create_wp = fun geomap geo -> match !current_fp with - None -> - GToolbox.message_box "Error" "Load a flight plan first"; - failwith "create_wp" - | Some (fp,_) -> + None -> + GToolbox.message_box "Error" "Load a flight plan first"; + failwith "create_wp" + | Some (fp,_) -> let w = fp#add_waypoint geo in geomap#add_info_georef (sprintf "%s" w#name) (w :> < pos : Latlong.geographic >); w @@ -171,57 +171,57 @@ let create_wp = fun geomap geo -> let ref_point_of_waypoint = fun xml -> Xml.Element("point", ["x",Xml.attrib xml "x"; - "y",Xml.attrib xml "y"; - "geo", Xml.attrib xml "name"],[]) + "y",Xml.attrib xml "y"; + "geo", Xml.attrib xml "name"],[]) (** Calibration of chosen image (requires a dummy flight plan) *) let calibrate_map = fun (geomap:MapCanvas.widget) editor_frame accel_group () -> match !current_fp with - | Some (_fp,_) -> GToolbox.message_box "Error" "Close current flight plan before calibration" - | None -> + | Some (_fp,_) -> GToolbox.message_box "Error" "Close current flight plan before calibration" + | None -> match GToolbox.select_file ~filename:(default_path_maps // "") ~title:"Open Image" () with - None -> () - | Some image -> - (** Displaying the image in the NW corner *) - let pixbuf = GdkPixbuf.from_file image in - let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in - let (x0, y0) = geomap#canvas#get_scroll_offsets in - let (x,y) = geomap#canvas#window_to_world (float x0) (float y0) in - pix#move x y; + None -> () + | Some image -> + (** Displaying the image in the NW corner *) + let pixbuf = GdkPixbuf.from_file image in + let pix = GnoCanvas.pixbuf ~pixbuf ~props:[`ANCHOR `NW] geomap#canvas#root in + let (x0, y0) = geomap#canvas#get_scroll_offsets in + let (x,y) = geomap#canvas#window_to_world (float x0) (float y0) in + pix#move x y; - (** Open a dummy flight plan *) - let dummy_georef = - match geomap#georef with - None -> {posn_lat = (Deg>>Rad)43.; posn_long = (Deg>>Rad)1. } - | Some geo -> geo in - let fp_xml = dummy_fp dummy_georef in - let fp = load_xml_fp geomap editor_frame accel_group fp_xml in + (** Open a dummy flight plan *) + let dummy_georef = + match geomap#georef with + None -> {posn_lat = (Deg>>Rad)43.; posn_long = (Deg>>Rad)1. } + | Some geo -> geo in + let fp_xml = dummy_fp dummy_georef in + let fp = load_xml_fp geomap editor_frame accel_group fp_xml in - (** Dialog to finish calibration *) - let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in - let v = GPack.vbox ~packing:dialog#add () in - let _ = GMisc.label ~text:"Choose 2 (or more) waypoints (Ctrl-Left)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210'\nClick the button below to save the XML result file\n" ~packing:v#add () in - let h = GPack.hbox ~packing:v#pack () in - let cancel = GButton.button ~stock:`CLOSE ~packing:h#add () in - let cal = GButton.button ~stock:`OK ~packing:h#add () in - let destroy = fun () -> - dialog#destroy (); - close_fp geomap; - pix#destroy () in - ignore(cancel#connect#clicked ~callback:destroy); - ignore(cal#connect#clicked ~callback:(fun _ -> - let points = List.map XmlEdit.xml_of_node fp#waypoints in - let points = List.map ref_point_of_waypoint points in - let xml = Xml.Element ("map", - ["file", Filename.basename image; - "projection", geomap#projection], - points) in - match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save calibrated map" () with - None -> () - | Some xml_file -> - let f = open_out xml_file in - Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); - close_out f)); - cal#grab_default (); - dialog#show () + (** Dialog to finish calibration *) + let dialog = GWindow.window ~border_width:10 ~title:"Map calibration" () in + let v = GPack.vbox ~packing:dialog#add () in + let _ = GMisc.label ~text:"Choose 2 (or more) waypoints (Ctrl-Left)\nRename the waypoints with their geographic coordinates\nFor example: 'WGS84 43.123456 1.234567' or 'UTM 530134 3987652 12' or 'LBT2e 123456 543210'\nClick the button below to save the XML result file\n" ~packing:v#add () in + let h = GPack.hbox ~packing:v#pack () in + let cancel = GButton.button ~stock:`CLOSE ~packing:h#add () in + let cal = GButton.button ~stock:`OK ~packing:h#add () in + let destroy = fun () -> + dialog#destroy (); + close_fp geomap; + pix#destroy () in + ignore(cancel#connect#clicked ~callback:destroy); + ignore(cal#connect#clicked ~callback:(fun _ -> + let points = List.map XmlEdit.xml_of_node fp#waypoints in + let points = List.map ref_point_of_waypoint points in + let xml = Xml.Element ("map", + ["file", Filename.basename image; + "projection", geomap#projection], + points) in + match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save calibrated map" () with + None -> () + | Some xml_file -> + let f = open_out xml_file in + Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); + close_out f)); + cal#grab_default (); + dialog#show () diff --git a/sw/ground_segment/cockpit/gcs.ml b/sw/ground_segment/cockpit/gcs.ml index 75e1d87e54..572218bc94 100644 --- a/sw/ground_segment/cockpit/gcs.ml +++ b/sw/ground_segment/cockpit/gcs.ml @@ -1,26 +1,26 @@ (* -* Multi aircrafts map display and flight plan editor -* -* Copyright (C) 2004-2009 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. -* -*) + * Multi aircrafts map display and flight plan editor + * + * Copyright (C) 2004-2009 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 G = MapCanvas open Printf @@ -59,57 +59,57 @@ let display_map = fun (geomap:G.widget) xml_map -> truncate (ExtXml.float_attrib p "x"), truncate (ExtXml.float_attrib p "y") in let geo_ref = fun p -> try Latlong.of_string (Xml.attrib p "geo") with - _ -> (* Compatibility with the old UTM format *) - let utm_x = ExtXml.float_attrib p "utm_x" - and utm_y = ExtXml.float_attrib p "utm_y" in - let utm_zone = ExtXml.int_attrib xml_map "utm_zone" in - let utm = {utm_x = utm_x; utm_y = utm_y; utm_zone = utm_zone } in - Latlong.of_utm WGS84 utm in + _ -> (* Compatibility with the old UTM format *) + let utm_x = ExtXml.float_attrib p "utm_x" + and utm_y = ExtXml.float_attrib p "utm_y" in + let utm_zone = ExtXml.int_attrib xml_map "utm_zone" in + let utm = {utm_x = utm_x; utm_y = utm_y; utm_zone = utm_zone } in + Latlong.of_utm WGS84 utm in match Xml.children xml_map with - p1::p2::_ -> - let x1y1 = pix_ref p1 - and x2y2 = pix_ref p2 - and geo1 = geo_ref p1 - and geo2 = geo_ref p2 in + p1::p2::_ -> + let x1y1 = pix_ref p1 + and x2y2 = pix_ref p2 + and geo1 = geo_ref p1 + and geo2 = geo_ref p2 in (* Take this point as a reference for the display if none currently *) - Map2d.set_georef_if_none geomap geo1; + Map2d.set_georef_if_none geomap geo1; - ignore (geomap#display_pixbuf ?opacity ((x1y1),geo1) ((x2y2),geo2) (GdkPixbuf.from_file image)); - geomap#center geo1 - | _ -> failwith (sprintf "display_map: two ref points required") + ignore (geomap#display_pixbuf ?opacity ((x1y1),geo1) ((x2y2),geo2) (GdkPixbuf.from_file image)); + geomap#center geo1 + | _ -> failwith (sprintf "display_map: two ref points required") with - Xml.File_not_found f -> - GToolbox.message_box "Error" (sprintf "File does not exist: %s" f) - | ExtXml.Error s -> + Xml.File_not_found f -> + GToolbox.message_box "Error" (sprintf "File does not exist: %s" f) + | ExtXml.Error s -> GToolbox.message_box "Error" (sprintf "Error in XML file: %s" s) let load_map = fun (geomap:G.widget) () -> match GToolbox.select_file ~title:"Open Map" ~filename:(default_path_maps // "*.xml") () with - None -> () - | Some f -> display_map geomap f + None -> () + | Some f -> display_map geomap f (** Save the given pixbuf calibrated with NW and SE corners *) let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se -> match GToolbox.select_file ~filename:(default_path_maps//".xml") ~title:"Save region map" () with - None -> () - | Some xml_file -> + None -> () + | Some xml_file -> let jpg = Filename.chop_extension xml_file ^ ".png" in GdkPixbuf.save jpg "png" pixbuf; let point = fun (x,y) wgs84 -> - Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in + Xml.Element ("point", ["x",soi x;"y",soi y;"geo", Latlong.string_of wgs84], []) in let width = GdkPixbuf.get_width pixbuf and height = GdkPixbuf.get_height pixbuf in let points = [point (0, 0) nw; point (width, height) se] in let xml = Xml.Element ("map", - ["file", Filename.basename jpg; - "projection", projection], - points) in + ["file", Filename.basename jpg; + "projection", projection], + points) in let f = open_out xml_file in Printf.fprintf f "%s\n" (Xml.to_string_fmt xml); close_out f @@ -119,8 +119,8 @@ let save_map = fun geomap ?(projection=geomap#projection) pixbuf nw se -> (****** Creates a calibrated map from the bitmap (selected region) ***********) let map_from_region = fun (geomap:G.widget) () -> match geomap#region with - None -> GToolbox.message_box "Error" "Select a region (shift-left drag)" - | Some ((xw1,yw1), (xw2,yw2)) -> + None -> GToolbox.message_box "Error" "Select a region (shift-left drag)" + | Some ((xw1,yw1), (xw2,yw2)) -> let xw1, xw2 = min xw1 xw2, max xw1 xw2 and yw1, yw2 = min yw1 yw2, max yw1 yw2 in let (xc1, yc1) = geomap#canvas#w2c xw1 yw1 @@ -130,7 +130,7 @@ let map_from_region = fun (geomap:G.widget) () -> let (x0, y0) = geomap#canvas#get_scroll_offsets in let src_x = xc1 - x0 and src_y = yc1 - y0 in GdkPixbuf.get_from_drawable ~dest ~width ~height ~src_x ~src_y - geomap#canvas#misc#window; + geomap#canvas#misc#window; let nw = geomap#of_world (xw1,yw1) and se = geomap#of_world (xw2,yw2) in save_map geomap dest nw se @@ -177,8 +177,8 @@ module GM = struct let zoomlevel = ref 18 let fill_tiles = fun geomap -> match geomap#georef with - None -> () - | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap !zoomlevel) + None -> () + | Some _ -> TodoList.add (fun () -> MapGoogle.fill_window geomap !zoomlevel) let auto = ref false let update = fun geomap -> @@ -187,21 +187,21 @@ module GM = struct auto := x; update geomap -(** Creates a calibrated map from the Google, OSM tiles (selected region) *) + (** Creates a calibrated map from the Google, OSM tiles (selected region) *) let map_from_tiles = fun (geomap:G.widget) () -> match geomap#region with - None -> GToolbox.message_box "Error" "Select a region (shift-left drag)" - | Some ((xw1,yw1), (xw2,yw2)) -> - let geo1 = geomap#of_world (xw1,yw1) - and geo2 = geomap#of_world (xw2,yw2) in - let sw = { posn_lat = min geo1.posn_lat geo2.posn_lat; - posn_long = min geo1.posn_long geo2.posn_long } - and ne = { posn_lat = max geo1.posn_lat geo2.posn_lat; - posn_long = max geo1.posn_long geo2.posn_long } in - let pix = MapGoogle.pixbuf sw ne !zoomlevel in - let nw = { posn_lat = ne.posn_lat; posn_long = sw.posn_long } - and se = { posn_lat = sw.posn_lat; posn_long = ne.posn_long } in - save_map geomap ~projection:"Mercator" pix nw se + None -> GToolbox.message_box "Error" "Select a region (shift-left drag)" + | Some ((xw1,yw1), (xw2,yw2)) -> + let geo1 = geomap#of_world (xw1,yw1) + and geo2 = geomap#of_world (xw2,yw2) in + let sw = { posn_lat = min geo1.posn_lat geo2.posn_lat; + posn_long = min geo1.posn_long geo2.posn_long } + and ne = { posn_lat = max geo1.posn_lat geo2.posn_lat; + posn_long = max geo1.posn_long geo2.posn_long } in + let pix = MapGoogle.pixbuf sw ne !zoomlevel in + let nw = { posn_lat = ne.posn_lat; posn_long = sw.posn_long } + and se = { posn_lat = sw.posn_lat; posn_long = ne.posn_long } in + save_map geomap ~projection:"Mercator" pix nw se end (* GM module *) let bdortho_size = 400 @@ -226,10 +226,10 @@ let display_bdortho = fun (geomap:G.widget) wgs84 () -> display f else TodoList.add - (fun () -> - let c = sprintf "%s %d %d %d %s" !get_bdortho lx ly r f in - ignore (Sys.command c); - display f) + (fun () -> + let c = sprintf "%s %d %d %d %s" !get_bdortho lx ly r f in + ignore (Sys.command c); + display f) end @@ -277,28 +277,28 @@ let button_press = fun (geomap:G.widget) ev -> TodoList.add (fun () -> MapIGN.display_tile geomap wgs84) and display_gm = fun () -> TodoList.add - (fun () -> - try ignore (MapGoogle.display_tile geomap wgs84 !GM.zoomlevel) with - Gm.Not_available -> ()) in + (fun () -> + try ignore (MapGoogle.display_tile geomap wgs84 !GM.zoomlevel) with + Gm.Not_available -> ()) in let m = if !ign then [`I ("Load IGN tile", display_ign)] else [] in let m = if !get_bdortho <> "" then - (`I ("Load BDORTHO", display_bdortho geomap wgs84))::m + (`I ("Load BDORTHO", display_bdortho geomap wgs84))::m else - m in + m in GToolbox.popup_menu ~entries:([`I ("Load background tile", display_gm)]@m) ~button:3 ~time:(Int32.of_int 0); true end else if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `CONTROL state then - let xc = GdkEvent.Button.x ev in - let yc = GdkEvent.Button.y ev in - let xyw = geomap#canvas#window_to_world xc yc in - let geo = geomap#of_world xyw in - ignore (EditFP.create_wp geomap geo); - true - else - false + let xc = GdkEvent.Button.x ev in + let yc = GdkEvent.Button.y ev in + let xyw = geomap#canvas#window_to_world xc yc in + let geo = geomap#of_world xyw in + ignore (EditFP.create_wp geomap geo); + true + else + false @@ -341,45 +341,45 @@ and hide_fp = ref false let options = [ - "-auto_ortho", Arg.Set auto_ortho, "IGN tiles path"; - "-b", Arg.String (fun x -> ivy_bus := x),(sprintf " Default is %s" !ivy_bus); - "-center", Arg.Set_string center, "Initial map center (e.g. 'WGS84 43.605 1.443')"; - "-center_ac", Arg.Set auto_center_new_ac, "Centers the map on any new A/C"; - "-edit", Arg.Unit (fun () -> edit := true; layout_file := "editor.xml"), "Flight plan editor"; - "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; - "-maps_fill", Arg.Set GM.auto, "Automatically start loading background maps"; - "-maps_zoom", Arg.Set_int GM.zoomlevel, "Background maps zoomlevel (default: 18, max: 22)"; - "-ign", Arg.String (fun s -> ign:=true; IGN.data_path := s), "IGN tiles path"; - "-lambertIIe", Arg.Unit (fun () -> projection:=G.LambertIIe),"Switch to LambertIIe projection"; - "-layout", Arg.Set_string layout_file, (sprintf " GUI layout. Default: %s" !layout_file); - "-m", Arg.String (fun x -> map_files := x :: !map_files), "Map XML description file"; - "-maximize", Arg.Set maximize, "Maximize window"; - "-mercator", Arg.Unit (fun () -> projection:=G.Mercator),"Switch to (Google Maps) Mercator projection, default"; - "-mplayer", Arg.Set_string mplayer, "Launch mplayer with the given argument as X plugin"; - "-no_alarm", Arg.Set no_alarm, "Disables alarm page"; - "-maps_no_http", Arg.Unit (fun () -> Gm.set_policy Gm.NoHttp), "Switch off downloading of maps, always use cached maps"; - "-ortho", Arg.Set_string get_bdortho, "IGN tiles path"; - "-osm", Arg.Unit (fun () -> Gm.set_maps_source Gm.OSM), "Use OpenStreetMap database (default is Google)"; - "-ms", Arg.Unit (fun () -> Gm.set_maps_source Gm.MS), "Use Microsoft maps database (default is Google)"; - "-particules", Arg.Set display_particules, "Display particules"; - "-plugin", Arg.Set_string plugin_window, "External X application (launched with the id of the plugin window as argument)"; - "-ref", Arg.Set_string geo_ref, "Geographic ref (e.g. 'WGS84 43.605 1.443')"; - "-speech", Arg.Set Speech.active, "Enable vocal messages"; - "-srtm", Arg.Set srtm, "Enable SRTM elevation display"; - "-track_size", Arg.Set_int Live.track_size, (sprintf "Default track length (%d)" !Live.track_size); - "-utm", Arg.Unit (fun () -> projection:=G.UTM),"Switch to UTM local projection"; - "-wid", Arg.String (fun s -> wid := Some (Int32.of_string s)), " Id of an existing window to be attached to"; - "-zoom", Arg.Set_float zoom, "Initial zoom"; - "-auto_hide_fp", Arg.Unit (fun () -> Live.auto_hide_fp true; hide_fp := true), "Automatically hide flight plans of unselected aircraft"; - ] + "-auto_ortho", Arg.Set auto_ortho, "IGN tiles path"; + "-b", Arg.String (fun x -> ivy_bus := x),(sprintf " Default is %s" !ivy_bus); + "-center", Arg.Set_string center, "Initial map center (e.g. 'WGS84 43.605 1.443')"; + "-center_ac", Arg.Set auto_center_new_ac, "Centers the map on any new A/C"; + "-edit", Arg.Unit (fun () -> edit := true; layout_file := "editor.xml"), "Flight plan editor"; + "-fullscreen", Arg.Set fullscreen, "Fullscreen window"; + "-maps_fill", Arg.Set GM.auto, "Automatically start loading background maps"; + "-maps_zoom", Arg.Set_int GM.zoomlevel, "Background maps zoomlevel (default: 18, max: 22)"; + "-ign", Arg.String (fun s -> ign:=true; IGN.data_path := s), "IGN tiles path"; + "-lambertIIe", Arg.Unit (fun () -> projection:=G.LambertIIe),"Switch to LambertIIe projection"; + "-layout", Arg.Set_string layout_file, (sprintf " GUI layout. Default: %s" !layout_file); + "-m", Arg.String (fun x -> map_files := x :: !map_files), "Map XML description file"; + "-maximize", Arg.Set maximize, "Maximize window"; + "-mercator", Arg.Unit (fun () -> projection:=G.Mercator),"Switch to (Google Maps) Mercator projection, default"; + "-mplayer", Arg.Set_string mplayer, "Launch mplayer with the given argument as X plugin"; + "-no_alarm", Arg.Set no_alarm, "Disables alarm page"; + "-maps_no_http", Arg.Unit (fun () -> Gm.set_policy Gm.NoHttp), "Switch off downloading of maps, always use cached maps"; + "-ortho", Arg.Set_string get_bdortho, "IGN tiles path"; + "-osm", Arg.Unit (fun () -> Gm.set_maps_source Gm.OSM), "Use OpenStreetMap database (default is Google)"; + "-ms", Arg.Unit (fun () -> Gm.set_maps_source Gm.MS), "Use Microsoft maps database (default is Google)"; + "-particules", Arg.Set display_particules, "Display particules"; + "-plugin", Arg.Set_string plugin_window, "External X application (launched with the id of the plugin window as argument)"; + "-ref", Arg.Set_string geo_ref, "Geographic ref (e.g. 'WGS84 43.605 1.443')"; + "-speech", Arg.Set Speech.active, "Enable vocal messages"; + "-srtm", Arg.Set srtm, "Enable SRTM elevation display"; + "-track_size", Arg.Set_int Live.track_size, (sprintf "Default track length (%d)" !Live.track_size); + "-utm", Arg.Unit (fun () -> projection:=G.UTM),"Switch to UTM local projection"; + "-wid", Arg.String (fun s -> wid := Some (Int32.of_string s)), " Id of an existing window to be attached to"; + "-zoom", Arg.Set_float zoom, "Initial zoom"; + "-auto_hide_fp", Arg.Unit (fun () -> Live.auto_hide_fp true; hide_fp := true), "Automatically hide flight plans of unselected aircraft"; + ] let quit = fun () -> match GToolbox.question_box ~title:"Leaving GCS" ~buttons:["Quit"; "Cancel"] "Do you want to quit ?" with - 1 -> - GMain.Main.quit (); - exit 0 - | _ -> () + 1 -> + GMain.Main.quit (); + exit 0 + | _ -> () let create_geomap = fun switch_fullscreen editor_frame -> let geomap = new G.widget ~srtm:!srtm ~height:500 ~projection:!projection () in @@ -424,7 +424,7 @@ let create_geomap = fun switch_fullscreen editor_frame -> let group = ref None in (* Determine a decent default selected item *) let active_policy = if Gm.get_policy () = Gm.NoHttp then Gm.NoHttp - else Gm.CacheOrHttp in + else Gm.CacheOrHttp in List.iter (fun policy -> let callback = fun b -> if b then Gm.set_policy policy in @@ -480,36 +480,36 @@ let create_geomap = fun switch_fullscreen editor_frame -> let resize = fun (widget:GObj.widget) orientation size -> match size with - Some size -> - if orientation = `HORIZONTAL then - widget#misc#set_size_request ~width:size () - else - widget#misc#set_size_request ~height:size () - | None -> () + Some size -> + if orientation = `HORIZONTAL then + widget#misc#set_size_request ~width:size () + else + widget#misc#set_size_request ~height:size () + | None -> () let rec pack_widgets = fun orientation xml widgets packing -> let size = try Some (ExtXml.int_attrib xml "size") with _ -> None in match String.lowercase (Xml.tag xml) with - "widget" -> - let name = ExtXml.attrib xml "name" in - let widget = - try List.assoc name widgets with - Not_found -> failwith (sprintf "Unknown widget: '%s'" name) - in - resize widget orientation size; - packing widget - | "rows" -> + "widget" -> + let name = ExtXml.attrib xml "name" in + let widget = + try List.assoc name widgets with + Not_found -> failwith (sprintf "Unknown widget: '%s'" name) + in + resize widget orientation size; + packing widget + | "rows" -> let resize = match size with None -> fun _ -> () | Some width -> fun (x:GObj.widget) -> x#misc#set_size_request ~width () in pack_list resize `VERTICAL (Xml.children xml) widgets packing - | "columns" -> + | "columns" -> let resize = match size with None -> fun _ -> () | Some height -> fun (x:GObj.widget) -> x#misc#set_size_request ~height () in pack_list resize `HORIZONTAL (Xml.children xml) widgets packing - | x -> failwith (sprintf "pack_widgets: %s" x) + | x -> failwith (sprintf "pack_widgets: %s" x) and pack_list = fun resize orientation xmls widgets packing -> match xmls with - [] -> () - | x::xs -> + [] -> () + | x::xs -> let paned = GPack.paned orientation ~show:true ~packing () in resize paned#coerce; pack_widgets orientation x widgets paned#add1; @@ -518,34 +518,34 @@ and pack_list = fun resize orientation xmls widgets packing -> let rec find_widget_children = fun name xml -> let xmls = Xml.children xml in match String.lowercase (Xml.tag xml) with - "widget" when ExtXml.attrib xml "name" = name -> xmls - | "rows" | "columns" -> + "widget" when ExtXml.attrib xml "name" = name -> xmls + | "rows" | "columns" -> let rec loop = function [] -> raise Not_found - | x::xs -> - try find_widget_children name x with - Not_found -> loop xs in + | x::xs -> + try find_widget_children name x with + Not_found -> loop xs in loop xmls - | _ -> raise Not_found + | _ -> raise Not_found let rec replace_widget_children = fun name children xml -> let xmls = Xml.children xml and tag = String.lowercase (Xml.tag xml) in match tag with - "widget" -> - Xml.Element("widget", - Xml.attribs xml, - if ExtXml.attrib xml "name" = name then children else xmls) - | "rows" | "columns" -> + "widget" -> + Xml.Element("widget", + Xml.attribs xml, + if ExtXml.attrib xml "name" = name then children else xmls) + | "rows" | "columns" -> let rec loop = function [] -> [] - | x::xs -> - replace_widget_children name children x :: loop xs in + | x::xs -> + replace_widget_children name children x :: loop xs in Xml.Element(tag, - Xml.attribs xml, - loop xmls) - | _ -> xml + Xml.attribs xml, + loop xmls) + | _ -> xml @@ -560,12 +560,12 @@ let save_layout = fun filename contents -> dialog#add_select_button_stock `SAVE `SAVE ; let _ = dialog#set_current_name (Filename.basename filename) in begin match dialog#run (), dialog#filename with - `SAVE, Some name -> - dialog#destroy (); - let f = open_out name in - fprintf f "%s\n" contents; - close_out f - | _ -> dialog#destroy () + `SAVE, Some name -> + dialog#destroy (); + let f = open_out name in + fprintf f "%s\n" contents; + close_out f + | _ -> dialog#destroy () end let listen_dropped_papgets = fun (geomap:G.widget) -> @@ -599,12 +599,12 @@ let () = let pid_plugin = ref None in let kill_plugin = fun () -> match !pid_plugin with - None -> () - | Some pid -> - try - Unix.kill pid (-9); - ignore (Unix.waitpid [] pid) - with _ -> () in + None -> () + | Some pid -> + try + Unix.kill pid (-9); + ignore (Unix.waitpid [] pid) + with _ -> () in let destroy = fun _ -> kill_plugin (); exit 0 in @@ -612,24 +612,24 @@ let () = (** The whole window map2d **) let window, switch_fullscreen = match !wid with - None -> - let icon = GdkPixbuf.from_file Env.icon_file in - let window = GWindow.window ~icon ~title:"GCS" ~border_width:1 ~width ~height ~allow_shrink:true () in - if !maximize then - window#maximize (); - if !fullscreen then - window#fullscreen (); - ignore (window#connect#destroy ~callback:destroy); - let switch_fullscreen = fun () -> - fullscreen := not !fullscreen; - if !fullscreen then - window#fullscreen () - else - window#unfullscreen () in - (window:>GWindow.window_skel),switch_fullscreen + None -> + let icon = GdkPixbuf.from_file Env.icon_file in + let window = GWindow.window ~icon ~title:"GCS" ~border_width:1 ~width ~height ~allow_shrink:true () in + if !maximize then + window#maximize (); + if !fullscreen then + window#fullscreen (); + ignore (window#connect#destroy ~callback:destroy); + let switch_fullscreen = fun () -> + fullscreen := not !fullscreen; + if !fullscreen then + window#fullscreen () + else + window#unfullscreen () in + (window:>GWindow.window_skel),switch_fullscreen - | Some window -> - (GWindow.plug ~window ~width ~height ():>GWindow.window_skel), fun _ -> () in + | Some window -> + (GWindow.plug ~window ~width ~height ():>GWindow.window_skel), fun _ -> () in (* Editor frame *) let editor_frame = GBin.frame () in @@ -655,12 +655,12 @@ let () = let plugin_frame = GPack.vbox ~width:plugin_width () in let widgets = ["map2d", map_frame#coerce; - "strips", Strip.scrolled#coerce; - "aircraft", ac_notebook#coerce; - "editor", editor_frame#coerce; - "alarms", alert_page#coerce; - "altgraph", alt_graph#drawing_area#coerce; - "plugin", plugin_frame#coerce] in + "strips", Strip.scrolled#coerce; + "aircraft", ac_notebook#coerce; + "editor", editor_frame#coerce; + "alarms", alert_page#coerce; + "altgraph", alt_graph#drawing_area#coerce; + "plugin", plugin_frame#coerce] in let the_layout = ExtXml.child layout "0" in pack_widgets `HORIZONTAL the_layout widgets window#add; @@ -675,7 +675,7 @@ let () = let width, height = Gdk.Drawable.get_size window#misc#window in let new_layout = Xml.Element ("layout", ["width", soi width; "height", soi height], [the_new_layout]) in save_layout layout_file (Xml.to_string_fmt new_layout) - in + in ignore (menu_fact#add_item "Save layout" ~key:GdkKeysyms._S ~callback:save_layout); @@ -690,8 +690,8 @@ let () = let restart = fun () -> begin match !pid_plugin with - None -> () - | Some p -> try Unix.kill p Sys.sigkill with _ -> () + None -> () + | Some p -> try Unix.kill p Sys.sigkill with _ -> () end; let com = sprintf "exec %s" com in let dev_null = Unix.descr_of_out_channel (open_out "/dev/null") in @@ -713,15 +713,15 @@ let () = child1#misc#reparent plugin_frame#coerce; (* Strange: the centering does not work if done inside this callback. - It is postponed to be called by the mainloop(). *) + It is postponed to be called by the mainloop(). *) ignore (GMain.Idle.add (fun () -> geomap#center c; false)); in let callback = fun ev -> match GdkEvent.Button.button ev with - 1 -> swap (); true - | 3 -> restart (); true - | _ -> false in + 1 -> swap (); true + | 3 -> restart (); true + | _ -> false in ignore (frame#event#connect#button_press ~callback); ignore (menu_fact#add_item "Swap plugin/map" ~callback:(fun _ -> swap ())); diff --git a/sw/ground_segment/cockpit/horizon.ml b/sw/ground_segment/cockpit/horizon.ml index b280ed056e..93abda1441 100644 --- a/sw/ground_segment/cockpit/horizon.ml +++ b/sw/ground_segment/cockpit/horizon.ml @@ -1,26 +1,26 @@ (* -* Multi aircrafts map display and flight plan editor -* -* Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin / 2011 Tobias Muench, Rolf Noellenburg -* -* 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. -* -*) + * Multi aircrafts map display and flight plan editor + * + * Copyright (C) 2004-2006 ENAC, Pascal Brisset, Antoine Drouin / 2011 Tobias Muench, Rolf Noellenburg + * + * 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 @@ -71,8 +71,8 @@ let ruler = fun ?(index_on_right=false) ~text_props ~max ~scale ~w ~index_width let v = truncate v / step in for i = Pervasives.max 0 (v - 5) to min (v + 5) (Array.length tab - 1) do (* FIXME *) if not tab.(i) then begin - tab.(i) <- true; - draw i + tab.(i) <- true; + draw i end done in @@ -116,7 +116,7 @@ class h = fun ?packing size -> and _bottom = GnoCanvas.rect ~x1:(-.size) ~y1:0. ~x2:size ~y2:(size2*.5.) ~fill_color:"#986701" disc and _line = GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|-.size;0.;size;0.|] ~fill_color:"white" disc and _ = GnoCanvas.line ~points:[|0.;-.size;0.;size|] ~fill_color:"white" disc - in + in let grads = fun ?(text=false) n s a b -> for i = 0 to n do let deg = float i *. a +. b in @@ -124,13 +124,13 @@ class h = fun ?packing size -> ignore (GnoCanvas.line ~points:[|-.s; y; s; y|] ~fill_color:"white" disc); ignore (GnoCanvas.line ~points:[|-.s; -.y; s; -.y|] ~fill_color:"white" disc); if text then - let text = Printf.sprintf "%d" (truncate deg) - and x = 2.*.s in - ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x disc); - ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x:(-.x) disc); - let text = "-"^text in - ignore (GnoCanvas.text ~props:text_props ~text ~y ~x disc); - ignore (GnoCanvas.text ~props:text_props ~text ~y ~x:(-.x) disc); + let text = Printf.sprintf "%d" (truncate deg) + and x = 2.*.s in + ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x disc); + ignore (GnoCanvas.text ~props:text_props ~text ~y:(-.y) ~x:(-.x) disc); + let text = "-"^text in + ignore (GnoCanvas.text ~props:text_props ~text ~y ~x disc); + ignore (GnoCanvas.text ~props:text_props ~text ~y ~x:(-.x) disc); done in let _ = @@ -156,8 +156,8 @@ class h = fun ?packing size -> ignore (GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|-.x;0.;-.x-.s;0.;-.x-.s;s|] ~fill_color:"black" mask); ignore (GnoCanvas.line ~props:[`WIDTH_PIXELS 4] ~points:[|x;0.;x+.s;0.;x+.s;s|] ~fill_color:"black" mask); - (* Top and bottom graduations *) - let g = fun a -> + (* Top and bottom graduations *) + let g = fun a -> let l = GnoCanvas.line~props:[`WIDTH_PIXELS 1] ~fill_color:"white" ~points:[|0.;-.size2;0.;-.1.07*.size2|] mask in l#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in for i = 1 to 5 do @@ -168,13 +168,13 @@ class h = fun ?packing size -> let gg = fun a -> let l = GnoCanvas.line~props:[`WIDTH_PIXELS 2] ~fill_color:"white" ~points:[|0.;-.size2;0.;-.1.15*.size2|] mask in l#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in - gg 30.; gg (-30.); - gg 0.; gg 0.; + gg 30.; gg (-30.); + gg 0.; gg 0.; let _30 = fun a -> let t = GnoCanvas.text ~text:"30" ~props:text_props ~x:0. ~y:(-1.28*.size2) mask in t#affine_relative (affine_pos_and_angle 0. 0. ((Deg>>Rad)a)) in - _30 30.; _30 (-30.) + _30 30.; _30 (-30.) in @@ -197,31 +197,31 @@ class h = fun ?packing size -> ruler ~text_props ~max:3000 ~scale:alt_scale ~w:alt_width ~step:10 ~index_width ~h:(0.75*.size2) g in - object - method set_attitude = fun roll pitch -> - disc#affine_absolute (affine_pos_and_angle (xc+.((sin roll)*.(pitch_scale pitch))) (yc+.pitch_scale pitch*.(cos roll)) (-.roll)) - val mutable max_speed = 0. - val mutable min_speed = max_float - method set_speed = fun (s:float) -> - speed#affine_absolute (affine_pos 0. 0.); - lazy_speed s; - speed#affine_absolute (affine_pos 0. (speed_scale*.s)); - min_speed <- min min_speed s; - max_speed <- max max_speed s; - mi#set [`TEXT (sprintf "%.1f" min_speed)]; - mx#set [`TEXT (sprintf "%.1f" max_speed)] - initializer - ignore (speed#connect#event (function - `BUTTON_PRESS _ev -> - max_speed <- 0.; min_speed <- max_float; true - | _ -> false)) +object + method set_attitude = fun roll pitch -> + disc#affine_absolute (affine_pos_and_angle (xc+.((sin roll)*.(pitch_scale pitch))) (yc+.pitch_scale pitch*.(cos roll)) (-.roll)) + val mutable max_speed = 0. + val mutable min_speed = max_float + method set_speed = fun (s:float) -> + speed#affine_absolute (affine_pos 0. 0.); + lazy_speed s; + speed#affine_absolute (affine_pos 0. (speed_scale*.s)); + min_speed <- min min_speed s; + max_speed <- max max_speed s; + mi#set [`TEXT (sprintf "%.1f" min_speed)]; + mx#set [`TEXT (sprintf "%.1f" max_speed)] + initializer + ignore (speed#connect#event (function + `BUTTON_PRESS _ev -> + max_speed <- 0.; min_speed <- max_float; true + | _ -> false)) - method set_alt = fun (s:float) -> - alt#affine_absolute (affine_pos 0. 0.); - lazy_alt s; - alt#affine_absolute (affine_pos 0. (alt_scale*.s)) + method set_alt = fun (s:float) -> + alt#affine_absolute (affine_pos 0. 0.); + lazy_alt s; + alt#affine_absolute (affine_pos 0. (alt_scale*.s)) - end +end (*****************************************************************************) (* pfd page *) diff --git a/sw/ground_segment/cockpit/live.ml b/sw/ground_segment/cockpit/live.ml index bf49943f1c..635874db3f 100644 --- a/sw/ground_segment/cockpit/live.ml +++ b/sw/ground_segment/cockpit/live.ml @@ -1,26 +1,26 @@ (* -* Real time handling of flying A/Cs -* -* 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. -* -*) + * Real time handling of flying A/Cs + * + * 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 G = MapCanvas open Latlong @@ -54,65 +54,65 @@ let rotate = fun a (x, y) -> (cosa *.x +. sina *.y, -. sina*.x +. cosa *. y) let rec list_casso x = function - [] -> raise Not_found +[] -> raise Not_found | (a,b)::abs -> if x = b then a else list_casso x abs let rec list_iter3 = fun f l1 l2 l3 -> match l1, l2, l3 with - [], [], [] -> () - | x1::x1s, x2::x2s, x3::x3s -> + [], [], [] -> () + | x1::x1s, x2::x2s, x3::x3s -> f x1 x2 x3; list_iter3 f x1s x2s x3s - | _ -> invalid_arg "list_iter3" + | _ -> invalid_arg "list_iter3" type color = string type aircraft = { - ac_name : string; - ac_speech_name : string; - config : Pprz.values; - track : MapTrack.track; - color: color; - fp_group : MapFP.flight_plan; - fp_show : GMenu.check_menu_item; - wp_HOME : MapWaypoints.waypoint option; - fp : Xml.xml; - blocks : (int * string) list; - mutable last_ap_mode : string; - mutable last_stage : int * int; - ir_page : Pages.infrared; - gps_page : Pages.gps; - pfd_page : Horizon.pfd; - misc_page : Pages.misc; - dl_settings_page : Page_settings.settings option; - rc_settings_page : Pages.rc_settings option; - pages : GObj.widget; - notebook_label : GMisc.label; - strip : Strip.t; - mutable first_pos : bool; - mutable last_block_name : string; - mutable in_kill_mode : bool; - mutable speed : float; - mutable alt : float; - mutable target_alt : float; - mutable flight_time : int; - mutable wind_speed : float; - mutable wind_dir : float; (* Rad, clockwise from North *) - mutable ground_prox : bool; - mutable got_track_status_timer : int; - mutable last_dist_to_wp : float; - mutable dl_values : float array; - mutable last_unix_time : float; - mutable airspeed : float - } + ac_name : string; + ac_speech_name : string; + config : Pprz.values; + track : MapTrack.track; + color: color; + fp_group : MapFP.flight_plan; + fp_show : GMenu.check_menu_item; + wp_HOME : MapWaypoints.waypoint option; + fp : Xml.xml; + blocks : (int * string) list; + mutable last_ap_mode : string; + mutable last_stage : int * int; + ir_page : Pages.infrared; + gps_page : Pages.gps; + pfd_page : Horizon.pfd; + misc_page : Pages.misc; + dl_settings_page : Page_settings.settings option; + rc_settings_page : Pages.rc_settings option; + pages : GObj.widget; + notebook_label : GMisc.label; + strip : Strip.t; + mutable first_pos : bool; + mutable last_block_name : string; + mutable in_kill_mode : bool; + mutable speed : float; + mutable alt : float; + mutable target_alt : float; + mutable flight_time : int; + mutable wind_speed : float; + mutable wind_dir : float; (* Rad, clockwise from North *) + mutable ground_prox : bool; + mutable got_track_status_timer : int; + mutable last_dist_to_wp : float; + mutable dl_values : float array; + mutable last_unix_time : float; + mutable airspeed : float +} let aircrafts = Hashtbl.create 3 exception AC_not_found let find_ac = fun ac_id -> - try + try Hashtbl.find aircrafts ac_id with - Not_found -> raise AC_not_found + Not_found -> raise AC_not_found let active_ac = ref "" let get_ac = fun vs -> @@ -184,18 +184,18 @@ let resize_track = fun ac track -> match GToolbox.input_string ~text:(string_of_int track#size) ~title:ac "Track size" with - None -> () - | Some s -> track#resize (int_of_string s) + None -> () + | Some s -> track#resize (int_of_string s) let send_move_waypoint_msg = fun ac i w -> let wgs84 = w#pos in let vs = ["ac_id", Pprz.String ac; - "wp_id", Pprz.Int i; - "lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84.posn_long); - "alt", Pprz.Float w#alt - ] in + "wp_id", Pprz.Int i; + "lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84.posn_long); + "alt", Pprz.Float w#alt + ] in Ground_Pprz.message_send "gcs" "MOVE_WAYPOINT" vs let commit_changes = fun ac -> @@ -204,13 +204,13 @@ let commit_changes = fun ac -> (fun w -> let (i, w) = a.fp_group#index w in if w#moved then - send_move_waypoint_msg ac i w) + send_move_waypoint_msg ac i w) a.fp_group#waypoints let center = fun geomap track () -> match track#last with - None -> () - | Some geo -> + None -> () + | Some geo -> geomap#center geo; geomap#canvas#misc#draw None @@ -250,73 +250,73 @@ let reset_waypoints = fun fp () -> let icon = ref None let show_snapshot = fun (geomap:G.widget) geo_FL geo_BR point pixbuf name ev -> match ev with - | `BUTTON_PRESS _ev -> + | `BUTTON_PRESS _ev -> let image = GMisc.image ~pixbuf () in let icon = image#coerce in begin - match GToolbox.question_box ~title:name ~buttons:["Delete"; "Close"] ~icon "" with - 1 -> - point#destroy () - | _ -> () + match GToolbox.question_box ~title:name ~buttons:["Delete"; "Close"] ~icon "" with + 1 -> + point#destroy () + | _ -> () end; true - | `LEAVE_NOTIFY _ev -> + | `LEAVE_NOTIFY _ev -> begin - match !icon with - None -> () - | Some i -> i#destroy () + match !icon with + None -> () + | Some i -> i#destroy () end; false - | `ENTER_NOTIFY _ev -> + | `ENTER_NOTIFY _ev -> let w = GdkPixbuf.get_width pixbuf and h = GdkPixbuf.get_height pixbuf in icon := Some (geomap#display_pixbuf ((0,0), geo_FL) ((w,h), geo_BR) pixbuf); point#raise_to_top (); false - | _ -> false + | _ -> false let mark = fun (geomap:G.widget) ac_id track plugin_frame -> let i = ref 1 in fun () -> match track#last with - Some geo -> - begin - let group = geomap#background in - let point = geomap#circle ~group ~fill_color:"blue" geo 5. in - point#raise_to_top (); - let lat = (Rad>>Deg)geo.posn_lat - and long = (Rad>>Deg)geo.posn_long in - Tele_Pprz.message_send ac_id "MARK" - ["ac_id", Pprz.String ac_id; - "lat", Pprz.Float lat; - "long", Pprz.Float long]; - let frame = - match plugin_frame with - None -> geomap#canvas#coerce - | Some pf -> pf#coerce in - let width, height = Gdk.Drawable.get_size frame#misc#window in - let dest = GdkPixbuf.create width height() in - GdkPixbuf.get_from_drawable ~dest ~width ~height frame#misc#window; - let name = sprintf "Snapshot-%s-%d_%f_%f_%f.png" ac_id !i lat long (track#last_heading) in - let png = sprintf "%s/var/logs/%s" Env.paparazzi_home name in - GdkPixbuf.save png "png" dest; - incr i; + Some geo -> + begin + let group = geomap#background in + let point = geomap#circle ~group ~fill_color:"blue" geo 5. in + point#raise_to_top (); + let lat = (Rad>>Deg)geo.posn_lat + and long = (Rad>>Deg)geo.posn_long in + Tele_Pprz.message_send ac_id "MARK" + ["ac_id", Pprz.String ac_id; + "lat", Pprz.Float lat; + "long", Pprz.Float long]; + let frame = + match plugin_frame with + None -> geomap#canvas#coerce + | Some pf -> pf#coerce in + let width, height = Gdk.Drawable.get_size frame#misc#window in + let dest = GdkPixbuf.create width height() in + GdkPixbuf.get_from_drawable ~dest ~width ~height frame#misc#window; + let name = sprintf "Snapshot-%s-%d_%f_%f_%f.png" ac_id !i lat long (track#last_heading) in + let png = sprintf "%s/var/logs/%s" Env.paparazzi_home name in + GdkPixbuf.save png "png" dest; + incr i; (* Computing the footprint: front_left and back_right *) - let cam_aperture = 2.4/.1.9 in (* width over distance FIXME *) - let alt = track#last_altitude -. float (Srtm.of_wgs84 geo) in - let width = cam_aperture *. alt in - let height = width *. 3. /. 4. in - let utm = utm_of WGS84 geo in - let a = (Deg>>Rad)track#last_heading in - let (xfl,yfl) = rotate a (-.width/.2., height/.2.) - and (xbr,ybr) = rotate a (width/.2., -.height/.2.) in - let geo_FL = of_utm WGS84 (utm_add utm (xfl,yfl)) - and geo_BR = of_utm WGS84 (utm_add utm (xbr,ybr)) in - ignore (point#connect#event (show_snapshot geomap geo_FL geo_BR point dest name)) - end - | None -> () + let cam_aperture = 2.4/.1.9 in (* width over distance FIXME *) + let alt = track#last_altitude -. float (Srtm.of_wgs84 geo) in + let width = cam_aperture *. alt in + let height = width *. 3. /. 4. in + let utm = utm_of WGS84 geo in + let a = (Deg>>Rad)track#last_heading in + let (xfl,yfl) = rotate a (-.width/.2., height/.2.) + and (xbr,ybr) = rotate a (width/.2., -.height/.2.) in + let geo_FL = of_utm WGS84 (utm_add utm (xfl,yfl)) + and geo_BR = of_utm WGS84 (utm_add utm (xbr,ybr)) in + ignore (point#connect#event (show_snapshot geomap geo_FL geo_BR point dest name)) + end + | None -> () (** Light display of attributes in the flight plan. *) @@ -325,7 +325,7 @@ let attributes_pretty_printer = fun attribs -> let valid = fun a -> let a = String.lowercase a in a <> "no" && a <> "strip_icon" && a <> "strip_button" && a <> "pre_call" - && a <> "post_call" && a <> "key" && a <> "group" in + && a <> "post_call" && a <> "key" && a <> "group" in let sprint_opt = fun b s -> if String.length b > 0 then @@ -341,8 +341,8 @@ let attributes_pretty_printer = fun attribs -> (* Don't print the name of the attribute if there is only one *) match attribs with - [(_, v)] -> v ^ sprint_opt pre_call "]" ^ sprint_opt post_call "[" - | _ -> XmlEdit.string_of_attribs attribs + [(_, v)] -> v ^ sprint_opt pre_call "]" ^ sprint_opt post_call "[" + | _ -> XmlEdit.string_of_attribs attribs (** Load a mission. Returns the XML window *) @@ -392,7 +392,7 @@ let key_press_event = fun keys do_action ev -> end else false with - | _ -> false + | _ -> false @@ -470,9 +470,9 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id let min_bat, max_bat = get_bat_levels af_xml in let alt_shift_plus_plus, alt_shift_plus, alt_shift_minus = get_alt_shift af_xml in let param = { Strip.color = color; min_bat = min_bat; max_bat = max_bat; - alt_shift_plus_plus = alt_shift_plus_plus; - alt_shift_plus = alt_shift_plus; - alt_shift_minus = alt_shift_minus; } in + alt_shift_plus_plus = alt_shift_plus_plus; + alt_shift_plus = alt_shift_plus; + alt_shift_minus = alt_shift_minus; } in (*let strip = Strip.add config color min_bat max_bat in*) let strip = Strip.add config param in strip#connect (fun () -> select_ac acs_notebook ac_id); @@ -488,15 +488,15 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id jump_to_block ac_id id); ignore (reset_wp_menu#connect#activate (reset_waypoints fp)); - (** Monitor waypoints changes *) - List.iter + (** Monitor waypoints changes *) + List.iter (fun w -> let (i, w) = fp#index w in w#set_commit_callback (fun () -> send_move_waypoint_msg ac_id i w)) fp#waypoints; - (** Add waypoints as geo references *) - List.iter + (** Add waypoints as geo references *) + List.iter (fun w -> let (_i, w) = fp#index w in geomap#add_info_georef (sprintf "%s.%s" name w#name) (w :> < pos : Latlong.geographic >)) @@ -509,42 +509,42 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id let id = ExtXml.int_attrib block "no" in begin (* Is it a key short cut ? *) try - let key, modifiers = GtkData.AccelGroup.parse (Xml.attrib block "key") in - keys := (key, (modifiers, id)) :: !keys + let key, modifiers = GtkData.AccelGroup.parse (Xml.attrib block "key") in + keys := (key, (modifiers, id)) :: !keys with - _ -> () + _ -> () end; try (* Is it a strip button ? *) let label = ExtXml.attrib block "strip_button" and block_name = ExtXml.attrib block "name" and group = ExtXml.attrib_or_default block "group" "" in let b = - try (* Is it an icon ? *) - let icon = Xml.attrib block "strip_icon" in - let b = GButton.button () in - let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in - ignore (GMisc.image ~pixbuf ~packing:b#add ()); + try (* Is it an icon ? *) + let icon = Xml.attrib block "strip_icon" in + let b = GButton.button () in + let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in + ignore (GMisc.image ~pixbuf ~packing:b#add ()); (* Drag for Drop *) - let papget = Papget_common.xml "goto_block" "button" - [ "block_name", block_name; - "icon", icon] in - Papget_common.dnd_source b#coerce papget; + let papget = Papget_common.xml "goto_block" "button" + [ "block_name", block_name; + "icon", icon] in + Papget_common.dnd_source b#coerce papget; (* Associates the label as a tooltip *) - tooltips#set_tip b#coerce ~text:label; - b - with - Xml.No_attribute _ -> (* It's not an icon *) + tooltips#set_tip b#coerce ~text:label; + b + with + Xml.No_attribute _ -> (* It's not an icon *) + GButton.button ~label () + | exc -> + fprintf stderr "Error: '%s' Using a standard button" (Printexc.to_string exc); GButton.button ~label () - | exc -> - fprintf stderr "Error: '%s' Using a standard button" (Printexc.to_string exc); - GButton.button ~label () in strip#add_widget b#coerce ~group; ignore (b#connect#clicked (fun _ -> jump_to_block ac_id id)) with - _ -> ()) + _ -> ()) (Xml.children (ExtXml.child (ExtXml.child fp_xml_dump "flight_plan") "blocks")); @@ -603,7 +603,7 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id (** Connect key shortcuts *) let key_press = fun ev -> - key_press_event settings_tab#keys (fun commit -> commit ()) ev in + key_press_event settings_tab#keys (fun commit -> commit ()) ev in ignore (geomap#canvas#event#connect#after#key_press key_press); let tab_label = GPack.hbox () in @@ -622,45 +622,45 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id try let xml_settings = Xml.children (ExtXml.child settings_xml "rc_settings") in if xml_settings = [] then - raise Exit + raise Exit else - let settings_tab = new Pages.rc_settings ~visible xml_settings in - let tab_label = (GMisc.label ~text:"RC Settings" ())#coerce in - ignore (ac_notebook#append_page ~tab_label settings_tab#widget); - Some settings_tab + let settings_tab = new Pages.rc_settings ~visible xml_settings in + let tab_label = (GMisc.label ~text:"RC Settings" ())#coerce in + ignore (ac_notebook#append_page ~tab_label settings_tab#widget); + Some settings_tab with _ -> None in let wp_HOME = let rec loop = function [] -> None | w::ws -> - let (_i, w) = fp#index w in - if w#name = "HOME" then Some w else loop ws in + let (_i, w) = fp#index w in + if w#name = "HOME" then Some w else loop ws in loop fp#waypoints in let ac = { track = track; color = color; last_dist_to_wp = 0.; - fp_group = fp; fp_show = fp_show ; config = config ; - wp_HOME = wp_HOME; fp = fp_xml; - ac_name = name; ac_speech_name = speech_name; - blocks = blocks; last_ap_mode= ""; - last_stage = (-1,-1); - ir_page = ir_page; flight_time = 0; - gps_page = gps_page; - pfd_page = pfd_page; - misc_page = misc_page; - dl_settings_page = dl_settings_page; - rc_settings_page = rc_settings_page; - strip = strip; first_pos = true; - last_block_name = ""; alt = 0.; target_alt = 0.; - in_kill_mode = false; speed = 0.; - wind_dir = 42.; ground_prox = true; - wind_speed = 0.; - pages = ac_frame#coerce; - notebook_label = _label; - got_track_status_timer = 1000; - dl_values = [||]; last_unix_time = 0.; - airspeed = 0. - } in + fp_group = fp; fp_show = fp_show ; config = config ; + wp_HOME = wp_HOME; fp = fp_xml; + ac_name = name; ac_speech_name = speech_name; + blocks = blocks; last_ap_mode= ""; + last_stage = (-1,-1); + ir_page = ir_page; flight_time = 0; + gps_page = gps_page; + pfd_page = pfd_page; + misc_page = misc_page; + dl_settings_page = dl_settings_page; + rc_settings_page = rc_settings_page; + strip = strip; first_pos = true; + last_block_name = ""; alt = 0.; target_alt = 0.; + in_kill_mode = false; speed = 0.; + wind_dir = 42.; ground_prox = true; + wind_speed = 0.; + pages = ac_frame#coerce; + notebook_label = _label; + got_track_status_timer = 1000; + dl_values = [||]; last_unix_time = 0.; + airspeed = 0. + } in Hashtbl.add aircrafts ac_id ac; select_ac acs_notebook ac_id; @@ -670,19 +670,19 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id if misc_page#periodic_send then begin (* FIXME: Disabling the timer would be preferable *) try - let a = (pi/.2. -. ac.wind_dir) - and w = ac.wind_speed in + let a = (pi/.2. -. ac.wind_dir) + and w = ac.wind_speed in - let wind_east = sprintf "%.1f" (-. cos a *. w) - and wind_north = sprintf "%.1f" (-. sin a *. w) - and airspeed = sprintf "%.1f" ac.airspeed in + let wind_east = sprintf "%.1f" (-. cos a *. w) + and wind_north = sprintf "%.1f" (-. sin a *. w) + and airspeed = sprintf "%.1f" ac.airspeed in - let msg_items = ["WIND_INFO"; ac_id; "42"; wind_east; wind_north;airspeed] in - let value = String.concat ";" msg_items in - let vs = ["ac_id", Pprz.String ac_id; "message", Pprz.String value] in - Ground_Pprz.message_send "dl" "RAW_DATALINK" vs; + let msg_items = ["WIND_INFO"; ac_id; "42"; wind_east; wind_north;airspeed] in + let value = String.concat ";" msg_items in + let vs = ["ac_id", Pprz.String ac_id; "message", Pprz.String value] in + Ground_Pprz.message_send "dl" "RAW_DATALINK" vs; with - exc -> log alert ac_id (sprintf "send_wind (%s): %s" ac_id (Printexc.to_string exc)) + exc -> log alert ac_id (sprintf "send_wind (%s): %s" ac_id (Printexc.to_string exc)) end; true in @@ -692,49 +692,49 @@ let create_ac = fun alert (geomap:G.widget) (acs_notebook:GPack.notebook) (ac_id begin match dl_settings_page with - Some settings_tab -> - (** Connect the strip buttons *) - let connect = fun ?(warning=true) setting_name strip_connect -> - try - let id = settings_tab#assoc setting_name in - strip_connect (fun x -> dl_setting_callback id x) - with Not_found -> - if warning then - fprintf stderr "Warning: %s not setable from GCS strip (i.e. not listed in the xml settings file)" setting_name in + Some settings_tab -> + (** Connect the strip buttons *) + let connect = fun ?(warning=true) setting_name strip_connect -> + try + let id = settings_tab#assoc setting_name in + strip_connect (fun x -> dl_setting_callback id x) + with Not_found -> + if warning then + fprintf stderr "Warning: %s not setable from GCS strip (i.e. not listed in the xml settings file)" setting_name in - connect "flight_altitude" (fun f -> ac.strip#connect_shift_alt (fun x -> f (ac.target_alt+.x))); - connect "launch" ac.strip#connect_launch; - connect "kill_throttle" ac.strip#connect_kill; - connect "nav_shift" ac.strip#connect_shift_lateral; - connect "pprz_mode" ac.strip#connect_mode; - connect "autopilot_flight_time" ac.strip#connect_flight_time; - let get_ac_unix_time = fun () -> ac.last_unix_time in - connect ~warning:false "snav_desired_tow" (ac.strip#connect_apt get_ac_unix_time); - begin (* Periodically update the appointment *) - try - let id = settings_tab#assoc "snav_desired_tow" in - let set_appointment = fun _ -> - begin try - let v = ac.dl_values.(id) in - let t = Unix.gmtime (Latlong.unix_time_of_tow (truncate v)) in - ac.strip#set_label "apt" (sprintf "%d:%02d:%02d" t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec) - with _ -> () end; - true - in - ignore (Glib.Timeout.add 1000 set_appointment) - with Not_found -> () - end; + connect "flight_altitude" (fun f -> ac.strip#connect_shift_alt (fun x -> f (ac.target_alt+.x))); + connect "launch" ac.strip#connect_launch; + connect "kill_throttle" ac.strip#connect_kill; + connect "nav_shift" ac.strip#connect_shift_lateral; + connect "pprz_mode" ac.strip#connect_mode; + connect "autopilot_flight_time" ac.strip#connect_flight_time; + let get_ac_unix_time = fun () -> ac.last_unix_time in + connect ~warning:false "snav_desired_tow" (ac.strip#connect_apt get_ac_unix_time); + begin (* Periodically update the appointment *) + try + let id = settings_tab#assoc "snav_desired_tow" in + let set_appointment = fun _ -> + begin try + let v = ac.dl_values.(id) in + let t = Unix.gmtime (Latlong.unix_time_of_tow (truncate v)) in + ac.strip#set_label "apt" (sprintf "%d:%02d:%02d" t.Unix.tm_hour t.Unix.tm_min t.Unix.tm_sec) + with _ -> () end; + true + in + ignore (Glib.Timeout.add 1000 set_appointment) + with Not_found -> () + end; (** Connect the GPS reset button *) - begin - try - let gps_reset_id = settings_tab#assoc "gps.reset" in - gps_page#connect_reset - (fun x -> dl_setting_callback gps_reset_id (float x)) - with Not_found -> - prerr_endline "Warning: GPS reset not setable from GCS (i.e. 'gps.reset' not listed in the xml settings file)" - end - | None -> () + begin + try + let gps_reset_id = settings_tab#assoc "gps.reset" in + gps_page#connect_reset + (fun x -> dl_setting_callback gps_reset_id (float x)) + with Not_found -> + prerr_endline "Warning: GPS reset not setable from GCS (i.e. 'gps.reset' not listed in the xml settings file)" + end + | None -> () end; (* Monitor track status *) @@ -755,8 +755,8 @@ let alert_color = "red" let safe_bind = fun msg cb -> let safe_cb = fun sender vs -> try cb sender vs with - AC_not_found -> () (* A/C not yet registed; silently ignore *) - | x -> fprintf stderr "%s: safe_bind (%s:%a): %s\n%!" Sys.argv.(0) msg (fun c vs -> List.iter (fun (_,v) -> fprintf c "%s " (Pprz.string_of_value v)) vs) vs (Printexc.to_string x) in + AC_not_found -> () (* A/C not yet registed; silently ignore *) + | x -> fprintf stderr "%s: safe_bind (%s:%a): %s\n%!" Sys.argv.(0) msg (fun c vs -> List.iter (fun (_,v) -> fprintf c "%s " (Pprz.string_of_value v)) vs) vs (Printexc.to_string x) in ignore (Ground_Pprz.message_bind msg safe_cb) let alert_bind = fun msg cb -> @@ -767,8 +767,8 @@ let alert_bind = fun msg cb -> let tele_bind = fun msg cb -> let safe_cb = fun sender vs -> try cb sender vs with - AC_not_found -> () (* A/C not yet registed; silently ignore *) - | x -> fprintf stderr "tele_bind (%s): %s\n%!" msg (Printexc.to_string x) in + AC_not_found -> () (* A/C not yet registed; silently ignore *) + | x -> fprintf stderr "tele_bind (%s): %s\n%!" msg (Printexc.to_string x) in ignore (Tele_Pprz.message_bind msg safe_cb) let ask_config = fun alert geomap fp_notebook ac -> @@ -828,8 +828,8 @@ let get_engine_status_msg = fun _sender vs -> let get_if_calib_msg = fun _sender vs -> let ac = get_ac vs in match ac.rc_settings_page with - None -> () - | Some p -> + None -> () + | Some p -> p#set_rc_setting_mode (Pprz.string_assoc "if_mode" vs); p#set (Pprz.float_assoc "if_value1" vs) (Pprz.float_assoc "if_value2" vs) @@ -857,14 +857,14 @@ let listen_dl_value = fun () -> let get_dl_value = fun _sender vs -> let ac = get_ac vs in match ac.dl_settings_page with - Some settings -> - let csv = Pprz.string_assoc "values" vs in - let values = Array.map float_of_string (Array.of_list (Str.split list_separator csv)) in - ac.dl_values <- values; - for i = 0 to min (Array.length values) settings#length - 1 do - settings#set i (try values.(i) with _ -> failwith (sprintf "values.(%d)" i)) - done - | None -> () in + Some settings -> + let csv = Pprz.string_assoc "values" vs in + let values = Array.map float_of_string (Array.of_list (Str.split list_separator csv)) in + ac.dl_values <- values; + for i = 0 to min (Array.length values) settings#length - 1 do + settings#set i (try values.(i) with _ -> failwith (sprintf "values.(%d)" i)) + done + | None -> () in safe_bind "DL_VALUES" get_dl_value @@ -877,11 +877,11 @@ let highlight_fp = fun ac b s -> let check_approaching = fun ac geo alert -> match ac.track#last with - None -> () - | Some ac_pos -> + None -> () + | Some ac_pos -> let d = LL.wgs84_distance ac_pos geo in if d < ac.speed *. approaching_alert_time then - log_and_say alert ac.ac_name (sprintf "%s, approaching" ac.ac_speech_name) + log_and_say alert ac.ac_name (sprintf "%s, approaching" ac.ac_speech_name) let ac_alt_graph = [14,0;-5,0;-7,-6] @@ -951,47 +951,47 @@ let draw_altgraph = fun (da_object:Gtk_tools.pixmap_in_drawin_area) (geomap:MapC dr#set_foreground (`NAME ac.color); let track = ac.track in match track#last with - Some pos -> - let (xac, _yac) = geomap#world_of pos in - let w = float width in - let eac = (truncate (w *. (xac -. east) /. (west -. east))) in - let alt = (truncate track#last_altitude) in - let aac = height - height * (alt - !min_alt) / height_alt in - let h = track#last_heading in - let climb_angle = ref 0. in - if track#last_speed > 0. then - climb_angle := (atan2 track#last_climb track#last_speed); + Some pos -> + let (xac, _yac) = geomap#world_of pos in + let w = float width in + let eac = (truncate (w *. (xac -. east) /. (west -. east))) in + let alt = (truncate track#last_altitude) in + let aac = height - height * (alt - !min_alt) / height_alt in + let h = track#last_heading in + let climb_angle = ref 0. in + if track#last_speed > 0. then + climb_angle := (atan2 track#last_climb track#last_speed); - dr#set_line_attributes ~width:4 ~cap:`ROUND (); - dr#set_foreground (`NAME "white"); - if h > 0. && h <= 180. then begin - dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); - dr#set_line_attributes ~width:2 (); - dr#set_foreground (`NAME ac.color); - dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); - end - else begin - dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); - dr#set_line_attributes ~width:2 (); - dr#set_foreground (`NAME ac.color); - dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); - end; + dr#set_line_attributes ~width:4 ~cap:`ROUND (); + dr#set_foreground (`NAME "white"); + if h > 0. && h <= 180. then begin + dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); + dr#set_line_attributes ~width:2 (); + dr#set_foreground (`NAME ac.color); + dr#lines (rotate_and_translate ac_alt_graph (-. !climb_angle) eac aac); + end + else begin + dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); + dr#set_line_attributes ~width:2 (); + dr#set_foreground (`NAME ac.color); + dr#lines (rotate_and_translate (flip ac_alt_graph) !climb_angle eac aac); + end; (* altitude from ground if available *) - let alt_from_ground = truncate (track#height ()) in - let gac = aac + height * alt_from_ground / height_alt in - dr#set_line_attributes ~width:1 ~cap:`NOT_LAST (); - dr#line ~x:eac ~y:aac ~x:eac ~y:gac; + let alt_from_ground = truncate (track#height ()) in + let gac = aac + height * alt_from_ground / height_alt in + dr#set_line_attributes ~width:1 ~cap:`NOT_LAST (); + dr#line ~x:eac ~y:aac ~x:eac ~y:gac; (* history *) - let v_path = track#v_path in - for i = 0 to Array.length v_path - 1 do - let (x, _y) = geomap#world_of (fst v_path.(i)) in - let e = (truncate (w *. (x -. east) /. (west -. east))) in - let a = height - height * ((truncate (snd v_path.(i))) - !min_alt) / height_alt in - dr#point ~x:e ~y:a; - done - | None -> () + let v_path = track#v_path in + for i = 0 to Array.length v_path - 1 do + let (x, _y) = geomap#world_of (fst v_path.(i)) in + let e = (truncate (w *. (x -. east) /. (west -. east))) in + let a = height - height * ((truncate (snd v_path.(i))) - !min_alt) / height_alt in + dr#point ~x:e ~y:a; + done + | None -> () ) aircrafts; (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap @@ -1009,13 +1009,13 @@ module GCS_icon = struct let display = fun (geomap:G.widget) vs -> let item = match !status with - None -> (* First call, create the graphical object *) - GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 2] - ~x1: ~-.radius ~y1: ~-.radius ~x2:radius ~y2:radius - geomap#canvas#root - | Some (item, timeout_handle) -> (* Remove the timeouted color modification *) - Glib.Timeout.remove timeout_handle; - item in + None -> (* First call, create the graphical object *) + GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 2] + ~x1: ~-.radius ~y1: ~-.radius ~x2:radius ~y2:radius + geomap#canvas#root + | Some (item, timeout_handle) -> (* Remove the timeouted color modification *) + Glib.Timeout.remove timeout_handle; + item in item#set [`OUTLINE_COLOR color]; let change_color_if_not_updated = @@ -1056,18 +1056,18 @@ let listen_flight_params = fun geomap auto_center_new_ac alert alt_graph -> let unix_time = a "unix_time" in if unix_time > ac.last_unix_time then begin - let utc = Unix.gmtime unix_time in - geomap#set_utc_time utc.Unix.tm_hour utc.Unix.tm_min utc.Unix.tm_sec; - ac.last_unix_time <- unix_time + let utc = Unix.gmtime unix_time in + geomap#set_utc_time utc.Unix.tm_hour utc.Unix.tm_min utc.Unix.tm_sec; + ac.last_unix_time <- unix_time end; if auto_center_new_ac && ac.first_pos then begin - center geomap ac.track (); - ac.first_pos <- false + center geomap ac.track (); + ac.first_pos <- false end; let set_label = fun lbl_name value -> - ac.strip#set_label lbl_name (sprintf "%.0fm" value) + ac.strip#set_label lbl_name (sprintf "%.0fm" value) in set_label "altitude" alt; ac.strip#set_speed speed; @@ -1076,10 +1076,10 @@ let listen_flight_params = fun geomap auto_center_new_ac alert alt_graph -> ac.alt <- alt; ac.strip#set_agl agl; if not ac.ground_prox && ac.flight_time > 10 && agl < 20. then begin - log_and_say alert ac.ac_name (sprintf "%s, %s" ac.ac_speech_name "Ground Proximity Warning"); - ac.ground_prox <- true + log_and_say alert ac.ac_name (sprintf "%s, %s" ac.ac_speech_name "Ground Proximity Warning"); + ac.ground_prox <- true end else if agl > 25. then - ac.ground_prox <- false; + ac.ground_prox <- false; try if not (alt_graph#drawing_area#misc#parent = None) then draw_altgraph alt_graph geomap aircrafts @@ -1119,29 +1119,29 @@ let listen_flight_params = fun geomap auto_center_new_ac alert alt_graph -> let d = Pprz.float_assoc "dist_to_wp" vs in let label = if d = 0. || ac.speed = 0. then - "N/A" + "N/A" else - sprintf "%.0fs" (d /. ac.speed) in + sprintf "%.0fs" (d /. ac.speed) in ac.strip#set_label "eta_time" label; ac.last_dist_to_wp <- d; (* Estimated Time to HOME *) try match ac.wp_HOME with - Some wp_HOME -> - let (bearing_to_HOME_deg, d) = Latlong.bearing ac.track#pos wp_HOME#pos in - let bearing_to_HOME = (Deg>>Rad)bearing_to_HOME_deg in - let wind_north = -. ac.wind_speed *. cos ac.wind_dir - and wind_east = -. ac.wind_speed *. sin ac.wind_dir in - let c = ac.wind_speed *. ac.wind_speed -. ac.airspeed *. ac.airspeed - and scal = wind_east *. sin bearing_to_HOME +. wind_north *. cos bearing_to_HOME in - let delta = 4. *. (scal*.scal -. c) in - let ground_speed_to_HOME = scal +. sqrt delta /. 2. in - let time_to_HOME = d /. ground_speed_to_HOME in - ac.misc_page#set_value "Time to HOME" (sprintf "%.0fs" time_to_HOME) - | _ -> () + Some wp_HOME -> + let (bearing_to_HOME_deg, d) = Latlong.bearing ac.track#pos wp_HOME#pos in + let bearing_to_HOME = (Deg>>Rad)bearing_to_HOME_deg in + let wind_north = -. ac.wind_speed *. cos ac.wind_dir + and wind_east = -. ac.wind_speed *. sin ac.wind_dir in + let c = ac.wind_speed *. ac.wind_speed -. ac.airspeed *. ac.airspeed + and scal = wind_east *. sin bearing_to_HOME +. wind_north *. cos bearing_to_HOME in + let delta = 4. *. (scal*.scal -. c) in + let ground_speed_to_HOME = scal +. sqrt delta /. 2. in + let time_to_HOME = d /. ground_speed_to_HOME in + ac.misc_page#set_value "Time to HOME" (sprintf "%.0fs" time_to_HOME) + | _ -> () with - _NotSoImportant -> () + _NotSoImportant -> () in safe_bind "NAV_STATUS" get_ns; @@ -1201,17 +1201,17 @@ let listen_flight_params = fun geomap auto_center_new_ac alert alt_graph -> ac.strip#set_label "AP" (if label="MANUAL" then "MANU" else label); let color = match ap_mode with - "AUTO2" | "NAV" -> ok_color - | "AUTO1" | "R_RCC" | "A_RCC" | "ATT_C" | "R_ZH" | "A_ZH" | "HOVER" | "HOV_C" | "H_ZH" -> "#10F0E0" - | "MANUAL" | "RATE" | "ATT" | "RC_D" -> warning_color - | _ -> alert_color in + "AUTO2" | "NAV" -> ok_color + | "AUTO1" | "R_RCC" | "A_RCC" | "ATT_C" | "R_ZH" | "A_ZH" | "HOVER" | "HOV_C" | "H_ZH" -> "#10F0E0" + | "MANUAL" | "RATE" | "ATT" | "RC_D" -> warning_color + | _ -> alert_color in ac.strip#set_color "AP" color; end; let status_filter_mode = Pprz.string_assoc "state_filter_mode" vs in let gps_mode = if (status_filter_mode <> "UNKNOWN") && (status_filter_mode <> "OK") && (status_filter_mode <> "GPS_LOST") - then status_filter_mode - else Pprz.string_assoc "gps_mode" vs in + then status_filter_mode + else Pprz.string_assoc "gps_mode" vs in ac.strip#set_label "GPS" gps_mode; ac.strip#set_color "GPS" (if gps_mode<>"3D" then alert_color else ok_color); let ft = @@ -1220,14 +1220,14 @@ let listen_flight_params = fun geomap auto_center_new_ac alert alt_graph -> let kill_mode = Pprz.string_assoc "kill_mode" vs in if kill_mode <> "OFF" then begin if not ac.in_kill_mode then - log_and_say alert ac.ac_name (sprintf "%s, mayday, kill mode" ac.ac_speech_name); + log_and_say alert ac.ac_name (sprintf "%s, mayday, kill mode" ac.ac_speech_name); ac.in_kill_mode <- true end else ac.in_kill_mode <- false; match ac.rc_settings_page with - None -> () - | Some p -> - p#set_rc_mode ap_mode + None -> () + | Some p -> + p#set_rc_mode ap_mode in safe_bind "AP_STATUS" get_ap_status; @@ -1245,7 +1245,7 @@ let listen_waypoint_moved = fun () -> let w = ac.fp_group#get_wp wp_id in w#set ~altitude ~update:true geo with - Not_found -> () (* Silently ignore unknown waypoints *) + Not_found -> () (* Silently ignore unknown waypoints *) in safe_bind "WAYPOINT_MOVED" get_values @@ -1268,11 +1268,11 @@ let get_svsinfo = fun alarm _sender vs -> let a = Array.create (List.length svids) (0,0,0,0) in let rec loop = fun i s c f ages -> match (s, c, f, ages) with - [], [], [], [] -> () - | s::ss, c::cs, f::fs, age::ages -> - a.(i) <- (int_of_string s, int_of_string c, int_of_string f, int_of_string age); - loop (i+1) ss cs fs ages - | _ -> assert false in + [], [], [], [] -> () + | s::ss, c::cs, f::fs, age::ages -> + a.(i) <- (int_of_string s, int_of_string c, int_of_string f, int_of_string age); + loop (i+1) ss cs fs ages + | _ -> assert false in loop 0 svids cn0s flagss ages; let pacc = Pprz.int_assoc "pacc" vs in @@ -1299,15 +1299,15 @@ let listen_telemetry_status = fun () -> let mark_dcshot = fun (geomap:G.widget) _sender vs -> let ac = find_ac !active_ac in - let photonumber = Pprz.string_assoc "photo_nr" vs in -(* let ac = get_ac vs in *) - match ac.track#last with + let photonumber = Pprz.string_assoc "photo_nr" vs in + (* let ac = get_ac vs in *) + match ac.track#last with Some geo -> - begin - let group = geomap#background in - let point = geomap#photoprojection ~group ~fill_color:"yellow" ~number:photonumber geo 3. in - point#raise_to_top () - end + begin + let group = geomap#background in + let point = geomap#photoprojection ~group ~fill_color:"yellow" ~number:photonumber geo 3. in + point#raise_to_top () + end | None -> () (* mark geomap ac.ac_name track !Plugin.frame *) @@ -1327,11 +1327,11 @@ let listen_tcas = fun a -> let ac = find_ac _sender in let other_ac = get_ac vs in let resolve = try - match Pprz.int_assoc "resolve" vs with - 1 -> "=> LEVEL" - | 2 -> "=> CLIMB" - | 3 -> "=> DESCEND" - | _ -> "" + match Pprz.int_assoc "resolve" vs with + 1 -> "=> LEVEL" + | 2 -> "=> CLIMB" + | 3 -> "=> DESCEND" + | _ -> "" with _ -> "" in log_and_say a ac.ac_name (sprintf "%s : %s -> %s %s" txt ac.ac_speech_name other_ac.ac_speech_name resolve) in @@ -1366,8 +1366,8 @@ let listen_acs_and_msgs = fun geomap ac_notebook my_alert auto_center_new_ac alt let ac_page = ac_notebook#get_nth_page i in Hashtbl.iter (fun ac_id ac -> - if ac.pages#get_oid = ac_page#get_oid - then select_ac ac_notebook ac_id) + if ac.pages#get_oid = ac_page#get_oid + then select_ac ac_notebook ac_id) aircrafts in ignore (ac_notebook#connect#switch_page ~callback); @@ -1378,6 +1378,6 @@ let listen_acs_and_msgs = fun geomap ac_notebook my_alert auto_center_new_ac alt center geomap ac.track () in let key_press = fun ev -> match GdkEvent.Key.keyval ev with - | k when k = GdkKeysyms._c -> center_active () ; true - | _ -> false in + | k when k = GdkKeysyms._c -> center_active () ; true + | _ -> false in ignore (geomap#canvas#event#connect#after#key_press key_press) diff --git a/sw/ground_segment/cockpit/map2d.ml b/sw/ground_segment/cockpit/map2d.ml index 77166b7fe0..7dbc287597 100644 --- a/sw/ground_segment/cockpit/map2d.ml +++ b/sw/ground_segment/cockpit/map2d.ml @@ -1,28 +1,28 @@ (* -* 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. -* -*) + * 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 set_georef_if_none = fun geomap wgs84 -> match geomap#georef with - None -> - geomap#set_georef wgs84; - geomap#center wgs84 - | Some _ -> () + None -> + geomap#set_georef wgs84; + geomap#center wgs84 + | Some _ -> () diff --git a/sw/ground_segment/cockpit/page_settings.ml b/sw/ground_segment/cockpit/page_settings.ml index 47f10c35ec..5021a4c450 100644 --- a/sw/ground_segment/cockpit/page_settings.ml +++ b/sw/ground_segment/cockpit/page_settings.ml @@ -1,26 +1,26 @@ (* -* Widget to pack settings buttons -* -* Copyright (C) 2004-2009 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. -* -*) + * Widget to pack settings buttons + * + * Copyright (C) 2004-2009 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 @@ -122,14 +122,14 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let group = (GButton.radio_button ())#group in (* Group shared by the buttons *) let buttons = Array.init (iupper-ilower+1) (fun j -> - (* Build the button *) + (* Build the button *) let label = if Array.length values = 0 then Printf.sprintf "%d" (ilower + j) else values.(j) in let b = GButton.radio_button ~group ~label ~packing:hbox#add () in - (* Connect the event *) + (* Connect the event *) ignore (b#connect#pressed (fun () -> update_value (ilower + j))); b) in (callback, fun j -> try buttons.(truncate j - ilower)#set_active true with _ -> ()) @@ -196,14 +196,14 @@ let one_setting = fun (i:int) (do_change:int -> float -> unit) packing dl_settin let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in ignore (GMisc.image ~pixbuf ~packing:b#add ()); - (* Drag for Drop *) + (* Drag for Drop *) let papget = Papget_common.xml "variable_setting" "button" ["variable", varname; "value", ExtXml.attrib x "value"; "icon", icon] in Papget_common.dnd_source b#coerce papget; - (* Associates the label as a tooltip *) + (* Associates the label as a tooltip *) tooltips#set_tip b#coerce ~text:label; b with diff --git a/sw/ground_segment/cockpit/pages.ml b/sw/ground_segment/cockpit/pages.ml index 16f7969376..9cfbc93dea 100644 --- a/sw/ground_segment/cockpit/pages.ml +++ b/sw/ground_segment/cockpit/pages.ml @@ -32,42 +32,42 @@ open Printf (** alert page *) class alert (widget: GBin.frame) = let scrolled = GBin.scrolled_window - ~hpolicy: `AUTOMATIC - ~vpolicy: `AUTOMATIC - ~packing: widget#add - () + ~hpolicy: `AUTOMATIC + ~vpolicy: `AUTOMATIC + ~packing: widget#add + () in let view = GText.view ~editable:false ~packing: scrolled#add () in -(* the object itselft *) - object - val mutable last = "" - method add text = - if text <> last then begin - let l = Unix.localtime (Unix.gettimeofday ()) in - view#buffer#insert (sprintf "%02d:%02d:%02d " l.Unix.tm_hour l.Unix.tm_min l.Unix.tm_sec); - view#buffer#insert text; - view#buffer#insert "\n"; + (* the object itselft *) +object + val mutable last = "" + method add text = + if text <> last then begin + let l = Unix.localtime (Unix.gettimeofday ()) in + view#buffer#insert (sprintf "%02d:%02d:%02d " l.Unix.tm_hour l.Unix.tm_min l.Unix.tm_sec); + view#buffer#insert text; + view#buffer#insert "\n"; - (* Scroll to the bottom line *) - let end_iter = view#buffer#end_iter in - let end_mark = view#buffer#create_mark end_iter in - view#scroll_mark_onscreen (`MARK end_mark); + (* Scroll to the bottom line *) + let end_iter = view#buffer#end_iter in + let end_mark = view#buffer#create_mark end_iter in + view#scroll_mark_onscreen (`MARK end_mark); - last <- text - end - end + last <- text + end +end (*****************************************************************************) (* infrared page *) (*****************************************************************************) class infrared (widget: GBin.frame) = let table = GPack.table - ~rows: 4 - ~columns: 2 - ~row_spacings: 5 - ~col_spacings: 5 - ~packing: widget#add - () + ~rows: 4 + ~columns: 2 + ~row_spacings: 5 + ~col_spacings: 5 + ~packing: widget#add + () in let contrast_status = GMisc.label ~text: "" ~packing: (table#attach ~top:0 ~left: 1) () @@ -87,24 +87,24 @@ class infrared (widget: GBin.frame) = ignore (GMisc.label ~text: "gps hybrid mode" ~packing: (table#attach ~top:2 ~left: 0) ()); ignore (GMisc.label ~text: "gps hybrid factor" ~packing: (table#attach ~top:3 ~left: 0) ()) in - object - val parent = widget - val table = table +object + val parent = widget + val table = table - val contrast_status = contrast_status - val contrast_value = contrast_value - val gps_hybrid_mode = gps_hybrid_mode - val gps_hybrid_factor = gps_hybrid_factor + val contrast_status = contrast_status + val contrast_value = contrast_value + val gps_hybrid_mode = gps_hybrid_mode + val gps_hybrid_factor = gps_hybrid_factor - method set_contrast_status (s:string) = - contrast_status#set_label s - method set_contrast_value (s:int) = - contrast_value#set_label (Printf.sprintf "%d" s) - method set_gps_hybrid_mode (s:string) = - gps_hybrid_mode#set_label s - method set_gps_hybrid_factor (s:float) = - gps_hybrid_factor#set_label (Printf.sprintf "%.8f" s) - end + method set_contrast_status (s:string) = + contrast_status#set_label s + method set_contrast_value (s:int) = + contrast_value#set_label (Printf.sprintf "%d" s) + method set_gps_hybrid_mode (s:string) = + gps_hybrid_mode#set_label s + method set_gps_hybrid_factor (s:float) = + gps_hybrid_factor#set_label (Printf.sprintf "%.8f" s) +end (*****************************************************************************) (* gps page *) @@ -123,71 +123,71 @@ class gps ?(visible = fun _ -> true) (widget: GBin.frame) = let warm = GButton.button ~label:"Warmstart" ~packing:hbox#add () in let cold = GButton.button ~label:"Coldstart" ~packing:hbox#add () in - object - val mutable active_cno = [] - val mutable active_flags = [] +object + val mutable active_cno = [] + val mutable active_flags = [] - method connect_reset = fun (callback:int -> unit) -> - hbox#misc#show (); - ignore (hot#connect#clicked (fun () -> callback 0)); - ignore (warm#connect#clicked (fun () -> callback 1)); - ignore (cold#connect#clicked (fun () -> callback 2)) + method connect_reset = fun (callback:int -> unit) -> + hbox#misc#show (); + ignore (hot#connect#clicked (fun () -> callback 0)); + ignore (warm#connect#clicked (fun () -> callback 1)); + ignore (cold#connect#clicked (fun () -> callback 2)) - method svsinfo pacc a = - if visible widget then - let da = da_object#drawing_area in - let {Gtk.width=width; height=height} = da#misc#allocation in + method svsinfo pacc a = + if visible widget then + let da = da_object#drawing_area in + let {Gtk.width=width; height=height} = da#misc#allocation in - (* Background *) - let dr = da_object#get_pixmap () in - dr#set_foreground (`NAME "white"); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); + (* Background *) + let dr = da_object#get_pixmap () in + dr#set_foreground (`NAME "white"); + dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - let context = da#misc#create_pango_context in - context#set_font_by_name ("sans " ^ string_of_int 10); - let layout = context#create_layout in + let context = da#misc#create_pango_context in + context#set_font_by_name ("sans " ^ string_of_int 10); + let layout = context#create_layout in - let n = Array.length a in - let sep_size = 3 in - let indic_size = min 25 ((width-(n+1)*sep_size)/n) in - let max_cn0 = 50 in + let n = Array.length a in + let sep_size = 3 in + let indic_size = min 25 ((width-(n+1)*sep_size)/n) in + let max_cn0 = 50 in - Pango.Layout.set_text layout "Dummy"; - let (_, h) = Pango.Layout.get_pixel_size layout in + Pango.Layout.set_text layout "Dummy"; + let (_, h) = Pango.Layout.get_pixel_size layout in - let size = fun cn0 -> (max 20 cn0 - 20) * 2 in + let size = fun cn0 -> (max 20 cn0 - 20) * 2 in - let y = sep_size + h + (size max_cn0) in - for i = 0 to n - 1 do - let (id, cn0, flags, age) = a.(i) in - if age < 60 then - let x = sep_size + i * (sep_size+indic_size) in + let y = sep_size + h + (size max_cn0) in + for i = 0 to n - 1 do + let (id, cn0, flags, age) = a.(i) in + if age < 60 then + let x = sep_size + i * (sep_size+indic_size) in - (* level *) - Pango.Layout.set_text layout (sprintf "% 2d" cn0); - dr#put_layout ~x ~y:0 ~fore:`BLACK layout; + (* level *) + Pango.Layout.set_text layout (sprintf "% 2d" cn0); + dr#put_layout ~x ~y:0 ~fore:`BLACK layout; - (* bar *) - let color = if age > 5 then "grey" else if flags land 0x01 = 1 then "green" else "red" in - dr#set_foreground (`NAME color); - let height = size cn0 in - dr#rectangle ~filled:true ~x ~y:(y-height) ~width:indic_size ~height (); - (* SV id *) - Pango.Layout.set_text layout (sprintf "% 2d" id); - dr#put_layout ~x ~y ~fore:`BLACK layout - done; + (* bar *) + let color = if age > 5 then "grey" else if flags land 0x01 = 1 then "green" else "red" in + dr#set_foreground (`NAME color); + let height = size cn0 in + dr#rectangle ~filled:true ~x ~y:(y-height) ~width:indic_size ~height (); + (* SV id *) + Pango.Layout.set_text layout (sprintf "% 2d" id); + dr#put_layout ~x ~y ~fore:`BLACK layout + done; - (* Pacc *) - let max_pacc = 2000 in - dr#set_foreground (`NAME "red"); - let w = min width ((pacc*width)/max_pacc) in - dr#rectangle ~filled:true ~x:0 ~y:(y+h) ~width:w ~height:h (); - Pango.Layout.set_text layout (if pacc = 0 then "Pos accuracy: N/A" else sprintf "Pos accuracy: %.1fm" (float pacc/.100.)); - let (_, h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:((width-w)/2) ~y:(y+h) ~fore:`BLACK layout; + (* Pacc *) + let max_pacc = 2000 in + dr#set_foreground (`NAME "red"); + let w = min width ((pacc*width)/max_pacc) in + dr#rectangle ~filled:true ~x:0 ~y:(y+h) ~width:w ~height:h (); + Pango.Layout.set_text layout (if pacc = 0 then "Pos accuracy: N/A" else sprintf "Pos accuracy: %.1fm" (float pacc/.100.)); + let (_, h) = Pango.Layout.get_pixel_size layout in + dr#put_layout ~x:((width-w)/2) ~y:(y+h) ~fore:`BLACK layout; - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - end + (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap +end (*****************************************************************************) (* Misc page *) @@ -215,27 +215,27 @@ class misc ~packing (widget: GBin.frame) = let top = index_of "Send periodically" in values.(top)#destroy (); GButton.check_button ~active:true ~packing:(table#attach ~top ~left:1) () in - object - method set_value label s = values.(index_of label)#set_text s - method periodic_send = periodic_send#active - end +object + method set_value label s = values.(index_of label)#set_text s + method periodic_send = periodic_send#active +end type rc_mode = string type rc_setting_mode = string let rc_setting_index = function - "gain_1_up" -> 0, 0 +"gain_1_up" -> 0, 0 | "gain_1_down" -> 1, 0 | "gain_2_up" -> 0, 1 | "gain_2_down" -> 1, 1 | x -> failwith (sprintf "Unknown rc_setting: %s" x) let rc_mode_index = function - "AUTO1" -> 0 | "AUTO2" -> 1 +"AUTO1" -> 0 | "AUTO2" -> 1 | _x -> -1 let rc_setting_mode_index = function - "UP" -> 0 | "DOWN" -> 1 +"UP" -> 0 | "DOWN" -> 1 | _x -> -1 let one_rc_mode = fun (table:GPack.table) rc_mode -> @@ -245,7 +245,7 @@ let one_rc_mode = fun (table:GPack.table) rc_mode -> and text = ExtXml.attrib rc_setting "var" in let (j, k) = rc_setting_index name in ignore (GMisc.label ~text ~packing:(table#attach ~top:(1+2*j+k) ~left:(1+2*i)) ()) - ) + ) (Xml.children rc_mode) @@ -283,13 +283,13 @@ class rc_settings = fun ?(visible = fun _ -> true) xmls -> method widget = sw#coerce method set = fun v1 v2 -> if visible self#widget then - let i = rc_mode_index rc_mode - and j = rc_setting_mode_index rc_setting_mode in - if i >= 0 && j >= 0 then - let s1 = string_of_float v1 in - let s2 = string_of_float v2 in + let i = rc_mode_index rc_mode + and j = rc_setting_mode_index rc_setting_mode in + if i >= 0 && j >= 0 then + let s1 = string_of_float v1 in + let s2 = string_of_float v2 in - values.(i).(j).(0)#set_text s1; - values.(i).(j).(1)#set_text s2 + values.(i).(j).(0)#set_text s1; + values.(i).(j).(1)#set_text s2 end diff --git a/sw/ground_segment/cockpit/papgets.ml b/sw/ground_segment/cockpit/papgets.ml index 323e8f2a6b..120fdc2b52 100644 --- a/sw/ground_segment/cockpit/papgets.ml +++ b/sw/ground_segment/cockpit/papgets.ml @@ -31,9 +31,9 @@ let dump_store = fun () -> Hashtbl.fold (fun _ p r -> if not p#deleted then - p#config ()::r + p#config ()::r else - r) + r) papgets [] @@ -43,26 +43,26 @@ let papget_listener = try let field = Papget_common.get_property "field" papget in match Str.split sep field with - [msg_name; field_name] -> - (new Papget.message_field msg_name field_name) - | _ -> failwith (sprintf "Unexpected field spec: %s" field) + [msg_name; field_name] -> + (new Papget.message_field msg_name field_name) + | _ -> failwith (sprintf "Unexpected field spec: %s" field) with - _ -> failwith (sprintf "field attr expected in '%s" (Xml.to_string papget)) + _ -> failwith (sprintf "field attr expected in '%s" (Xml.to_string papget)) let block_name_of_index = function - [ i ] -> - let i = sprintf "%.0f" (float_of_string i) in - if Hashtbl.length Live.aircrafts = 1 then - Hashtbl.fold - (fun ac_id ac _r -> - let blocks = ExtXml.child ac.Live.fp "blocks" in - let block = ExtXml.child blocks i in - ExtXml.attrib block "name") - Live.aircrafts - "N/A" - else - "N/A" +[ i ] -> + let i = sprintf "%.0f" (float_of_string i) in + if Hashtbl.length Live.aircrafts = 1 then + Hashtbl.fold + (fun ac_id ac _r -> + let blocks = ExtXml.child ac.Live.fp "blocks" in + let block = ExtXml.child blocks i in + ExtXml.attrib block "name") + Live.aircrafts + "N/A" + else + "N/A" | _ -> failwith "Papgets.block_name_of_index" let extra_functions = @@ -79,15 +79,15 @@ let expression_listener = fun papget -> let display_float_papget = fun canvas_group config display x y listener -> let renderer = match display with - "text" -> - (new Papget_renderer.canvas_text ~config canvas_group x y :> Papget_renderer.t) - | "ruler" -> - (new Papget_renderer.canvas_ruler canvas_group ~config x y :> Papget_renderer.t) - | "gauge" -> - (new Papget_renderer.canvas_gauge ~config canvas_group x y :> Papget_renderer.t) - | "led" -> - (new Papget_renderer.canvas_led ~config canvas_group x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + "text" -> + (new Papget_renderer.canvas_text ~config canvas_group x y :> Papget_renderer.t) + | "ruler" -> + (new Papget_renderer.canvas_ruler canvas_group ~config x y :> Papget_renderer.t) + | "gauge" -> + (new Papget_renderer.canvas_gauge ~config canvas_group x y :> Papget_renderer.t) + | "led" -> + (new Papget_renderer.canvas_led ~config canvas_group x y :> Papget_renderer.t) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in let p = new Papget.canvas_display_float_item ~config listener renderer in let p = (p :> Papget.item) in @@ -108,84 +108,84 @@ let create = fun canvas_group papget -> and y = ExtXml.float_attrib papget "y" and config = Xml.children papget in match type_ with - "expression" -> - let expr_listener = expression_listener papget in - display_float_papget canvas_group config display x y expr_listener + "expression" -> + let expr_listener = expression_listener papget in + display_float_papget canvas_group config display x y expr_listener - | "message_field" -> - let msg_listener = papget_listener papget in - display_float_papget canvas_group config display x y msg_listener + | "message_field" -> + let msg_listener = papget_listener papget in + display_float_papget canvas_group config display x y msg_listener - | "goto_block" -> - let renderer = - match display with - "button" -> - (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - let block_name = Papget_common.get_property "block_name" papget in - let clicked = fun () -> - prerr_endline "Warning: goto_block papget sends to all A/C"; - Hashtbl.iter - (fun ac_id ac -> - let blocks = ExtXml.child ac.Live.fp "blocks" in - let block = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = block_name) blocks "block" in - let block_id = ExtXml.int_attrib block "no" in - Live.jump_to_block ac_id block_id - ) - Live.aircrafts - in - let properties = - [ Papget_common.property "block_name" block_name ] @ locked papget in + | "goto_block" -> + let renderer = + match display with + "button" -> + (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + let block_name = Papget_common.get_property "block_name" papget in + let clicked = fun () -> + prerr_endline "Warning: goto_block papget sends to all A/C"; + Hashtbl.iter + (fun ac_id ac -> + let blocks = ExtXml.child ac.Live.fp "blocks" in + let block = ExtXml.child ~select:(fun x -> ExtXml.attrib x "name" = block_name) blocks "block" in + let block_id = ExtXml.int_attrib block "no" in + Live.jump_to_block ac_id block_id + ) + Live.aircrafts + in + let properties = + [ Papget_common.property "block_name" block_name ] @ locked papget in - let p = new Papget.canvas_goto_block_item properties clicked renderer in - let p = (p :> Papget.item) in - register_papget p - | "variable_setting" -> - let renderer = - match display with - "button" -> - (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + let p = new Papget.canvas_goto_block_item properties clicked renderer in + let p = (p :> Papget.item) in + register_papget p + | "variable_setting" -> + let renderer = + match display with + "button" -> + (new Papget_renderer.canvas_button canvas_group ~config x y :> Papget_renderer.t) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - let varname = Papget_common.get_property "variable" papget - and value = float_of_string (Papget_common.get_property "value" papget) in + let varname = Papget_common.get_property "variable" papget + and value = float_of_string (Papget_common.get_property "value" papget) in - let clicked = fun () -> - prerr_endline "Warning: variable_setting papget sending to all active A/C"; - Hashtbl.iter - (fun ac_id ac -> - match ac.Live.dl_settings_page with - None -> () - | Some settings -> - let var_id = settings#assoc varname in - Live.dl_setting ac_id var_id value) - Live.aircrafts - in - let properties = - [ Papget_common.property "variable" varname; - Papget_common.float_property "value" value ] - @ locked papget in - let p = new Papget.canvas_variable_setting_item properties clicked renderer in - let p = (p :> Papget.item) in - register_papget p + let clicked = fun () -> + prerr_endline "Warning: variable_setting papget sending to all active A/C"; + Hashtbl.iter + (fun ac_id ac -> + match ac.Live.dl_settings_page with + None -> () + | Some settings -> + let var_id = settings#assoc varname in + Live.dl_setting ac_id var_id value) + Live.aircrafts + in + let properties = + [ Papget_common.property "variable" varname; + Papget_common.float_property "value" value ] + @ locked papget in + let p = new Papget.canvas_variable_setting_item properties clicked renderer in + let p = (p :> Papget.item) in + register_papget p - | "video_plugin" -> - let renderer = - match display with - "mplayer" -> - (new Papget_renderer.canvas_mplayer canvas_group ~config x y :> Papget_renderer.t) - | "plugin" -> - (new Papget_renderer.canvas_plugin canvas_group ~config x y :> Papget_renderer.t) - | _ -> failwith (sprintf "Unexpected papget display: %s" display) in + | "video_plugin" -> + let renderer = + match display with + "mplayer" -> + (new Papget_renderer.canvas_mplayer canvas_group ~config x y :> Papget_renderer.t) + | "plugin" -> + (new Papget_renderer.canvas_plugin canvas_group ~config x y :> Papget_renderer.t) + | _ -> failwith (sprintf "Unexpected papget display: %s" display) in - let properties = locked papget in - let p = new Papget.canvas_video_plugin_item properties renderer in - let p = (p :> Papget.item) in - register_papget p + let properties = locked papget in + let p = new Papget.canvas_video_plugin_item properties renderer in + let p = (p :> Papget.item) in + register_papget p - | _ -> failwith (sprintf "Unexpected papget type: %s" type_) + | _ -> failwith (sprintf "Unexpected papget type: %s" type_) with - exc -> fprintf stderr "Papgets.create: %s\n%!" (Printexc.to_string exc) + exc -> fprintf stderr "Papgets.create: %s\n%!" (Printexc.to_string exc) exception Parse_message_dnd of string @@ -194,27 +194,27 @@ let parse_message_dnd = let sep = Str.regexp ":" in fun s -> match Str.split sep s with - [s; c; m; f;scale] -> (s, c, m, f,scale) - | _ -> raise (Parse_message_dnd (Printf.sprintf "parse_dnd: %s" s)) + [s; c; m; f;scale] -> (s, c, m, f,scale) + | _ -> raise (Parse_message_dnd (Printf.sprintf "parse_dnd: %s" s)) let dnd_data_received = fun canvas_group _context ~x ~y data ~info ~time -> try (* With the format sent by Messages *) let (_sender, _class_name, msg_name, field_name,scale) = parse_message_dnd data#data in let attrs = [ "type", "message_field"; - "display", "text"; - "x", sprintf "%d" x; "y", sprintf "%d" y ] + "display", "text"; + "x", sprintf "%d" x; "y", sprintf "%d" y ] and props = [ Papget_common.property "field" (sprintf "%s:%s" msg_name field_name); - Papget_common.property "scale" scale ] in + Papget_common.property "scale" scale ] in let papget_xml = Xml.Element ("papget", attrs, props) in create canvas_group papget_xml with - Parse_message_dnd _ -> - try (* XML spec *) - let xml = Xml.parse_string data#data in - (* Add x and y attributes *) - let attrs = Xml.attribs xml @ ["x", string_of_int x; "y", string_of_int y] in - let papget_xml = Xml.Element (Xml.tag xml,attrs,Xml.children xml) in - create canvas_group papget_xml - with - exc -> prerr_endline (Printexc.to_string exc) + Parse_message_dnd _ -> + try (* XML spec *) + let xml = Xml.parse_string data#data in + (* Add x and y attributes *) + let attrs = Xml.attribs xml @ ["x", string_of_int x; "y", string_of_int y] in + let papget_xml = Xml.Element (Xml.tag xml,attrs,Xml.children xml) in + create canvas_group papget_xml + with + exc -> prerr_endline (Printexc.to_string exc) diff --git a/sw/ground_segment/cockpit/particules.ml b/sw/ground_segment/cockpit/particules.ml index 13744c7337..c780ef4db4 100644 --- a/sw/ground_segment/cockpit/particules.ml +++ b/sw/ground_segment/cockpit/particules.ml @@ -20,12 +20,12 @@ let move_particule = fun (geomap:MapCanvas.widget) id geo value -> geomap#move_item item geo; item#set [`FILL_COLOR fill_color] with - Not_found -> - let group = geomap#background in - let p = GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 1; `OUTLINE_COLOR "black"] ~x1:(-3.) ~y1:(-3.) ~x2:3. ~y2:3. group in -(* geomap#circle ~group ~fill_color:"red" geo 10. in *) - p#raise_to_top (); - Hashtbl.add particules id (p:>GnomeCanvas.re_p GnoCanvas.item) + Not_found -> + let group = geomap#background in + let p = GnoCanvas.ellipse ~fill_color ~props:[`WIDTH_PIXELS 1; `OUTLINE_COLOR "black"] ~x1:(-3.) ~y1:(-3.) ~x2:3. ~y2:3. group in + (* geomap#circle ~group ~fill_color:"red" geo 10. in *) + p#raise_to_top (); + Hashtbl.add particules id (p:>GnomeCanvas.re_p GnoCanvas.item) let list_separator = Str.regexp "," @@ -41,13 +41,13 @@ let listen = fun (geomap:MapCanvas.widget) -> let rec loop = fun ids xs ys vs -> match ids, xs, ys, vs with - [], [], [], [] -> () - | id::ids, x::xs, y::ys, v::vs -> - let id = int_of_string id - and wgs84 = {posn_lat=(Deg>>Rad)(fos x); posn_long=(Deg>>Rad)(fos y)} in - move_particule geomap id wgs84 (ios v); - loop ids xs ys vs - | _ -> failwith "Particules.listen loop" + [], [], [], [] -> () + | id::ids, x::xs, y::ys, v::vs -> + let id = int_of_string id + and wgs84 = {posn_lat=(Deg>>Rad)(fos x); posn_long=(Deg>>Rad)(fos y)} in + move_particule geomap id wgs84 (ios v); + loop ids xs ys vs + | _ -> failwith "Particules.listen loop" in loop ids xs ys vs in diff --git a/sw/ground_segment/cockpit/saveSettings.ml b/sw/ground_segment/cockpit/saveSettings.ml index 5b3862c10a..07ee52a24b 100644 --- a/sw/ground_segment/cockpit/saveSettings.ml +++ b/sw/ground_segment/cockpit/saveSettings.ml @@ -134,15 +134,15 @@ let fill_data = fun (model:GTree.tree_store) settings airframe_xml -> try let unit_code = match code_unit, unit_setting with - | Some uc, Some us -> + | Some uc, Some us -> if uc = us then uc else invalid_arg (Printf.sprintf "Warning: code unit in airframe (%s) and setting file (%s) are not matching for param %s\n" uc us param) (* raise Invalid_argument *) - | Some u, None | None, Some u -> u - | None, None -> "" + | Some u, None | None, Some u -> u + | None, None -> "" and unit_airframe = match airframe_unit with - | Some u -> u - | None -> "" + | Some u -> u + | None -> "" in (* Printf.fprintf stderr "param %s: unit_code=%s unit_airframe=%s\n" param unit_code unit_airframe; flush stderr; *) Pprz.scale_of_units unit_airframe unit_code diff --git a/sw/ground_segment/cockpit/sectors.ml b/sw/ground_segment/cockpit/sectors.ml index b8d89c27d1..6e4ac3ab2d 100644 --- a/sw/ground_segment/cockpit/sectors.ml +++ b/sw/ground_segment/cockpit/sectors.ml @@ -7,20 +7,20 @@ let (//) = Filename.concat let rec display = fun (geomap:MapCanvas.widget) r -> match String.lowercase (Xml.tag r) with - "disc" -> - let rad = float_of_string (ExtXml.attrib r "radius") - and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in - ignore (geomap#circle ~width:5 ~color:"red" geo rad) - | "union" -> + "disc" -> + let rad = float_of_string (ExtXml.attrib r "radius") + and geo = Latlong.of_string (ExtXml.attrib (ExtXml.child r "point") "pos") in + ignore (geomap#circle ~width:5 ~color:"red" geo rad) + | "union" -> List.iter (display geomap) (Xml.children r) - | "polygon" -> + | "polygon" -> let pts = List.map (fun x -> Latlong.of_string (ExtXml.attrib x "pos")) (Xml.children r) in let pts = Array.of_list pts in let n = Array.length pts in for i = 0 to n - 1 do - ignore (geomap#segment ~width:5 ~fill_color:"red" pts.(i) pts.((i+1)mod n)) + ignore (geomap#segment ~width:5 ~fill_color:"red" pts.(i) pts.((i+1)mod n)) done - |x -> fprintf stderr "Sector.display: '%s' not yet\n%!" x + |x -> fprintf stderr "Sector.display: '%s' not yet\n%!" x let display_sector = fun (geomap:MapCanvas.widget) sector -> @@ -29,13 +29,13 @@ let display_sector = fun (geomap:MapCanvas.widget) sector -> let load = fun geomap () -> match GToolbox.select_file ~title:"Load sectors" ~filename:(Env.flight_plans_path // "*.xml") () with - None -> () - | Some f -> + None -> () + | Some f -> try - let xml = Xml.parse_file f in - List.iter (display_sector geomap) (Xml.children xml) + let xml = Xml.parse_file f in + List.iter (display_sector geomap) (Xml.children xml) with - Dtd.Prove_error(e) -> - let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in - GToolbox.message_box "Error" m + Dtd.Prove_error(e) -> + let m = sprintf "Error while loading %s:\n%s" f (Dtd.prove_error e) in + GToolbox.message_box "Error" m diff --git a/sw/ground_segment/cockpit/speech.ml b/sw/ground_segment/cockpit/speech.ml index 38cfdd1f60..61c2567094 100644 --- a/sw/ground_segment/cockpit/speech.ml +++ b/sw/ground_segment/cockpit/speech.ml @@ -30,8 +30,8 @@ let say = fun s -> match os with (* If the os is Darwin, then use "say" *) "Linux" -> ignore (Sys.command (Printf.sprintf "spd-say '%s'&" s)) - (* If the os is Linux, use "spd-say" *) + (* If the os is Linux, use "spd-say" *) | "Darwin" -> ignore (Sys.command (Printf.sprintf "say '%s'&" s)) - (* Add more cases here to enhance support *) + (* Add more cases here to enhance support *) | _ -> ignore (Sys.command (Printf.sprintf "echo Current OS not supported by -speech option")) ) diff --git a/sw/ground_segment/cockpit/strip.ml b/sw/ground_segment/cockpit/strip.ml index 6a085c5ca4..85bcb0c68d 100644 --- a/sw/ground_segment/cockpit/strip.ml +++ b/sw/ground_segment/cockpit/strip.ml @@ -29,26 +29,26 @@ let (//) = Filename.concat type t = < add_widget : ?group:string -> GObj.widget -> unit; - connect_shift_alt : (float -> unit) -> unit; - connect_shift_lateral : (float -> unit) -> unit; - connect_launch : (float -> unit) -> unit; - connect_kill : (float -> unit) -> unit; - connect_mode : (float -> unit) -> unit; - connect_mark : (unit -> unit) -> unit; - connect_flight_time : (float -> unit) -> unit; - connect_apt : (unit -> float) -> (float -> unit) -> unit; - set_agl : float -> unit; - set_bat : float -> unit; - set_throttle : ?kill:bool -> float -> unit; - set_speed : float -> unit; - set_airspeed : float -> unit; - set_climb : float -> unit; - set_color : string -> string -> unit; - set_label : string -> string -> unit; - set_rc : int -> string -> unit; - connect : (unit -> unit) -> unit; - hide_buttons : unit -> unit; - show_buttons : unit -> unit > + connect_shift_alt : (float -> unit) -> unit; + connect_shift_lateral : (float -> unit) -> unit; + connect_launch : (float -> unit) -> unit; + connect_kill : (float -> unit) -> unit; + connect_mode : (float -> unit) -> unit; + connect_mark : (unit -> unit) -> unit; + connect_flight_time : (float -> unit) -> unit; + connect_apt : (unit -> float) -> (float -> unit) -> unit; + set_agl : float -> unit; + set_bat : float -> unit; + set_throttle : ?kill:bool -> float -> unit; + set_speed : float -> unit; + set_airspeed : float -> unit; + set_climb : float -> unit; + set_color : string -> string -> unit; + set_label : string -> string -> unit; + set_rc : int -> string -> unit; + connect : (unit -> unit) -> unit; + hide_buttons : unit -> unit; + show_buttons : unit -> unit > type strip_param = { color : string; @@ -76,8 +76,8 @@ let set_label labels name value = if l#text <> value then l#set_label value with - Not_found -> - fprintf stderr "Strip.set_label: '%s' unknown\n%!" name + Not_found -> + fprintf stderr "Strip.set_label: '%s' unknown\n%!" name (** set a color *) let set_color labels name color = @@ -85,116 +85,116 @@ let set_color labels name color = eb#coerce#misc#modify_bg [`NORMAL, `NAME color] class gauge = fun (gauge_da:GMisc.drawing_area) -> - object (self) - inherit Gtk_tools.pixmap_in_drawin_area ~drawing_area:gauge_da () - method layout = fun string -> - let context = gauge_da#misc#create_pango_context in - let layout = context#create_layout in - let fd = Pango.Context.get_font_description (Pango.Layout.get_context layout) in - Pango.Font.modify fd ~weight:`BOLD (); - context#set_font_description fd; - Pango.Layout.set_text layout string; - layout - method request_width = fun string -> - let layout = self#layout string in - let (width,_h) = Pango.Layout.get_pixel_size layout in - (gauge_da#misc#set_size_request ~width () : unit) - end +object (self) + inherit Gtk_tools.pixmap_in_drawin_area ~drawing_area:gauge_da () + method layout = fun string -> + let context = gauge_da#misc#create_pango_context in + let layout = context#create_layout in + let fd = Pango.Context.get_font_description (Pango.Layout.get_context layout) in + Pango.Font.modify fd ~weight:`BOLD (); + context#set_font_description fd; + Pango.Layout.set_text layout string; + layout + method request_width = fun string -> + let layout = self#layout string in + let (width,_h) = Pango.Layout.get_pixel_size layout in + (gauge_da#misc#set_size_request ~width () : unit) +end class vgauge = fun ?(color="green") ?(history_len=50) gauge_da v_min v_max -> - object (self) - inherit gauge gauge_da - val history = Array.create history_len 0 - val mutable history_index = -1 - method set = fun ?arrow ?(background="orange") value strings -> - let {Gtk.width=width; height=height} = gauge_da#misc#allocation in - if height > 1 then (* Else the drawing area is not allocated already *) - let dr = self#get_pixmap () in - dr#set_foreground (`NAME background); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); +object (self) + inherit gauge gauge_da + val history = Array.create history_len 0 + val mutable history_index = -1 + method set = fun ?arrow ?(background="orange") value strings -> + let {Gtk.width=width; height=height} = gauge_da#misc#allocation in + if height > 1 then (* Else the drawing area is not allocated already *) + let dr = self#get_pixmap () in + dr#set_foreground (`NAME background); + dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - let f = (value -. v_min) /. (v_max -. v_min) in - let f = max 0. (min 1. f) in - let h = truncate (float height *. f) in + let f = (value -. v_min) /. (v_max -. v_min) in + let f = max 0. (min 1. f) in + let h = truncate (float height *. f) in - (* First call: fill the array with the given value *) - if history_index < 0 then begin - for i = 0 to history_len - 1 do - history.(i) <- h - done; - history_index <- 0; - end; + (* First call: fill the array with the given value *) + if history_index < 0 then begin + for i = 0 to history_len - 1 do + history.(i) <- h + done; + history_index <- 0; + end; - (* Store the value in the history array and update index *) - history.(history_index) <- h; - history_index <- (history_index+1) mod history_len; + (* Store the value in the history array and update index *) + history.(history_index) <- h; + history_index <- (history_index+1) mod history_len; - dr#set_foreground (`NAME color); + dr#set_foreground (`NAME color); - (* From left to right, older to new values *) - let polygon = ref [0,height; width,height] in - for i = 0 to history_len - 1 do - let idx = (history_index+i) mod history_len in - polygon := ((i*width)/history_len, (height-history.(idx))):: !polygon; - done; - polygon := (width,height-h):: !polygon; - dr#polygon ~filled:true !polygon; + (* From left to right, older to new values *) + let polygon = ref [0,height; width,height] in + for i = 0 to history_len - 1 do + let idx = (history_index+i) mod history_len in + polygon := ((i*width)/history_len, (height-history.(idx))):: !polygon; + done; + polygon := (width,height-h):: !polygon; + dr#polygon ~filled:true !polygon; - (* Arrow for the variation *) - begin - match arrow with - None -> () - | Some angle_rad -> - let w = width and h = height in - let fh = 0.8 *. float w in - let x = truncate (cos angle_rad *. fh) - and y = - truncate (sin angle_rad *. fh) in - let a = -.angle_rad +. 5. *. LL.pi /. 6. - and a' = -.angle_rad -. 5. *. LL.pi /. 6. - and al = 0.2 *. fh in - let ax = truncate (cos a *. al) - and ay = truncate (sin a *. al) in - let ax' = truncate (cos a' *. al) - and ay' = truncate (sin a' *. al) in - let l = [w/10, h/2; w/10+x,h/2+y; w/10+x+ax,h/2+y+ay; w/10+x,h/2+y; w/10+x+ax',h/2+y+ay'] in - dr#set_foreground `BLACK; - dr#lines l - end; + (* Arrow for the variation *) + begin + match arrow with + None -> () + | Some angle_rad -> + let w = width and h = height in + let fh = 0.8 *. float w in + let x = truncate (cos angle_rad *. fh) + and y = - truncate (sin angle_rad *. fh) in + let a = -.angle_rad +. 5. *. LL.pi /. 6. + and a' = -.angle_rad -. 5. *. LL.pi /. 6. + and al = 0.2 *. fh in + let ax = truncate (cos a *. al) + and ay = truncate (sin a *. al) in + let ax' = truncate (cos a' *. al) + and ay' = truncate (sin a' *. al) in + let l = [w/10, h/2; w/10+x,h/2+y; w/10+x+ax,h/2+y+ay; w/10+x,h/2+y; w/10+x+ax',h/2+y+ay'] in + dr#set_foreground `BLACK; + dr#lines l + end; - List.iter (fun (vpos, string) -> - let layout = self#layout string in - let (w,h) = Pango.Layout.get_pixel_size layout in - let y = truncate (vpos *. float height) - h / 2 in - dr#put_layout ~x:((width-w)/2) ~y ~fore:`BLACK layout) - strings; + List.iter (fun (vpos, string) -> + let layout = self#layout string in + let (w,h) = Pango.Layout.get_pixel_size layout in + let y = truncate (vpos *. float height) - h / 2 in + dr#put_layout ~x:((width-w)/2) ~y ~fore:`BLACK layout) + strings; - (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - end + (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap +end class hgauge = fun ?(color="green") gauge_da v_min v_max -> - object (self) - inherit gauge gauge_da - method set = fun ?(background="orange") value string -> - let {Gtk.width=width; height=height} = gauge_da#misc#allocation in - if height > 1 then (* Else the drawing area is not allocated already *) - let dr = self#get_pixmap () in - dr#set_foreground (`NAME background); - dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); +object (self) + inherit gauge gauge_da + method set = fun ?(background="orange") value string -> + let {Gtk.width=width; height=height} = gauge_da#misc#allocation in + if height > 1 then (* Else the drawing area is not allocated already *) + let dr = self#get_pixmap () in + dr#set_foreground (`NAME background); + dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); - let f = (value -. v_min) /. (v_max -. v_min) in - let f = max 0. (min 1. f) in - let w = truncate (float width *. f) in + let f = (value -. v_min) /. (v_max -. v_min) in + let f = max 0. (min 1. f) in + let w = truncate (float width *. f) in - dr#set_foreground (`NAME color); - dr#rectangle ~x:0 ~y:0 ~width:w ~height ~filled:true (); + dr#set_foreground (`NAME color); + dr#rectangle ~x:0 ~y:0 ~width:w ~height ~filled:true (); - let layout = self#layout string in - let (w,h) = Pango.Layout.get_pixel_size layout in - dr#put_layout ~x:((width-w)/2) ~y:((height-h)/2) ~fore:`BLACK layout; + let layout = self#layout string in + let (w,h) = Pango.Layout.get_pixel_size layout in + dr#put_layout ~x:((width-w)/2) ~y:((height-h)/2) ~fore:`BLACK layout; - (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap - end + (new GDraw.drawable gauge_da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap +end (** add a strip to the panel *) (*let add = fun config color min_bat max_bat ->*) @@ -288,9 +288,9 @@ let add = fun config strip_param -> let pixbuf = GdkPixbuf.from_file (Env.gcs_icons_path // icon) in ignore (GMisc.image ~pixbuf ~packing:b#add ()) with - exc -> - fprintf stderr "Error: %s\n" (Printexc.to_string exc); - ignore (GMisc.label ~text:"?" ~packing:b#add ())) + exc -> + fprintf stderr "Error: %s\n" (Printexc.to_string exc); + ignore (GMisc.label ~text:"?" ~packing:b#add ())) [ strip#button_launch, "launch.png"; strip#button_kill, "kill.png"; strip#button_resurrect, "resurrect.png"; @@ -302,123 +302,123 @@ let add = fun config strip_param -> strip#button_right, "right.png"; ]; - object - val mutable climb = 0. - val mutable button_tbl = Hashtbl.create 10 - method set_climb = fun v -> climb <- v - method set_agl value = - let arrow = max (min 0.5 (climb /. 5.)) (-0.5) in - agl#set ~arrow value [0.2, (sprintf "%3.0f" value); 0.8, sprintf "%+.1f" climb] - method set_bat value = bat#set value [0.5, (string_of_float value)] - method set_throttle ?(kill=false) value = - let background = if kill then "red" else "orange" in - throttle#set ~background value (sprintf "%.0f%%" value) - method set_speed value = speed#set value (sprintf "%.1fm/s" value) +object + val mutable climb = 0. + val mutable button_tbl = Hashtbl.create 10 + method set_climb = fun v -> climb <- v + method set_agl value = + let arrow = max (min 0.5 (climb /. 5.)) (-0.5) in + agl#set ~arrow value [0.2, (sprintf "%3.0f" value); 0.8, sprintf "%+.1f" climb] + method set_bat value = bat#set value [0.5, (string_of_float value)] + method set_throttle ?(kill=false) value = + let background = if kill then "red" else "orange" in + throttle#set ~background value (sprintf "%.0f%%" value) + method set_speed value = speed#set value (sprintf "%.1fm/s" value) - method set_airspeed value = - let text = sprintf "Ground speed (est. airspeed: %.1fm/s)" value in - let tooltips = GData.tooltips () in - tooltips#set_tip strip#eventbox_speed#coerce ~text + method set_airspeed value = + let text = sprintf "Ground speed (est. airspeed: %.1fm/s)" value in + let tooltips = GData.tooltips () in + tooltips#set_tip strip#eventbox_speed#coerce ~text - method connect_mark callback = - ignore (strip#button_mark#connect#clicked callback) + method connect_mark callback = + ignore (strip#button_mark#connect#clicked callback) - method set_label name value = set_label !strip_labels name value - method set_color name value = set_color !strip_labels name value + method set_label name value = set_label !strip_labels name value + method set_color name value = set_color !strip_labels name value - method set_rc rate status = rc#set (float_of_int rate) status + method set_rc rate status = rc#set (float_of_int rate) status (* add a button widget in a vertical box if it belongs to a group (create new group if needed) *) - method add_widget ?(group="") w = - let (vbox, pack) = match String.length group with - 0 -> (GPack.vbox ~show:true (), true) - | _ -> try (Hashtbl.find button_tbl group, false) with - Not_found -> - let vb = GPack.vbox ~show:true () in - ignore(Hashtbl.add button_tbl group vb); - (vb, true) - in + method add_widget ?(group="") w = + let (vbox, pack) = match String.length group with + 0 -> (GPack.vbox ~show:true (), true) + | _ -> try (Hashtbl.find button_tbl group, false) with + Not_found -> + let vb = GPack.vbox ~show:true () in + ignore(Hashtbl.add button_tbl group vb); + (vb, true) + in (*let vbox = GPack.vbox ~show:true () in*) - vbox#pack ~fill:false w; - if pack then strip#hbox_user#pack ~fill:false vbox#coerce else () + vbox#pack ~fill:false w; + if pack then strip#hbox_user#pack ~fill:false vbox#coerce else () - method connect_shift_alt callback = - let tooltips = GData.tooltips () in - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_minus in - ignore (tooltips#set_tip strip#button_down#coerce ~text); - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus in - ignore (tooltips#set_tip strip#button_up#coerce ~text); - let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus_plus in - ignore (tooltips#set_tip strip#button_up_up#coerce ~text); - connect_buttons callback - [ strip#button_down, alt_shift_minus; - strip#button_up, alt_shift_plus; - strip#button_up_up, alt_shift_plus_plus] + method connect_shift_alt callback = + let tooltips = GData.tooltips () in + let text = Printf.sprintf "Altitude %+.1fm" alt_shift_minus in + ignore (tooltips#set_tip strip#button_down#coerce ~text); + let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus in + ignore (tooltips#set_tip strip#button_up#coerce ~text); + let text = Printf.sprintf "Altitude %+.1fm" alt_shift_plus_plus in + ignore (tooltips#set_tip strip#button_up_up#coerce ~text); + connect_buttons callback + [ strip#button_down, alt_shift_minus; + strip#button_up, alt_shift_plus; + strip#button_up_up, alt_shift_plus_plus] - method connect_shift_lateral = fun callback -> - connect_buttons callback - [ strip#button_left, -5.; - strip#button_right, 5.; - strip#button_center, 0.] + method connect_shift_lateral = fun callback -> + connect_buttons callback + [ strip#button_left, -5.; + strip#button_right, 5.; + strip#button_center, 0.] - method connect_kill = fun callback -> - let callback = fun x -> - if x = 1. then - match GToolbox.question_box ~title:"Kill throttle" ~buttons:["Kill"; "Cancel"] (sprintf "Kill throttle of A/C %s ?" ac_name) with - 1 -> callback 1. - | _ -> () - else (* No confirmation for resurrect *) - callback x - in - connect_buttons callback - [ strip#button_kill, 1.; - strip#button_resurrect, 0.] + method connect_kill = fun callback -> + let callback = fun x -> + if x = 1. then + match GToolbox.question_box ~title:"Kill throttle" ~buttons:["Kill"; "Cancel"] (sprintf "Kill throttle of A/C %s ?" ac_name) with + 1 -> callback 1. + | _ -> () + else (* No confirmation for resurrect *) + callback x + in + connect_buttons callback + [ strip#button_kill, 1.; + strip#button_resurrect, 0.] - method connect_launch = fun callback -> - connect_buttons callback - [ strip#button_launch, 1. ] + method connect_launch = fun callback -> + connect_buttons callback + [ strip#button_launch, 1. ] - method connect_mode = fun callback -> - let callback = fun _ -> (* Back in AUTO2 *) - match GToolbox.question_box ~title:"Back to auto" ~buttons:["AUTO"; "Cancel"] (sprintf "Restore AUTO mode for A/C %s ?" ac_name) with - 1 -> callback 2.; true - | _ -> true in - ignore(strip#eventbox_mode#event#connect#button_press ~callback) + method connect_mode = fun callback -> + let callback = fun _ -> (* Back in AUTO2 *) + match GToolbox.question_box ~title:"Back to auto" ~buttons:["AUTO"; "Cancel"] (sprintf "Restore AUTO mode for A/C %s ?" ac_name) with + 1 -> callback 2.; true + | _ -> true in + ignore(strip#eventbox_mode#event#connect#button_press ~callback) (* Reset the flight time *) - method connect_flight_time = fun callback -> - let callback = fun _ -> (* Reset flight time *) - match GToolbox.question_box ~title:"Reset flight time" ~buttons:["Reset"; "Cancel"] (sprintf "Reset flight time for A/C %s ?" ac_name) with - 1 -> callback 0.; true - | _ -> true in - ignore(strip#eventbox_flight_time#event#connect#button_press ~callback) + method connect_flight_time = fun callback -> + let callback = fun _ -> (* Reset flight time *) + match GToolbox.question_box ~title:"Reset flight time" ~buttons:["Reset"; "Cancel"] (sprintf "Reset flight time for A/C %s ?" ac_name) with + 1 -> callback 0.; true + | _ -> true in + ignore(strip#eventbox_flight_time#event#connect#button_press ~callback) (** Appointment date *) - method connect_apt = fun get_ac_unix_time send_value -> - strip#label_apt#misc#show (); - strip#label_apt_value#misc#show (); - let callback = fun _ -> - let w = new Gtk_setting_time.setting_time ~file () in - let utc = Unix.gmtime (get_ac_unix_time () +. 60.) in - w#spinbutton_hour#set_value (float utc.Unix.tm_hour); - w#spinbutton_min#set_value (float utc.Unix.tm_min); - ignore (w#button_cancel#connect#clicked (fun () -> w#setting_time#destroy ())); - let callback = fun () -> - let hour = truncate w#spinbutton_hour#value - and min = truncate w#spinbutton_min#value - and sec = truncate w#spinbutton_sec#value in - w#setting_time#destroy (); - let tow = Latlong.gps_tow_of_utc hour min sec in - send_value (float tow) in - ignore (w#button_ok#connect#clicked callback); - true - in - ignore(strip#eventbox_RDV#event#connect#button_press ~callback) + method connect_apt = fun get_ac_unix_time send_value -> + strip#label_apt#misc#show (); + strip#label_apt_value#misc#show (); + let callback = fun _ -> + let w = new Gtk_setting_time.setting_time ~file () in + let utc = Unix.gmtime (get_ac_unix_time () +. 60.) in + w#spinbutton_hour#set_value (float utc.Unix.tm_hour); + w#spinbutton_min#set_value (float utc.Unix.tm_min); + ignore (w#button_cancel#connect#clicked (fun () -> w#setting_time#destroy ())); + let callback = fun () -> + let hour = truncate w#spinbutton_hour#value + and min = truncate w#spinbutton_min#value + and sec = truncate w#spinbutton_sec#value in + w#setting_time#destroy (); + let tow = Latlong.gps_tow_of_utc hour min sec in + send_value (float tow) in + ignore (w#button_ok#connect#clicked callback); + true + in + ignore(strip#eventbox_RDV#event#connect#button_press ~callback) - method hide_buttons () = strip#hbox_user#misc#hide (); strip#frame_nav#misc#set_sensitive false - method show_buttons () = strip#hbox_user#misc#show (); strip#frame_nav#misc#set_sensitive true - method connect = fun (select: unit -> unit) -> - let callback = fun _ -> select (); true in - ignore (strip#eventbox_strip#event#connect#button_press ~callback) - end + method hide_buttons () = strip#hbox_user#misc#hide (); strip#frame_nav#misc#set_sensitive false + method show_buttons () = strip#hbox_user#misc#show (); strip#frame_nav#misc#set_sensitive true + method connect = fun (select: unit -> unit) -> + let callback = fun _ -> select (); true in + ignore (strip#eventbox_strip#event#connect#button_press ~callback) +end diff --git a/sw/ground_segment/joystick/input2ivy.ml b/sw/ground_segment/joystick/input2ivy.ml index 45dc8ea5d2..b88c683bc5 100644 --- a/sw/ground_segment/joystick/input2ivy.ml +++ b/sw/ground_segment/joystick/input2ivy.ml @@ -23,14 +23,14 @@ *) (* 1/26/2011 - Additional functionality added by jpeverill: - Joystick xml config files now loaded from PAPARAZZI_HOME/conf/joystick/ - Exponential output setting (per channel) - Limit output setting (per channel) - Per channel trim, controlled through joystick buttons - Trim can also be saved into auxilliary file, based on aircraft, and loaded at runtime if it exists - File will be called ..trim and is saved in the conf/joystick directory as well - Division in channel mapping - Interactive keyboard trim control (primitive) + Joystick xml config files now loaded from PAPARAZZI_HOME/conf/joystick/ + Exponential output setting (per channel) + Limit output setting (per channel) + Per channel trim, controlled through joystick buttons + Trim can also be saved into auxilliary file, based on aircraft, and loaded at runtime if it exists + File will be called ..trim and is saved in the conf/joystick directory as well + Division in channel mapping + Interactive keyboard trim control (primitive) *) open Printf @@ -64,7 +64,7 @@ let index_of_blocks = Hashtbl.create 13 (** External C functions to access the input device *) external stick_init : int -> int = "ml_stick_init" (** [stick_init device] Return 0 on success. Search for a device if [device] - is the empty string *) + is the empty string *) external stick_read : unit -> int * int * int array = "ml_stick_read" (** Return the number of buttons, an integer of bits for the buttons values @@ -82,13 +82,13 @@ type input = (** Description of a message *) type msg = { - msg_name : string; - msg_class : string; - fields : (string * Syntax.expression) list; - on_event : Syntax.expression option; - send_always : bool; - has_ac_id : bool - } + msg_name : string; + msg_class : string; + fields : (string * Syntax.expression) list; + on_event : Syntax.expression option; + send_always : bool; + has_ac_id : bool +} (** Representation of a variable *) type var = { @@ -98,11 +98,11 @@ type var = { (** Represenation of an input device, the messages to send and the variables *) type actions = { - period_ms : int; - inputs : (string*input) list; - messages : msg list; - variables : (string*var) list; - } + period_ms : int; + inputs : (string*input) list; + messages : msg list; + variables : (string*var) list; +} (** adjust the trim on an axis given its name *) let trim_adjust = fun axis_name adjustment -> @@ -111,20 +111,20 @@ let trim_adjust = fun axis_name adjustment -> (** Get message class type *) let get_message_type = fun class_name -> match class_name with - "datalink" -> "Message" - | "ground" -> "Message" - | "trim_plus" -> "Trim" - | "trim_minus" -> "Trim" - | "trim_save" -> "Trim" - | _ -> failwith class_name + "datalink" -> "Message" + | "ground" -> "Message" + | "trim_plus" -> "Trim" + | "trim_minus" -> "Trim" + | "trim_save" -> "Trim" + | _ -> failwith class_name (** Get a message description from its name (and class name) *) (** class_names with entries above as "Message" should be listed here *) let get_message = fun class_name msg_name -> match class_name with - "datalink" -> snd (DL.message_of_name msg_name) - | "ground" -> snd (G.message_of_name msg_name) - | _ -> failwith class_name + "datalink" -> snd (DL.message_of_name msg_name) + | "ground" -> snd (G.message_of_name msg_name) + | _ -> failwith class_name (** Get the A/C id from its name in conf/conf.xml *) let ac_id_of_name = fun ac_name -> @@ -133,8 +133,8 @@ let ac_id_of_name = fun ac_name -> let aircraft = ExtXml.child ~select:(fun x -> Xml.attrib x "name" = ac_name) conf_xml "aircraft" in ExtXml.int_attrib aircraft "ac_id" with - Not_found -> - failwith (sprintf "A/C '%s' not found" ac_name) + Not_found -> + failwith (sprintf "A/C '%s' not found" ac_name) (** Fill the index_of_settings table from var/AC/settings.xml *) let hash_index_of_settings = fun ac_name -> @@ -168,29 +168,29 @@ let hash_index_of_blocks = fun ac_name -> (* Return the rank of an element in a list, first is 0 *) let rank = fun x l -> let rec loop i = function - [] -> raise Not_found + [] -> raise Not_found | y::ys -> if x = y then i else loop (i+1) ys in loop 0 l (** Eval IndexOfEnum, IndexOfSetting and IndexOfBlock built-in functions - in an expression *) + in an expression *) let eval_settings_and_blocks = fun field_descr expr -> let rec loop = function - Syntax.Call ("IndexOfEnum", [Syntax.Ident enum]) -> begin - try Syntax.Int (rank enum field_descr.Pprz.enum) with - Not_found -> failwith (sprintf "IndexOfEnum: unknown value '%s'" enum) - end - | Syntax.Call ("IndexOfSetting", [Syntax.Ident var]) -> begin + Syntax.Call ("IndexOfEnum", [Syntax.Ident enum]) -> begin + try Syntax.Int (rank enum field_descr.Pprz.enum) with + Not_found -> failwith (sprintf "IndexOfEnum: unknown value '%s'" enum) + end + | Syntax.Call ("IndexOfSetting", [Syntax.Ident var]) -> begin try Syntax.Int (Hashtbl.find index_of_settings var) with - Not_found -> failwith (sprintf "IndexOfSetting: unknown var '%s'" var) + Not_found -> failwith (sprintf "IndexOfSetting: unknown var '%s'" var) end - | Syntax.Call ("IndexOfBlock", [Syntax.Ident name]) -> begin + | Syntax.Call ("IndexOfBlock", [Syntax.Ident name]) -> begin try Syntax.Int (Hashtbl.find index_of_blocks name) with - Not_found -> failwith (sprintf "IndexOfBlock: unknown block '%s'" name) + Not_found -> failwith (sprintf "IndexOfBlock: unknown block '%s'" name) end - | Syntax.Call (ident, exprs) | Syntax.CallOperator (ident, exprs) -> + | Syntax.Call (ident, exprs) | Syntax.CallOperator (ident, exprs) -> Syntax.Call (ident, List.map loop exprs) - | e -> e in + | e -> e in loop expr (** Parse an XML list of input channels *) @@ -200,16 +200,16 @@ let parse_input = fun input -> and index = ExtXml.int_attrib x "index" in let value = match Xml.tag x with - "axis" -> - let trim = try ExtXml.float_attrib x "trim" with _ -> 0.0 in - let exponent = try ExtXml.float_attrib x "exponent" with _ -> 0.0 in - let limit = try ExtXml.float_attrib x "limit" with _ -> 1.0 in - let deadband = try ExtXml.int_attrib x "deadband" with _ -> 0 in - Axis (index, deadband, limit, exponent, ref trim) - | "button" -> Button index - | _ -> failwith "parse_input: unexepcted tag" in + "axis" -> + let trim = try ExtXml.float_attrib x "trim" with _ -> 0.0 in + let exponent = try ExtXml.float_attrib x "exponent" with _ -> 0.0 in + let limit = try ExtXml.float_attrib x "limit" with _ -> 1.0 in + let deadband = try ExtXml.int_attrib x "deadband" with _ -> 0 in + Axis (index, deadband, limit, exponent, ref trim) + | "button" -> Button index + | _ -> failwith "parse_input: unexepcted tag" in (name, value)) - (Xml.children input) + (Xml.children input) (** Parse a 'à la C' expression *) let parse_value = fun s -> @@ -231,12 +231,12 @@ let parse_msg = fun msg -> let fields, has_ac_id = match get_message_type msg_class with - "Message" -> - let msg_descr = get_message msg_class msg_name in - (List.map (parse_msg_field msg_descr) (Xml.children msg), - List.mem_assoc "ac_id" msg_descr.Pprz.fields) - | "Trim" -> ([], false) - | _ -> failwith ("Unknown message class type") in + "Message" -> + let msg_descr = get_message msg_class msg_name in + (List.map (parse_msg_field msg_descr) (Xml.children msg), + List.mem_assoc "ac_id" msg_descr.Pprz.fields) + | "Trim" -> ([], false) + | _ -> failwith ("Unknown message class type") in let on_event = try Some (parse_value (Xml.attrib msg "on_event")) with _ -> None in @@ -254,23 +254,23 @@ let parse_variables = fun variables -> let l = ref [] in List.iter (fun x -> match Xml.tag x with - "var" -> - let name = Xml.attrib x "name" - and default = ExtXml.int_attrib x "default" in - if List.mem_assoc name !l then failwith (sprintf "Variable %s already declared" name); + "var" -> + let name = Xml.attrib x "name" + and default = ExtXml.int_attrib x "default" in + if List.mem_assoc name !l then failwith (sprintf "Variable %s already declared" name); (* filter all "set" node for this variable *) - let set = List.filter (fun vs -> + let set = List.filter (fun vs -> (ExtXml.tag_is vs "set") && - (compare (ExtXml.attrib_or_default vs "var" "") name) = 0) - (Xml.children variables) in - let var_event = List.map (fun s -> - let value = ExtXml.int_attrib s "value" - and on_event = parse_value (Xml.attrib s "on_event") in - (value, on_event) + (compare (ExtXml.attrib_or_default vs "var" "") name) = 0) + (Xml.children variables) in + let var_event = List.map (fun s -> + let value = ExtXml.int_attrib s "value" + and on_event = parse_value (Xml.attrib s "on_event") in + (value, on_event) ) set in - l := (name, { value = default; var_event = var_event; }) :: !l; - () - | _ -> () + l := (name, { value = default; var_event = var_event; }) :: !l; + () + | _ -> () ) (Xml.children variables); !l @@ -288,8 +288,8 @@ let second_of_two (_,x) = x let trim_set = fun inputs value -> let input = my_assoc (first_of_two value) inputs in match input with - Axis (i, deadband, limit, exponent, trim) -> trim := (second_of_two value) - | Button i -> failwith "No trim for buttons" + Axis (i, deadband, limit, exponent, trim) -> trim := (second_of_two value) + | Button i -> failwith "No trim for buttons" (** Input the trim file if it exists *) @@ -298,10 +298,10 @@ let parse_trim_file = fun trim_file_name inputs -> let trim = Xml.parse_file trim_file_name in let trim_values = List.map (fun x -> - let axis = ExtXml.attrib x "axis" - and trimval = ExtXml.float_attrib x "value" in - (axis, trimval)) - (Xml.children trim) in + let axis = ExtXml.attrib x "axis" + and trimval = ExtXml.float_attrib x "value" in + (axis, trimval)) + (Xml.children trim) in List.iter (trim_set inputs) trim_values; end @@ -343,8 +343,8 @@ let apply_trim = fun x trim -> (** Access to an input value, button or axis *) let eval_input = fun buttons axis input -> match input with - Axis (i, deadband, limit, exponent, trim) -> (apply_trim (apply_limit (apply_exponent (apply_deadband axis.(i) deadband) exponent) limit) trim.contents) - | Button i -> (buttons lsr i) land 0x1 + Axis (i, deadband, limit, exponent, trim) -> (apply_trim (apply_limit (apply_exponent (apply_deadband axis.(i) deadband) exponent) limit) trim.contents) + | Button i -> (buttons lsr i) land 0x1 (** Scale a value in the given bounds *) let scale = fun x min max -> @@ -360,10 +360,10 @@ let fit = fun x min max min_input max_input -> bound v min_input max_input (** Return a pprz RC mode - * mode > max -> 2 - * mode < min -> 0 - * else 1 - *) + * mode > max -> 2 + * mode < min -> 0 + * else 1 +*) let pprz_threshold = max_input / 2 let pprz_mode = fun mode -> if mode > pprz_threshold then 2 @@ -373,39 +373,39 @@ let pprz_mode = fun mode -> (** Eval a function call (TO BE COMPLETED) *) let eval_call = fun f args -> match f, args with - "-", [a] -> - a - | "-", [a1; a2] -> a1 - a2 - | "+", [a1; a2] -> a1 + a2 - | "*", [a1; a2] -> a1 * a2 - | "%", [a1; a2] -> a1 / a2 - | "&&", [a1; a2] -> a1 land a2 - | "||", [a1; a2] -> a1 lor a2 - | "<", [a1; a2] -> if a1 < a2 then 1 else 0 - | ">", [a1; a2] -> if a1 > a2 then 1 else 0 - | "Scale", [x; min; max] -> scale (x) (min) (max) - | "Fit", [x; min; max; min_input; max_input] -> fit (x) (min) (max) (min_input) (max_input) - | "Bound", [x; min; max] -> bound (x) (min) (max) - | "PprzMode", [x] -> pprz_mode (x) - | "JoystickID", [] -> !joystick_id - | f, args -> failwith (sprintf "eval_call: unknown function '%s'" f) + "-", [a] -> - a + | "-", [a1; a2] -> a1 - a2 + | "+", [a1; a2] -> a1 + a2 + | "*", [a1; a2] -> a1 * a2 + | "%", [a1; a2] -> a1 / a2 + | "&&", [a1; a2] -> a1 land a2 + | "||", [a1; a2] -> a1 lor a2 + | "<", [a1; a2] -> if a1 < a2 then 1 else 0 + | ">", [a1; a2] -> if a1 > a2 then 1 else 0 + | "Scale", [x; min; max] -> scale (x) (min) (max) + | "Fit", [x; min; max; min_input; max_input] -> fit (x) (min) (max) (min_input) (max_input) + | "Bound", [x; min; max] -> bound (x) (min) (max) + | "PprzMode", [x] -> pprz_mode (x) + | "JoystickID", [] -> !joystick_id + | f, args -> failwith (sprintf "eval_call: unknown function '%s'" f) (** Eval an expression *) let eval_expr = fun buttons axis inputs variables expr -> let rec eval = function - Syntax.Ident ident -> + Syntax.Ident ident -> (* try input first, then variables *) - let i = match (List.mem_assoc ident inputs, List.mem_assoc ident variables) with - (true, _) -> eval_input buttons axis (List.assoc ident inputs) - | (false, true) -> - let v = List.assoc ident variables in - v.value - | (false, false) -> failwith (sprintf "eval_expr: %s not found" ident) - in - i + let i = match (List.mem_assoc ident inputs, List.mem_assoc ident variables) with + (true, _) -> eval_input buttons axis (List.assoc ident inputs) + | (false, true) -> + let v = List.assoc ident variables in + v.value + | (false, false) -> failwith (sprintf "eval_expr: %s not found" ident) + in + i | Syntax.Int int -> int | Syntax.Float float -> failwith "eval_expr: float" | Syntax.Call (ident, exprs) | Syntax.CallOperator (ident, exprs) -> - eval_call ident (List.map eval exprs) + eval_call ident (List.map eval exprs) | Syntax.Index _ -> failwith "eval_expr: index" | Syntax.Field _ -> failwith "eval_expr: Field" | Syntax.Deref _ -> failwith "eval_expr: deref" in @@ -431,8 +431,8 @@ let trim_save_add_leaf = fun x channel_pair -> let chan_name = first_list channel_pair in let channel = second_list channel_pair in match channel with - Axis (i, deadband, limit, exponent, trim) -> x := x.contents ^ (Printf.sprintf "" chan_name trim.contents) - | Button i -> Printf.printf "%d" i + Axis (i, deadband, limit, exponent, trim) -> x := x.contents ^ (Printf.sprintf "" chan_name trim.contents) + | Button i -> Printf.printf "%d" i (** save trim settings to file *) let trim_save = fun inputs -> @@ -449,8 +449,8 @@ let trim_save = fun inputs -> let trim_adjust = fun axis_name adjustment inputs -> let input = my_assoc axis_name inputs in match input with - Axis (i, deadband, limit, exponent, trim) -> trim := trim.contents +. adjustment - | Button i -> failwith "No trim for buttons" + Axis (i, deadband, limit, exponent, trim) -> trim := trim.contents +. adjustment + | Button i -> failwith "No trim for buttons" (** Update variables state *) let update_variables = fun inputs buttons axis variables -> @@ -473,20 +473,20 @@ let execute_action = fun ac_id inputs buttons axis variables message -> and on_event = match message.on_event with - None -> true - | Some expr -> eval_expr buttons axis inputs variables expr <> 0 in + None -> true + | Some expr -> eval_expr buttons axis inputs variables expr <> 0 in let previous_values = get_previous_values message.msg_name in (* FIXME ((value <> previous) && on_event) || send_always ??? *) if ( ( (on_event, values) <> previous_values ) || message.send_always ) && on_event then begin let vs = if message.has_ac_id then ("ac_id", Pprz.Int ac_id) :: values else values in match message.msg_class with - "datalink" -> DL.message_send "input2ivy" message.msg_name vs - | "ground" -> G.message_send "input2ivy" message.msg_name vs - | "trim_plus" -> trim_adjust message.msg_name trim_step inputs - | "trim_minus" -> trim_adjust message.msg_name (-.trim_step) inputs - | "trim_save" -> trim_save inputs - | c -> failwith (sprintf "execute_action: unknown class '%s'" c) + "datalink" -> DL.message_send "input2ivy" message.msg_name vs + | "ground" -> G.message_send "input2ivy" message.msg_name vs + | "trim_plus" -> trim_adjust message.msg_name trim_step inputs + | "trim_minus" -> trim_adjust message.msg_name (-.trim_step) inputs + | "trim_save" -> trim_save inputs + | c -> failwith (sprintf "execute_action: unknown class '%s'" c) end; record_values message.msg_name (on_event, values) @@ -505,7 +505,7 @@ let print_inputs = fun nb_buttons buttons axis -> (** Get the values from the input values and send messages - This is called at a rate programmed in the xml *) + This is called at a rate programmed in the xml *) let execute_actions = fun actions ac_id -> try let (nb_buttons, buttons, axis) = stick_read () in @@ -517,7 +517,7 @@ let execute_actions = fun actions ac_id -> update_variables actions.inputs buttons axis actions.variables; List.iter (execute_action ac_id actions.inputs buttons axis actions.variables) actions.messages with - exc -> prerr_endline (Printexc.to_string exc) + exc -> prerr_endline (Printexc.to_string exc) (** process keyboard commands *) @@ -530,16 +530,16 @@ let execute_kb_action = fun actions conditions -> ijkm for right *) if true then begin - match ch with - 101 -> trim_adjust "ly" 1.0 actions.inputs - | 115 -> trim_adjust "lx" (-1.0) actions.inputs - | 100 -> trim_adjust "lx" 1.0 actions.inputs - | 120 -> trim_adjust "ly" (-1.0) actions.inputs - | 105 -> trim_adjust "ry" 1.0 actions.inputs - | 106 -> trim_adjust "rx" (-1.0) actions.inputs - | 107 -> trim_adjust "rx" 1.0 actions.inputs - | 109 -> trim_adjust "ry" (-1.0) actions.inputs - | _ -> trim_adjust "ly" 0.0 actions.inputs + match ch with + 101 -> trim_adjust "ly" 1.0 actions.inputs + | 115 -> trim_adjust "lx" (-1.0) actions.inputs + | 100 -> trim_adjust "lx" 1.0 actions.inputs + | 120 -> trim_adjust "ly" (-1.0) actions.inputs + | 105 -> trim_adjust "ry" 1.0 actions.inputs + | 106 -> trim_adjust "rx" (-1.0) actions.inputs + | 107 -> trim_adjust "rx" 1.0 actions.inputs + | 109 -> trim_adjust "ry" (-1.0) actions.inputs + | _ -> trim_adjust "ly" 0.0 actions.inputs end; true @@ -593,8 +593,8 @@ let () = (** setup stdin *) (* TODO find a better way to change trim, use a GUI ? *) (*let tstatus = (Unix.tcgetattr Unix.stdin) in - tstatus.c_icanon <- false; - Unix.tcsetattr Unix.stdin Unix.TCSANOW tstatus;*) + tstatus.c_icanon <- false; + Unix.tcsetattr Unix.stdin Unix.TCSANOW tstatus;*) ignore (Glib.Timeout.add actions.period_ms (fun () -> execute_actions actions ac_id; true)); (*ignore (Glib.Io.add_watch ~cond:[`IN] ~callback:(fun x -> execute_kb_action actions x) (Glib.Io.channel_of_descr Unix.stdin));*) diff --git a/sw/ground_segment/multimon/test_gen_hdlc.ml b/sw/ground_segment/multimon/test_gen_hdlc.ml index 71d14ae0e2..e155315441 100644 --- a/sw/ground_segment/multimon/test_gen_hdlc.ml +++ b/sw/ground_segment/multimon/test_gen_hdlc.ml @@ -13,14 +13,14 @@ let _ = let i = ref 0 in let cb = fun _ -> incr i; -(***) + (***) Hdlc.write_data (let s = Printf.sprintf "coucou [%d]" !i in prerr_endline s; s); true in (***) ignore (Glib.Timeout.add 1000 cb); (***) ignore (Glib.Timeout.add 90 (fun _ -> Hdlc.write_to_dsp (); true)); -(** ignore (Glib.Timeout.add 100 (fun _ -> prerr_endline "x"; true)); **) + (** ignore (Glib.Timeout.add 100 (fun _ -> prerr_endline "x"; true)); **) (** Threaded main loop (blocking write) *) GtkThread.main () diff --git a/sw/ground_segment/tmtc/150m.ml b/sw/ground_segment/tmtc/150m.ml index 02b00e1bc3..694206f1c6 100644 --- a/sw/ground_segment/tmtc/150m.ml +++ b/sw/ground_segment/tmtc/150m.ml @@ -1,7 +1,7 @@ (** Code example on the Ivy bus. - Agent which monitors the altitude from the ground and set the A/C in HOME mode - if it reaches 150m. Also displays this altitude and a HOME button to allow the user - to force the HOME mode *) + Agent which monitors the altitude from the ground and set the A/C in HOME mode + if it reaches 150m. Also displays this altitude and a HOME button to allow the user + to force the HOME mode *) let (//) = Filename.concat @@ -27,13 +27,13 @@ module Datalink_Pprz = Pprz.Messages(struct let name = "datalink" end) (******************************* Send the message to the A/C to set it in HOME mode *) let set_to_HOME = fun () -> let vs = ["ac_id", Pprz.String ac_id; - "index", Pprz.Int index_pprz_mode; - "value", Pprz.Float (float autopilot_HOME_mode_value)] in + "index", Pprz.Int index_pprz_mode; + "value", Pprz.Float (float autopilot_HOME_mode_value)] in Datalink_Pprz.message_send "dl" "SETTING" vs (******************************* Get GPS message, display the altitude from the SRTM -model, and set to HOME if higher than 150m *) + model, and set to HOME if higher than 150m *) let get_gps_message = fun label _sender vs -> (* Extract data from the message *) let alt_m = Pprz.int_assoc "alt" vs / 100 @@ -43,8 +43,8 @@ let get_gps_message = fun label _sender vs -> (* Build the geographic position *) let utm = { Latlong.utm_x = float utm_east; - Latlong.utm_y = float utm_north; - Latlong.utm_zone = utm_zone } in + Latlong.utm_y = float utm_north; + Latlong.utm_zone = utm_zone } in (* Get the ground altitude from the SRTM model *) let srtm_alt_m = Srtm.of_utm utm in @@ -61,7 +61,7 @@ let get_gps_message = fun label _sender vs -> (********************************* Main *********************************************) let () = - let ivy_bus = Defivybus.default_ivy_bus in + let ivy_bus = Defivybus.default_ivy_bus in (** Connect to the Ivy bus *) Ivy.init "Paparazzi 150m" "READY" (fun _ _ -> ()); diff --git a/sw/ground_segment/tmtc/aircraft.ml b/sw/ground_segment/tmtc/aircraft.ml index 65db850408..9a4b64ec63 100644 --- a/sw/ground_segment/tmtc/aircraft.ml +++ b/sw/ground_segment/tmtc/aircraft.ml @@ -23,47 +23,47 @@ open Latlong type ac_cam = { - mutable phi : float; (* Rad, right = >0 *) - mutable theta : float; (* Rad, front = >0 *) - mutable target : (float * float) (* meter*meter relative *) - } + mutable phi : float; (* Rad, right = >0 *) + mutable theta : float; (* Rad, front = >0 *) + mutable target : (float * float) (* meter*meter relative *) +} type rc_status = string (** OK, LOST, REALLY_LOST *) type rc_mode = string (** MANUAL, AUTO, FAILSAFE *) type fbw = { - mutable rc_status : rc_status; - mutable rc_mode : rc_mode; - mutable rc_rate : int; - mutable pprz_mode_msgs_since_last_fbw_status_msg : int; - } + mutable rc_status : rc_status; + mutable rc_mode : rc_mode; + mutable rc_rate : int; + mutable pprz_mode_msgs_since_last_fbw_status_msg : int; +} let gps_nb_channels = 16 type svinfo = { - svid : int; - flags : int; - qi : int; - cno : int; - elev : int; - azim : int; - mutable age : int - } + svid : int; + flags : int; + qi : int; + cno : int; + elev : int; + azim : int; + mutable age : int +} let svinfo_init = fun () -> { - svid = 0 ; - flags = 0; - qi = 0; - cno = 0; - elev = 0; - azim = 0; - age = 0 - } + svid = 0 ; + flags = 0; + qi = 0; + cno = 0; + elev = 0; + azim = 0; + age = 0 + } type inflight_calib = { - mutable if_mode : int; (* DOWN|OFF|UP *) - mutable if_val1 : float; - mutable if_val2 : float - } + mutable if_mode : int; (* DOWN|OFF|UP *) + mutable if_val1 : float; + mutable if_val2 : float +} type horiz_mode = Circle of Latlong.geographic * int @@ -88,13 +88,13 @@ let add_pos_to_nav_ref = fun nav_ref ?(z = 0.) (x, y) -> lat in match nav_ref with - Geo geo -> - let m_to_rad = 0.0005399568034557235 *. 0.00029088820866572159 in - let lat = lat_of_xy (geo.posn_lat +. asin (y*.m_to_rad)) 0. geo (x*.m_to_rad, y *.m_to_rad) 10 1.e-7 in - Latlong.make_geo lat (geo.posn_long +. asin (x*.m_to_rad /. cos lat)) - | Utm utm -> + Geo geo -> + let m_to_rad = 0.0005399568034557235 *. 0.00029088820866572159 in + let lat = lat_of_xy (geo.posn_lat +. asin (y*.m_to_rad)) 0. geo (x*.m_to_rad, y *.m_to_rad) 10 1.e-7 in + Latlong.make_geo lat (geo.posn_long +. asin (x*.m_to_rad /. cos lat)) + | Utm utm -> Latlong.of_utm Latlong.WGS84 (Latlong.utm_add utm (x, y)) - | Ltp ecef -> + | Ltp ecef -> let ned = Latlong.make_ned [| y; x; 0. |] in (* FIXME z=0 *) let (geo, _) = Latlong.geo_of_ecef Latlong.WGS84 (Latlong.ecef_of_ned ecef ned) in geo @@ -102,62 +102,62 @@ let add_pos_to_nav_ref = fun nav_ref ?(z = 0.) (x, y) -> type waypoint = { altitude : float; wp_geo : Latlong.geographic } type aircraft = { - mutable vehicle_type : vehicle_type; - id : string; - name : string; - flight_plan : Xml.xml; - airframe : Xml.xml; - mutable pos : Latlong.geographic; - mutable unix_time : float; - mutable itow : int32; (* ms *) - mutable roll : float; - mutable pitch : float; - mutable heading : float; (* rad, CW 0=N *) - mutable gspeed : float; (* m/s *) - mutable course : float; (* rad *) - mutable alt : float; - mutable agl : float; - mutable climb : float; - mutable nav_ref : nav_ref option; - mutable d_hmsl : float; - mutable desired_pos : Latlong.geographic; - mutable desired_altitude : float; - mutable desired_course : float; - mutable desired_climb : float; - mutable cur_block : int; - mutable cur_stage : int; - mutable throttle : float; - mutable kill_mode : bool; - mutable throttle_accu : float; - mutable rpm : float; - mutable temp : float; - mutable bat : float; - mutable amp : float; - mutable energy : int; - mutable ap_mode : int; - mutable gaz_mode : int; - mutable lateral_mode : int; - mutable horizontal_mode : int; - mutable periodic_callbacks : Glib.Timeout.id list; - cam : ac_cam; - mutable gps_mode : int; - mutable gps_Pacc : int; - mutable state_filter_mode : int; - fbw : fbw; - svinfo : svinfo array; - waypoints : (int, waypoint) Hashtbl.t; - mutable flight_time : int; - mutable stage_time : int; - mutable block_time : int; - mutable horiz_mode : horiz_mode; - dl_setting_values : float array; - mutable nb_dl_setting_values : int; - mutable survey : (Latlong.geographic * Latlong.geographic) option; - mutable last_msg_date : float; - mutable time_since_last_survey_msg : float; - mutable dist_to_wp : float; - inflight_calib : inflight_calib - } + mutable vehicle_type : vehicle_type; + id : string; + name : string; + flight_plan : Xml.xml; + airframe : Xml.xml; + mutable pos : Latlong.geographic; + mutable unix_time : float; + mutable itow : int32; (* ms *) + mutable roll : float; + mutable pitch : float; + mutable heading : float; (* rad, CW 0=N *) + mutable gspeed : float; (* m/s *) + mutable course : float; (* rad *) + mutable alt : float; + mutable agl : float; + mutable climb : float; + mutable nav_ref : nav_ref option; + mutable d_hmsl : float; + mutable desired_pos : Latlong.geographic; + mutable desired_altitude : float; + mutable desired_course : float; + mutable desired_climb : float; + mutable cur_block : int; + mutable cur_stage : int; + mutable throttle : float; + mutable kill_mode : bool; + mutable throttle_accu : float; + mutable rpm : float; + mutable temp : float; + mutable bat : float; + mutable amp : float; + mutable energy : int; + mutable ap_mode : int; + mutable gaz_mode : int; + mutable lateral_mode : int; + mutable horizontal_mode : int; + mutable periodic_callbacks : Glib.Timeout.id list; + cam : ac_cam; + mutable gps_mode : int; + mutable gps_Pacc : int; + mutable state_filter_mode : int; + fbw : fbw; + svinfo : svinfo array; + waypoints : (int, waypoint) Hashtbl.t; + mutable flight_time : int; + mutable stage_time : int; + mutable block_time : int; + mutable horiz_mode : horiz_mode; + dl_setting_values : float array; + mutable nb_dl_setting_values : int; + mutable survey : (Latlong.geographic * Latlong.geographic) option; + mutable last_msg_date : float; + mutable time_since_last_survey_msg : float; + mutable dist_to_wp : float; + inflight_calib : inflight_calib +} let max_nb_dl_setting_values = 256 (** indexed iwth an uint8 (messages.xml) *) diff --git a/sw/ground_segment/tmtc/airprox.ml b/sw/ground_segment/tmtc/airprox.ml index c656886eeb..539ee3e088 100644 --- a/sw/ground_segment/tmtc/airprox.ml +++ b/sw/ground_segment/tmtc/airprox.ml @@ -44,7 +44,7 @@ let airprox = fun aircraft1 aircraft2 -> z1 = aircraft1.alt and z2 = aircraft2.alt in let alt_difference = abs_float (z1 -. z2) and dist = distance (x1, y1) (x2, y2) in - ((alt_difference < 10.0) && (dist < 100.0)) + ((alt_difference < 10.0) && (dist < 100.0)) (** return airprox level *) (** level is warning if the distance between both aircraft is increasing *) @@ -64,8 +64,8 @@ let airprox_level = fun aircraft1 aircraft2 -> vy1 = speed1 *. (sin (halfpi -. course1)) and vy2 = speed2 *. (sin (halfpi -. course2)) in let d1 = distance - (x1+. vx1 *. 0.2, x2+. vx2 *. 0.2) - (y1+. vy1 *. 0.2, y2+. vy2 *. 0.2) in + (x1+. vx1 *. 0.2, x2+. vx2 *. 0.2) + (y1+. vy1 *. 0.2, y2+. vy2 *. 0.2) in if d1 < d0 then "CRITICAL" else "WARNING" (** send a airprox alert on ivy if there is an airprox between ac_name1 and *) diff --git a/sw/ground_segment/tmtc/broadcaster.ml b/sw/ground_segment/tmtc/broadcaster.ml index 937451a4f3..5f81760dd6 100644 --- a/sw/ground_segment/tmtc/broadcaster.ml +++ b/sw/ground_segment/tmtc/broadcaster.ml @@ -27,15 +27,15 @@ let () = let buffer = String.create buffer_size in let get_tcp = fun _ -> begin - try - let n = input i buffer 0 buffer_size in - let data = String.sub buffer 0 n in + try + let n = input i buffer 0 buffer_size in + let data = String.sub buffer 0 n in - Ivy.send (sprintf "%s %s" !ivy_to (Base64.encode_string data)) - with - exc -> prerr_endline (Printexc.to_string exc) + Ivy.send (sprintf "%s %s" !ivy_to (Base64.encode_string data)) + with + exc -> prerr_endline (Printexc.to_string exc) end; - true in + true in let ginput = GMain.Io.channel_of_descr (Unix.descr_of_in_channel i) in ignore (Glib.Io.add_watch [`IN] get_tcp ginput); @@ -45,7 +45,7 @@ let () = (* Forward datalink on Tcp *) let get_ivy = fun _ args -> try fprintf o "%s%!" (Base64.decode_string args.(0)) with - exc -> prerr_endline (Printexc.to_string exc) in + exc -> prerr_endline (Printexc.to_string exc) in ignore (Ivy.bind get_ivy (sprintf "^%s (.*)" !ivy_from)); (* Main Loop *) diff --git a/sw/ground_segment/tmtc/dia.ml b/sw/ground_segment/tmtc/dia.ml index 52953a69fa..2474c5d7ba 100644 --- a/sw/ground_segment/tmtc/dia.ml +++ b/sw/ground_segment/tmtc/dia.ml @@ -21,8 +21,8 @@ *) (** Encode telemetry messages in an audio stream (to be mixed with a - video stream). Listen messages from the "ground" class (a server - must be running) and write message(s) of the "DIA" class. + video stream). Listen messages from the "ground" class (a server + must be running) and write message(s) of the "DIA" class. *) open Printf @@ -34,16 +34,16 @@ module Ground_Pprz = Pprz.Messages(struct let name = "ground" end) module Sub_Pprz = Pprz.Messages(struct let name = "DIA" end) type state = { - mutable lat : float; - mutable long : float; - mutable alt : int; + mutable lat : float; + mutable long : float; + mutable alt : int; - mutable course : int; - mutable speed : int; + mutable course : int; + mutable speed : int; - mutable cam_roll : int; - mutable cam_pitch : int; - } + mutable cam_roll : int; + mutable cam_pitch : int; +} let state = { lat = 0.; long = 0.; alt = 0; @@ -115,8 +115,8 @@ let _ = ignore (Glib.Timeout.add msg_period (fun () -> send_msg (); true)); - (* Main Loop *) - let loop = Glib.Main.create true in - while Glib.Main.is_running loop do - ignore (Glib.Main.iteration true) - done + (* Main Loop *) + let loop = Glib.Main.create true in + while Glib.Main.is_running loop do + ignore (Glib.Main.iteration true) + done diff --git a/sw/ground_segment/tmtc/diadec.ml b/sw/ground_segment/tmtc/diadec.ml index 6f66725bf2..e6d2132fe8 100644 --- a/sw/ground_segment/tmtc/diadec.ml +++ b/sw/ground_segment/tmtc/diadec.ml @@ -36,8 +36,8 @@ let use_tele_message = fun buf -> let msg = Sub_Pprz.message_of_id msg_id in printf "%d %s\n%!" ac_id (Sub_Pprz.string_of_message msg values) with - _ -> - Debug.call 'W' (fun f -> fprintf f "Warning, cannot use: %s\n" (Debug.xprint buf)) + _ -> + Debug.call 'W' (fun f -> fprintf f "Warning, cannot use: %s\n" (Debug.xprint buf)) let _ = diff --git a/sw/ground_segment/tmtc/fw_server.ml b/sw/ground_segment/tmtc/fw_server.ml index 4a597a8f68..57b6045147 100644 --- a/sw/ground_segment/tmtc/fw_server.ml +++ b/sw/ground_segment/tmtc/fw_server.ml @@ -42,7 +42,7 @@ let rec norm_course = let fvalue = fun x -> match x with - Pprz.Float x -> x + Pprz.Float x -> x | Pprz.Int32 x -> Int32.to_float x | Pprz.Int x -> float_of_int x | _ -> failwith (sprintf "Receive.log_and_parse: float expected, got '%s'" (Pprz.string_of_value x)) @@ -50,16 +50,16 @@ let fvalue = fun x -> let ivalue = fun x -> match x with - Pprz.Int x -> x - | Pprz.Int32 x -> Int32.to_int x - | _ -> failwith "Receive.log_and_parse: int expected" + Pprz.Int x -> x + | Pprz.Int32 x -> Int32.to_int x + | _ -> failwith "Receive.log_and_parse: int expected" let format_string_field = fun s -> let s = String.copy s in for i = 0 to String.length s - 1 do match s.[i] with - ' ' -> s.[i] <- '_' - | _ -> () + ' ' -> s.[i] <- '_' + | _ -> () done; s @@ -78,8 +78,8 @@ let update_waypoint = fun ac wp_id p alt -> if new_wp <> prev_wp then Hashtbl.replace ac.waypoints wp_id new_wp with - Not_found -> - Hashtbl.add ac.waypoints wp_id new_wp + Not_found -> + Hashtbl.add ac.waypoints wp_id new_wp @@ -90,34 +90,34 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> let fvalue = fun x -> let f = fvalue (value x) in - match classify_float f with - FP_infinite | FP_nan -> - let msg = sprintf "Non normal number: %f in '%s %s %s'" f ac_name msg.Pprz.name (string_of_values values) in - raise (Telemetry_error (ac_name, format_string_field msg)) + match classify_float f with + FP_infinite | FP_nan -> + let msg = sprintf "Non normal number: %f in '%s %s %s'" f ac_name msg.Pprz.name (string_of_values values) in + raise (Telemetry_error (ac_name, format_string_field msg)) | _ -> f and ivalue = fun x -> ivalue (value x) in if not (msg.Pprz.name = "DOWNLINK_STATUS") then a.last_msg_date <- U.gettimeofday (); match msg.Pprz.name with - "GPS" -> - a.gps_mode <- check_index (ivalue "mode") gps_modes "GPS_MODE"; - if a.gps_mode = _3D then begin - let p = { LL.utm_x = fvalue "utm_east" /. 100.; - utm_y = fvalue "utm_north" /. 100.; - utm_zone = ivalue "utm_zone" } in - a.pos <- LL.of_utm WGS84 p; - a.unix_time <- LL.unix_time_of_tow (truncate (fvalue "itow" /. 1000.)); - a.itow <- Int32.of_float (fvalue "itow"); - a.gspeed <- fvalue "speed" /. 100.; - a.course <- norm_course ((Deg>>Rad)(fvalue "course" /. 10.)); - if !heading_from_course then - a.heading <- a.course; - a.agl <- a.alt -. float (try Srtm.of_wgs84 a.pos with _ -> 0); - if a.gspeed > 3. && a.ap_mode = _AUTO2 then - Wind.update ac_name a.gspeed a.course - end - | "GPS_LLA" -> + "GPS" -> + a.gps_mode <- check_index (ivalue "mode") gps_modes "GPS_MODE"; + if a.gps_mode = _3D then begin + let p = { LL.utm_x = fvalue "utm_east" /. 100.; + utm_y = fvalue "utm_north" /. 100.; + utm_zone = ivalue "utm_zone" } in + a.pos <- LL.of_utm WGS84 p; + a.unix_time <- LL.unix_time_of_tow (truncate (fvalue "itow" /. 1000.)); + a.itow <- Int32.of_float (fvalue "itow"); + a.gspeed <- fvalue "speed" /. 100.; + a.course <- norm_course ((Deg>>Rad)(fvalue "course" /. 10.)); + if !heading_from_course then + a.heading <- a.course; + a.agl <- a.alt -. float (try Srtm.of_wgs84 a.pos with _ -> 0); + if a.gspeed > 3. && a.ap_mode = _AUTO2 then + Wind.update ac_name a.gspeed a.course + end + | "GPS_LLA" -> let lat = ivalue "lat" and lon = ivalue "lon" in let geo = make_geo_deg (float lat /. 1e7) (float lon /. 1e7) in @@ -131,32 +131,32 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.agl <- a.alt -. float (try Srtm.of_wgs84 a.pos with _ -> 0); a.gps_mode <- check_index (ivalue "mode") gps_modes "GPS_MODE"; if a.gspeed > 3. && a.ap_mode = _AUTO2 then - Wind.update ac_name a.gspeed a.course - | "GPS_SOL" -> + Wind.update ac_name a.gspeed a.course + | "GPS_SOL" -> a.gps_Pacc <- ivalue "Pacc" - | "ESTIMATOR" -> + | "ESTIMATOR" -> a.alt <- fvalue "z"; a.climb <- fvalue "z_dot" - | "DESIRED" -> + | "DESIRED" -> (* Trying to be compatible with old logs ... *) begin match a.nav_ref with - Some nav_ref -> - let x = (try fvalue "x" with _ -> fvalue "desired_x") - and y = (try fvalue "y" with _ -> fvalue "desired_y") in - a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref (x, y); - | None -> () + Some nav_ref -> + let x = (try fvalue "x" with _ -> fvalue "desired_x") + and y = (try fvalue "y" with _ -> fvalue "desired_y") in + a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref (x, y); + | None -> () end; a.desired_altitude <- (try fvalue "altitude" with _ -> fvalue "desired_altitude"); a.desired_climb <- (try fvalue "climb" with _ -> fvalue "desired_climb"); - begin try a.desired_course <- norm_course (fvalue "course") with _ -> () end - | "NAVIGATION_REF" -> + begin try a.desired_course <- norm_course (fvalue "course") with _ -> () end + | "NAVIGATION_REF" -> a.nav_ref <- Some (Utm { utm_x = fvalue "utm_east"; utm_y = fvalue "utm_north"; utm_zone = ivalue "utm_zone" }) - | "NAVIGATION_REF_LLA" -> + | "NAVIGATION_REF_LLA" -> let lat = ivalue "lat" and lon = ivalue "lon" in let geo = make_geo_deg (float lat /. 1e7) (float lon /. 1e7) in a.nav_ref <- Some (Geo geo) - | "ATTITUDE" -> + | "ATTITUDE" -> let roll = fvalue "phi" and pitch = fvalue "theta" in if (List.assoc "phi" msg.Pprz.fields).Pprz._type = Pprz.Scalar "int16" then begin (* Compatibility with old message in degrees *) @@ -168,11 +168,11 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.pitch <- pitch; a.heading <- norm_course (fvalue "psi") end - | "NAVIGATION" -> + | "NAVIGATION" -> a.cur_block <- ivalue "cur_block"; a.cur_stage <- ivalue "cur_stage"; a.dist_to_wp <- sqrt (fvalue "dist2_wp") - | "BAT" -> + | "BAT" -> a.throttle <- fvalue "throttle" /. 9600. *. 100.; a.kill_mode <- ivalue "kill_auto_throttle" <> 0; a.flight_time <- ivalue "flight_time"; @@ -181,25 +181,25 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.stage_time <- ivalue "stage_time"; a.block_time <- ivalue "block_time"; a.energy <- ivalue "energy" - | "FBW_STATUS" -> + | "FBW_STATUS" -> a.bat <- fvalue "vsupply" /. 10.; a.fbw.pprz_mode_msgs_since_last_fbw_status_msg <- 0; a.fbw.rc_rate <- ivalue "frame_rate"; let fbw_rc_mode = ivalue "rc_status" in a.fbw.rc_status <- ( match fbw_rc_mode with - 2 -> "NONE" - | 1 -> "LOST" - | _ -> "OK" ); + 2 -> "NONE" + | 1 -> "LOST" + | _ -> "OK" ); let fbw_mode = ivalue "mode" in a.fbw.rc_mode <- ( match fbw_mode with - 2 -> "FAILSAFE" - | 1 -> "AUTO" - | _ -> "MANUAL" ) - | "STATE_FILTER_STATUS" -> + 2 -> "FAILSAFE" + | 1 -> "AUTO" + | _ -> "MANUAL" ) + | "STATE_FILTER_STATUS" -> a.state_filter_mode <- check_index (ivalue "state_filter_mode") state_filter_modes "STATE_FILTER_MODES" - | "PPRZ_MODE" -> + | "PPRZ_MODE" -> a.vehicle_type <- FixedWing; a.gaz_mode <- check_index (ivalue "ap_gaz") gaz_modes "AP_GAZ"; a.lateral_mode <- check_index (ivalue "ap_lateral") lat_modes "AP_LAT"; @@ -228,11 +228,11 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.ap_mode <- 5 (* Override and set FAIL(Safe) Mode *) else a.ap_mode <- check_index (ivalue "ap_mode") fixedwing_ap_modes "AP_MODE" - | "CAM" -> + | "CAM" -> a.cam.phi <- (Deg>>Rad) (fvalue "phi"); a.cam.theta <- (Deg>>Rad) (fvalue "theta"); a.cam.target <- (fvalue "target_x", fvalue "target_y") - | "SVINFO" -> + | "SVINFO" -> let i = ivalue "chn" in assert(i < Array.length a.svinfo); a.svinfo.(i) <- { @@ -244,64 +244,64 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> azim = ivalue "Azim"; age = 0 } - | "CIRCLE" -> + | "CIRCLE" -> begin match a.nav_ref, a.horizontal_mode with - Some nav_ref, 2 -> (** FIXME *) - a.horiz_mode <- Circle (Aircraft.add_pos_to_nav_ref nav_ref (fvalue "center_east", fvalue "center_north"), truncate (fvalue "radius")); - if !Kml.enabled then Kml.update_horiz_mode a - | _ -> () - end - | "SEGMENT" -> - begin - match a.nav_ref, a.horizontal_mode with - Some nav_ref, 1 -> (** FIXME *) - let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_1", fvalue "segment_north_1") - and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_2", fvalue "segment_north_2") in - a.horiz_mode <- Segment (p1, p2); - if !Kml.enabled then Kml.update_horiz_mode a + Some nav_ref, 2 -> (** FIXME *) + a.horiz_mode <- Circle (Aircraft.add_pos_to_nav_ref nav_ref (fvalue "center_east", fvalue "center_north"), truncate (fvalue "radius")); + if !Kml.enabled then Kml.update_horiz_mode a | _ -> () end - | "SETTINGS" -> + | "SEGMENT" -> + begin + match a.nav_ref, a.horizontal_mode with + Some nav_ref, 1 -> (** FIXME *) + let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_1", fvalue "segment_north_1") + and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "segment_east_2", fvalue "segment_north_2") in + a.horiz_mode <- Segment (p1, p2); + if !Kml.enabled then Kml.update_horiz_mode a + | _ -> () + end + | "SETTINGS" -> a.inflight_calib.if_val1 <- fvalue "slider_1_val"; a.inflight_calib.if_val2 <- fvalue "slider_2_val"; - | "SURVEY" -> + | "SURVEY" -> begin a.time_since_last_survey_msg <- 0.; match a.nav_ref with - Some nav_ref -> - let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "west", fvalue "south") - and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "east", fvalue "north") in - a.survey <- Some (p1, p2) - | None -> () + Some nav_ref -> + let p1 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "west", fvalue "south") + and p2 = Aircraft.add_pos_to_nav_ref nav_ref (fvalue "east", fvalue "north") in + a.survey <- Some (p1, p2) + | None -> () end - | "CALIBRATION" -> + | "CALIBRATION" -> a.throttle_accu <- fvalue "climb_sum_err" - | "DL_VALUE" -> + | "DL_VALUE" -> let i = ivalue "index" in if i < max_nb_dl_setting_values then begin - a.dl_setting_values.(i) <- fvalue "value"; - a.nb_dl_setting_values <- max a.nb_dl_setting_values (i+1) + a.dl_setting_values.(i) <- fvalue "value"; + a.nb_dl_setting_values <- max a.nb_dl_setting_values (i+1) end else - failwith "Too much dl_setting values !!!" - | "WP_MOVED" -> + failwith "Too much dl_setting values !!!" + | "WP_MOVED" -> begin match a.nav_ref with - Some Utm nav_ref -> - let utm_zone = try ivalue "utm_zone" with _ -> nav_ref.utm_zone in - let p = { LL.utm_x = fvalue "utm_east"; - utm_y = fvalue "utm_north"; - utm_zone = utm_zone } in - update_waypoint a (ivalue "wp_id") (LL.of_utm WGS84 p) (fvalue "alt") - | _ -> () (** Can't use this message *) + Some Utm nav_ref -> + let utm_zone = try ivalue "utm_zone" with _ -> nav_ref.utm_zone in + let p = { LL.utm_x = fvalue "utm_east"; + utm_y = fvalue "utm_north"; + utm_zone = utm_zone } in + update_waypoint a (ivalue "wp_id") (LL.of_utm WGS84 p) (fvalue "alt") + | _ -> () (** Can't use this message *) end - | "WP_MOVED_LLA" -> + | "WP_MOVED_LLA" -> let lat = ivalue "lat" and lon = ivalue "lon" and alt = ivalue "alt" in let geo = make_geo_deg (float lat /. 1e7) (float lon /. 1e7) in - update_waypoint a (ivalue "wp_id") geo (float alt /. 100.) - | "GENERIC_COM" -> + update_waypoint a (ivalue "wp_id") geo (float alt /. 100.) + | "GENERIC_COM" -> let flight_time = ivalue "flight_time" in if flight_time >= a.flight_time then begin a.flight_time <- flight_time; @@ -321,16 +321,16 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.ap_mode <- check_index (ivalue "ap_mode") fixedwing_ap_modes "AP_MODE"; a.cur_block <- ivalue "nav_block"; end - | "FORMATION_SLOT_TM" -> + | "FORMATION_SLOT_TM" -> Dl_Pprz.message_send "ground_dl" "FORMATION_SLOT" values - | "FORMATION_STATUS_TM" -> + | "FORMATION_STATUS_TM" -> Dl_Pprz.message_send "ground_dl" "FORMATION_STATUS" values - | "TCAS_RA" -> + | "TCAS_RA" -> let vs = [ "ac_id", Pprz.Int (ivalue "ac_id"); "ac_id_conflict", Pprz.Int (int_of_string a.id); "resolve", Pprz.Int (ivalue "resolve") ] in Dl_Pprz.message_send "ground_dl" "TCAS_RESOLVE" vs - | _ -> () + | _ -> () diff --git a/sw/ground_segment/tmtc/ihm.ml b/sw/ground_segment/tmtc/ihm.ml index 349dae2072..08ca337f86 100644 --- a/sw/ground_segment/tmtc/ihm.ml +++ b/sw/ground_segment/tmtc/ihm.ml @@ -18,10 +18,10 @@ let print_p = fun c p -> let print_pattern = fun a -> match a with - Circle (p, r) -> printf "Circle (%a %d) " print_p p r - | Eight (p1, p2, r) -> printf "Eight (%a %a %d) " print_p p1 print_p p2 r - | Line (p1, p2) -> printf "Line (%a %a) " print_p p1 print_p p2 - | Nop -> printf "Nop " + Circle (p, r) -> printf "Circle (%a %d) " print_p p r + | Eight (p1, p2, r) -> printf "Eight (%a %a %d) " print_p p1 print_p p2 r + | Line (p1, p2) -> printf "Line (%a %a) " print_p p1 print_p p2 + | Nop -> printf "Nop " let print_patterns = fun t -> let i = ref 0 in @@ -56,41 +56,41 @@ let geo_of = fun p -> of_utm WGS84 (utm_add utm_ref (float p.x, float p.y)) let send_circle = fun ac_id p r -> let wgs84 = geo_of p in let vs = [ "ac_id", Pprz.String ac_id; - "wp_id", Pprz.Int 1; (* FIXME *) - "alt", Pprz.Float (float p.z); - "lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84.posn_long)] in + "wp_id", Pprz.Int 1; (* FIXME *) + "alt", Pprz.Float (float p.z); + "lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84.posn_long)] in GroundPprz.message_send "ihm" "MOVE_WAYPOINT" vs; let vs = [ "ac_id", Pprz.String ac_id; - "index", Pprz.Int nav_radius_id; - "value", Pprz.Float (float r) ] in + "index", Pprz.Int nav_radius_id; + "value", Pprz.Float (float r) ] in GroundPprz.message_send "ihm" "DL_SETTING" vs; let vs = [ "ac_id", Pprz.String ac_id; - "block_id", Pprz.Int circle_block ] in - GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs + "block_id", Pprz.Int circle_block ] in + GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs let send_line = fun ac_id p1 p2 -> let wgs84_1 = geo_of p1 and wgs84_2 = geo_of p2 in let vs = [ "ac_id", Pprz.String ac_id; - "wp_id", Pprz.Int 1; (* FIXME *) - "alt", Pprz.Float (float p1.z); - "lat", Pprz.Float ((Rad>>Deg)wgs84_1.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84_1.posn_long)] in + "wp_id", Pprz.Int 1; (* FIXME *) + "alt", Pprz.Float (float p1.z); + "lat", Pprz.Float ((Rad>>Deg)wgs84_1.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84_1.posn_long)] in GroundPprz.message_send "ihm" "MOVE_WAYPOINT" vs; let vs = [ "ac_id", Pprz.String ac_id; - "wp_id", Pprz.Int 2; (* FIXME *) - "alt", Pprz.Float (float p2.z); - "lat", Pprz.Float ((Rad>>Deg)wgs84_2.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84_2.posn_long)] in + "wp_id", Pprz.Int 2; (* FIXME *) + "alt", Pprz.Float (float p2.z); + "lat", Pprz.Float ((Rad>>Deg)wgs84_2.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84_2.posn_long)] in GroundPprz.message_send "ihm" "MOVE_WAYPOINT" vs; let vs = [ "ac_id", Pprz.String ac_id; - "block_id", Pprz.Int glide_block ] in + "block_id", Pprz.Int glide_block ] in GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs @@ -98,26 +98,26 @@ let send_eight = fun ac_id p1 p2 r -> let wgs84_1 = geo_of p1 and wgs84_2 = geo_of p2 in let vs = [ "ac_id", Pprz.String ac_id; - "wp_id", Pprz.Int 1; (* FIXME *) - "alt", Pprz.Float (float p1.z); - "lat", Pprz.Float ((Rad>>Deg)wgs84_1.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84_1.posn_long)] in + "wp_id", Pprz.Int 1; (* FIXME *) + "alt", Pprz.Float (float p1.z); + "lat", Pprz.Float ((Rad>>Deg)wgs84_1.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84_1.posn_long)] in GroundPprz.message_send "ihm" "MOVE_WAYPOINT" vs; let vs = [ "ac_id", Pprz.String ac_id; - "wp_id", Pprz.Int 2; (* FIXME *) - "alt", Pprz.Float (float p2.z); - "lat", Pprz.Float ((Rad>>Deg)wgs84_2.posn_lat); - "long", Pprz.Float ((Rad>>Deg)wgs84_2.posn_long)] in + "wp_id", Pprz.Int 2; (* FIXME *) + "alt", Pprz.Float (float p2.z); + "lat", Pprz.Float ((Rad>>Deg)wgs84_2.posn_lat); + "long", Pprz.Float ((Rad>>Deg)wgs84_2.posn_long)] in GroundPprz.message_send "ihm" "MOVE_WAYPOINT" vs; let vs = [ "ac_id", Pprz.String ac_id; - "index", Pprz.Int nav_radius_id; - "value", Pprz.Float (float r) ] in + "index", Pprz.Int nav_radius_id; + "value", Pprz.Float (float r) ] in GroundPprz.message_send "ihm" "DL_SETTING" vs; let vs = [ "ac_id", Pprz.String ac_id; - "block_id", Pprz.Int eight_block ] in + "block_id", Pprz.Int eight_block ] in GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs @@ -126,33 +126,33 @@ let send_pattern_up = fun ac_id -> let tl = Hashtbl.find timelines ac_id in begin match tl with - Circle (p, r) :: _ -> send_circle ac_id p r - | Eight (p1, p2, r) :: _ -> send_eight ac_id p1 p2 r - | Line (p1, p2) :: _ -> send_line ac_id p1 p2 - | Nop :: _ -> - let vs = [ "ac_id", Pprz.String ac_id; - "block_id", Pprz.Int nop_block ] in - GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs - | [] -> failwith (Printf.sprintf "send_pattern_up: %s - empty list" ac_id) + Circle (p, r) :: _ -> send_circle ac_id p r + | Eight (p1, p2, r) :: _ -> send_eight ac_id p1 p2 r + | Line (p1, p2) :: _ -> send_line ac_id p1 p2 + | Nop :: _ -> + let vs = [ "ac_id", Pprz.String ac_id; + "block_id", Pprz.Int nop_block ] in + GroundPprz.message_send "ihm" "JUMP_TO_BLOCK" vs + | [] -> failwith (Printf.sprintf "send_pattern_up: %s - empty list" ac_id) end with - Not_found -> failwith (Printf.sprintf "send_pattern_up: %s" ac_id) + Not_found -> failwith (Printf.sprintf "send_pattern_up: %s" ac_id) let get_ac = fun vs -> let ac_id = Pprz.string_assoc "ac_id" vs in try Hashtbl.find timelines ac_id with - Not_found -> - add_timeline ac_id + Not_found -> + add_timeline ac_id let insert_in_timeline values idx action = let t = get_ac values in let rec iter t i = if i = 0 then action :: t else - match t with - [] -> failwith "insert_in_timeline" - | x :: xs -> x :: iter xs (i-1) in + match t with + [] -> failwith "insert_in_timeline" + | x :: xs -> x :: iter xs (i-1) in let newt = iter t idx in (***)print_patterns newt; @@ -207,25 +207,25 @@ let ihm_eight_cb = fun _sender values -> if idx = 0 then send_pattern_up (Pprz.string_assoc "ac_id" values) (* -let delete = fun timeline idx values -> - (* Shift left *) + let delete = fun timeline idx values -> +(* Shift left *) for i = max 0 idx to timeline_max_length - 2 do - timeline.(i) <- timeline.(i+1) + timeline.(i) <- timeline.(i+1) done; if idx = 0 then - send_pattern_up (Pprz.string_assoc "ac_id" values) + send_pattern_up (Pprz.string_assoc "ac_id" values) *) let delete_in_timeline values idx = let rec iter t idx = if idx = 0 then match t with - [] -> failwith "delete_in_timeline" - | x :: xs -> xs + [] -> failwith "delete_in_timeline" + | x :: xs -> xs else match t with - [] -> failwith "delete_in_timeline" - | x :: xs -> x :: iter xs (idx-1) in + [] -> failwith "delete_in_timeline" + | x :: xs -> x :: iter xs (idx-1) in let t = get_ac values in let newt = iter t idx in let ac_id = Pprz.string_assoc "ac_id" values in diff --git a/sw/ground_segment/tmtc/ivy2udp.ml b/sw/ground_segment/tmtc/ivy2udp.ml index 02a15871d1..4d71c3891f 100644 --- a/sw/ground_segment/tmtc/ivy2udp.ml +++ b/sw/ground_segment/tmtc/ivy2udp.ml @@ -78,20 +78,20 @@ let () = let get_datalink_message = fun _ -> begin try - let n = input (Unix.in_channel_of_descr socket) buffer 0 buffer_size in - let b = String.sub buffer 0 n in - Debug.trace 'x' (Debug.xprint b); + let n = input (Unix.in_channel_of_descr socket) buffer 0 buffer_size in + let b = String.sub buffer 0 n in + Debug.trace 'x' (Debug.xprint b); - let use_dl_message = fun payload -> - Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); - let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in - let msg = Dl_Pprz.message_of_id msg_id in - Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in + let use_dl_message = fun payload -> + Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); + let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in + let msg = Dl_Pprz.message_of_id msg_id in + Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in - assert (PprzTransport.parse use_dl_message b = n) + assert (PprzTransport.parse use_dl_message b = n) with - exc -> - prerr_endline (Printexc.to_string exc) + exc -> + prerr_endline (Printexc.to_string exc) end; true in diff --git a/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml b/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml index 61c2e40b4a..a42861a87a 100644 --- a/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml +++ b/sw/ground_segment/tmtc/ivy_tcp_aircraft.ml @@ -44,20 +44,20 @@ let () = let get_datalink_message = fun _ -> begin try - let n = input i buffer 0 buffer_size in - let b = String.sub buffer 0 n in - Debug.trace 'x' (Debug.xprint b); + let n = input i buffer 0 buffer_size in + let b = String.sub buffer 0 n in + Debug.trace 'x' (Debug.xprint b); - let use_dl_message = fun payload -> - Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); - let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in - let msg = Dl_Pprz.message_of_id msg_id in - Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in + let use_dl_message = fun payload -> + Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); + let (msg_id, ac_id, values) = Dl_Pprz.values_of_payload payload in + let msg = Dl_Pprz.message_of_id msg_id in + Dl_Pprz.message_send "ground_dl" msg.Pprz.name values in - assert (PprzTransport.parse use_dl_message b = n) + assert (PprzTransport.parse use_dl_message b = n) with - exc -> - prerr_endline (Printexc.to_string exc) + exc -> + prerr_endline (Printexc.to_string exc) end; true in diff --git a/sw/ground_segment/tmtc/ivy_tcp_controller.ml b/sw/ground_segment/tmtc/ivy_tcp_controller.ml index 5d80a5a220..8674bd6667 100644 --- a/sw/ground_segment/tmtc/ivy_tcp_controller.ml +++ b/sw/ground_segment/tmtc/ivy_tcp_controller.ml @@ -32,21 +32,21 @@ let () = let get_message = fun _ -> begin try - let n = input i buffer 0 buffer_size in - let b = String.sub buffer 0 n in - Debug.trace 'x' (Debug.xprint b); + let n = input i buffer 0 buffer_size in + let b = String.sub buffer 0 n in + Debug.trace 'x' (Debug.xprint b); - let use_tele_message = fun payload -> - Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); - let (msg_id, ac_id, values) = Tm_Pprz.values_of_payload payload in - let msg = Tm_Pprz.message_of_id msg_id in - Tm_Pprz.message_send (string_of_int ac_id) msg.Pprz.name values in + let use_tele_message = fun payload -> + Debug.trace 'x' (Debug.xprint (Serial.string_of_payload payload)); + let (msg_id, ac_id, values) = Tm_Pprz.values_of_payload payload in + let msg = Tm_Pprz.message_of_id msg_id in + Tm_Pprz.message_send (string_of_int ac_id) msg.Pprz.name values in - ignore (PprzTransport.parse use_tele_message b) + ignore (PprzTransport.parse use_tele_message b) with - exc -> - prerr_endline (Printexc.to_string exc) - end; + exc -> + prerr_endline (Printexc.to_string exc) + end; true in let ginput = GMain.Io.channel_of_descr (Unix.descr_of_in_channel i) in diff --git a/sw/ground_segment/tmtc/kml.ml b/sw/ground_segment/tmtc/kml.ml index 31989a5ef1..c26156f876 100644 --- a/sw/ground_segment/tmtc/kml.ml +++ b/sw/ground_segment/tmtc/kml.ml @@ -52,21 +52,21 @@ let waypoint = fun utm0 alt0 wp -> data "styleUrl" "#msn_wp_icon"; el "Point" [] [data "extrude" "1"; - data "coordinates" (coordinates wgs84 a)]] + data "coordinates" (coordinates wgs84 a)]] let icon_style = fun ?(heading=0) ?(color="ffffffff") id icon -> el "Style" ["id", id] [el "IconStyle" [] - [data "heading" (string_of_int heading); - data "color" color; - el "Icon" [] - [data "href" (sprintf "http://maps.google.com/mapfiles/kml/%s" icon)]]] + [data "heading" (string_of_int heading); + data "color" color; + el "Icon" [] + [data "href" (sprintf "http://maps.google.com/mapfiles/kml/%s" icon)]]] let line_style = fun id ?(width = 2) color -> el "Style" ["id", id] [el "LineStyle" [] - [data "color" color; - data "width" (string_of_int width)]] + [data "color" color; + data "width" (string_of_int width)]] let pair = fun key icon -> el "Pair" [] @@ -104,8 +104,8 @@ let ring_around_home = fun utm0 fp -> line_style "red" "800000ff"; el "LinearRing" [] [ data "extrude" "1"; - data "altitudeMode" "relativeToGround"; - data "coordinates" coords]] + data "altitudeMode" "relativeToGround"; + data "coordinates" coords]] let horiz_mode = @@ -114,7 +114,7 @@ let horiz_mode = line_style ~width:4 "green" "8000ff00"; el "LineString" [] [ data "altitudeMode" "absolute"; - data "coordinates" ""]] + data "coordinates" ""]] let georef_of_xml = fun xml -> let lat0 = Latlong.deg_of_string (ExtXml.attrib xml "lat0") @@ -152,34 +152,34 @@ let aircraft = fun ac url_flight_plan url_changes -> let dyn_links = List.map (fun url -> el "NetworkLink" [] - [data "name" ("Update "^ac); - el "Link" [] - [data "refreshMode" "onInterval"; - data "refreshInterval" "0.5"; - data "href" url]]) + [data "name" ("Update "^ac); + el "Link" [] + [data "refreshMode" "onInterval"; + data "refreshInterval" "0.5"; + data "href" url]]) url_changes in let description = data "description" "Beta version. Open and double-click on flight plan. You may need to refresh following Update objects on errors" in kml [el "Document" [] - (description::(el "NetworkLink" [] - [data "name" (ac^" flight plan"); - el "Link" [] - [data "href" url_flight_plan]]):: dyn_links)] + (description::(el "NetworkLink" [] + [data "name" (ac^" flight plan"); + el "Link" [] + [data "href" url_flight_plan]]):: dyn_links)] let change_placemark = fun ?(description="") id wgs84 alt -> el "Change" [] [el "Placemark" ["targetId", id] - [data "description" description; - el "Point" [] - [data "altitudeMode" "absolute"; - data "coordinates" (coordinates wgs84 alt)]]] + [data "description" description; + el "Point" [] + [data "altitudeMode" "absolute"; + data "coordinates" (coordinates wgs84 alt)]]] let link_update = fun target_href changes -> kml [el "NetworkLinkControl" [] - [el "Update" [] (data "targetHref" target_href :: changes)]] + [el "Update" [] (data "targetHref" target_href :: changes)]] @@ -190,12 +190,12 @@ let change_waypoint = fun ac_name wp_id wgs84 alt -> let update_linear_ring = fun target_href id coordinates -> kml [el "NetworkLinkControl" [] - [el "Update" [] - [data "targetHref" target_href; - el "Change" [] - [el "Placemark" ["targetId", id] - [el "LineString" [] - [data "coordinates" coordinates]]]]]] + [el "Update" [] + [data "targetHref" target_href; + el "Change" [] + [el "Placemark" ["targetId", id] + [el "LineString" [] + [data "coordinates" coordinates]]]]]] let print_xml = fun ac_name file xml -> @@ -236,15 +236,15 @@ let update_horiz_mode = in let alt = ac.desired_altitude in match ac.horiz_mode with - Segment (p1, p2) -> - let coordinates = String.concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in - let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in - print_xml ac.name "route_changes.kml" kml_changes - | Circle (p, r) -> - let coordinates = circle p (float r) alt in - let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in - print_xml ac.name "route_changes.kml" kml_changes - | _ -> () + Segment (p1, p2) -> + let coordinates = String.concat " " (List.map (fun p -> coordinates p alt) [p1; p2]) in + let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in + print_xml ac.name "route_changes.kml" kml_changes + | Circle (p, r) -> + let coordinates = circle p (float r) alt in + let kml_changes = update_linear_ring url_flight_plan "horiz_mode" coordinates in + print_xml ac.name "route_changes.kml" kml_changes + | _ -> () end @@ -270,7 +270,7 @@ let update_ac = fun ac -> let kml_changes = link_update url_flight_plan [change] in print_xml ac.name "ac_changes.kml" kml_changes with - _ -> () + _ -> () let build_files = fun a -> diff --git a/sw/ground_segment/tmtc/link.ml b/sw/ground_segment/tmtc/link.ml index 6021d4e9e5..d80d8b8490 100644 --- a/sw/ground_segment/tmtc/link.ml +++ b/sw/ground_segment/tmtc/link.ml @@ -21,7 +21,7 @@ *) (** Agent connecting a hardware modem, usually through USB/serial, with - the Ivy sowtware bus. + the Ivy sowtware bus. *) open Latlong @@ -40,15 +40,15 @@ type transport = | Pprz2 (* Paparazzi protocol, with timestamp, A/C id, message id and CRC *) | XBee (* Maxstream protocol, API mode *) let transport_of_string = function - "pprz" -> Pprz +"pprz" -> Pprz | "pprz2" -> Pprz2 | "xbee" -> XBee | x -> invalid_arg (sprintf "transport_of_string: %s" x) type ground_device = { - fd : Unix.file_descr; transport : transport ; baud_rate : int - } + fd : Unix.file_descr; transport : transport ; baud_rate : int +} (* We assume here a single modem is used *) let my_id = 0 @@ -68,23 +68,23 @@ let add_timestamp = ref None let send_message_over_ivy = fun sender name vs -> let timestamp = match !add_timestamp with - None -> None - | Some start_time -> Some (Unix.gettimeofday () -. start_time) in + None -> None + | Some start_time -> Some (Unix.gettimeofday () -. start_time) in Tm_Pprz.message_send ?timestamp sender name vs (*********** Monitoring *************************************************) type status = { - mutable last_rx_byte : int; - mutable last_rx_msg : int; - mutable rx_byte : int; - mutable rx_msg : int; - mutable rx_err : int; - mutable ms_since_last_msg : int; - mutable last_ping : float; (* s *) - mutable last_pong : float; (* s *) - udp_peername : Unix.sockaddr option - } + mutable last_rx_byte : int; + mutable last_rx_msg : int; + mutable rx_byte : int; + mutable rx_msg : int; + mutable rx_err : int; + mutable ms_since_last_msg : int; + mutable last_ping : float; (* s *) + mutable last_pong : float; (* s *) + udp_peername : Unix.sockaddr option +} let statuss = Hashtbl.create 3 let dead_aircraft_time_ms = 5000 @@ -121,13 +121,13 @@ let live_aircraft = fun ac_id -> let s = Hashtbl.find statuss ac_id in s.ms_since_last_msg < dead_aircraft_time_ms with - Not_found -> false + Not_found -> false let udp_peername = fun ac_id -> try (Hashtbl.find statuss ac_id).udp_peername with - Not_found -> invalid_arg "udp_peername" + Not_found -> invalid_arg "udp_peername" let last_udp_peername = ref (Unix.ADDR_UNIX "not initialized") let udp_read = fun fd buf pos len -> @@ -147,13 +147,13 @@ let send_status_msg = status.last_rx_byte <- status.rx_byte; status.ms_since_last_msg <- status.ms_since_last_msg + status_msg_period; let vs = ["run_time", Pprz.Int t; - "rx_bytes_rate", Pprz.Float byte_rate; - "rx_msgs_rate", Pprz.Float msg_rate; - "rx_err", Pprz.Int status.rx_err; - "rx_bytes", Pprz.Int status.rx_byte; - "rx_msgs", Pprz.Int status.rx_msg; - "ping_time", Pprz.Float (1000. *. (status.last_pong -. status.last_ping)) - ] in + "rx_bytes_rate", Pprz.Float byte_rate; + "rx_msgs_rate", Pprz.Float msg_rate; + "rx_err", Pprz.Int status.rx_err; + "rx_bytes", Pprz.Int status.rx_byte; + "rx_msgs", Pprz.Int status.rx_msg; + "ping_time", Pprz.Float (1000. *. (status.last_pong -. status.last_ping)) + ] in send_message_over_ivy (string_of_int ac_id) "DOWNLINK_STATUS" vs) statuss @@ -168,9 +168,9 @@ let use_tele_message = fun ?udp_peername ?raw_data_size payload -> send_message_over_ivy (string_of_int ac_id) msg.Pprz.name values; update_status ?udp_peername ac_id raw_data_size (msg.Pprz.name = "PONG") with - exc -> - prerr_endline (Printexc.to_string exc); - Debug.call 'W' (fun f -> fprintf f "Warning, cannot use: %s\n" (Debug.xprint buf)); + exc -> + prerr_endline (Printexc.to_string exc); + Debug.call 'W' (fun f -> fprintf f "Warning, cannot use: %s\n" (Debug.xprint buf)); type priority = Null | Low | Normal | High @@ -228,7 +228,7 @@ module XB = struct (** XBee module *) fun () -> incr x; if !x >= 256 then - x := 1; + x := 1; !x let oversize_packet = 4 (* Start + msb_len + lsb_len + cksum *) @@ -237,33 +237,33 @@ module XB = struct (** XBee module *) let frame_data = Serial.string_of_payload frame_data in Debug.trace 'x' (Debug.xprint frame_data); match Xbee.api_parse_frame frame_data with - Xbee.Modem_Status x -> - Debug.trace 'x' (sprintf "getting XBee status %d" x) - | Xbee.AT_Command_Response (frame_id, comm, status, value) -> - Debug.trace 'x' (sprintf "getting XBee AT command response: %d %s %d %s" frame_id comm status (Debug.xprint value)) - | Xbee.TX_Status (frame_id,status) | Xbee.TX868_Status (frame_id,status,_) -> - Debug.trace 'x' (sprintf "getting XBee TX status: %d %d" frame_id status); - if status = 1 then (* no ack, retry *) - let (packet, nb_prev_retries) = packets.(frame_id) in - if nb_prev_retries < !nb_retries then begin - packets.(frame_id) <- (packet, nb_prev_retries+1); - let o = Unix.out_channel_of_descr device.fd in - ignore (GMain.Timeout.add (10 + Random.int retry_delay) - (fun _ -> - fprintf o "%s%!" packet; - Debug.call 'y' (fun f -> fprintf f "Resending (%d) %s\n" (nb_prev_retries+1) (Debug.xprint packet)); - false)); - end + Xbee.Modem_Status x -> + Debug.trace 'x' (sprintf "getting XBee status %d" x) + | Xbee.AT_Command_Response (frame_id, comm, status, value) -> + Debug.trace 'x' (sprintf "getting XBee AT command response: %d %s %d %s" frame_id comm status (Debug.xprint value)) + | Xbee.TX_Status (frame_id,status) | Xbee.TX868_Status (frame_id,status,_) -> + Debug.trace 'x' (sprintf "getting XBee TX status: %d %d" frame_id status); + if status = 1 then (* no ack, retry *) + let (packet, nb_prev_retries) = packets.(frame_id) in + if nb_prev_retries < !nb_retries then begin + packets.(frame_id) <- (packet, nb_prev_retries+1); + let o = Unix.out_channel_of_descr device.fd in + ignore (GMain.Timeout.add (10 + Random.int retry_delay) + (fun _ -> + fprintf o "%s%!" packet; + Debug.call 'y' (fun f -> fprintf f "Resending (%d) %s\n" (nb_prev_retries+1) (Debug.xprint packet)); + false)); + end - | Xbee.RX_Packet_64 (addr64, rssi, options, data) -> - Debug.trace 'x' (sprintf "getting XBee RX64: %Lx %d %d %s" addr64 rssi options (Debug.xprint data)); - use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) - | Xbee.RX868_Packet (addr64, options, data) -> - Debug.trace 'x' (sprintf "getting XBee868 RX: %Lx %d %s" addr64 options (Debug.xprint data)); - use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) - | Xbee.RX_Packet_16 (addr16, rssi, options, data) -> - Debug.trace 'x' (sprintf "getting XBee RX16: from=%x %d %d %s" addr16 rssi options (Debug.xprint data)); - use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) + | Xbee.RX_Packet_64 (addr64, rssi, options, data) -> + Debug.trace 'x' (sprintf "getting XBee RX64: %Lx %d %d %s" addr64 rssi options (Debug.xprint data)); + use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) + | Xbee.RX868_Packet (addr64, options, data) -> + Debug.trace 'x' (sprintf "getting XBee868 RX: %Lx %d %s" addr64 options (Debug.xprint data)); + use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) + | Xbee.RX_Packet_16 (addr16, rssi, options, data) -> + Debug.trace 'x' (sprintf "getting XBee RX16: from=%x %d %d %s" addr16 rssi options (Debug.xprint data)); + use_tele_message ~raw_data_size:(String.length frame_data + oversize_packet) (Serial.payload_of_string data) let send = fun ?ac_id device rf_data -> @@ -272,9 +272,9 @@ module XB = struct (** XBee module *) let frame_id = gen_frame_id () in let frame_data = if !Xbee.mode868 then - Xbee.api_tx64 ~frame_id (Int64.of_int ac_id) rf_data + Xbee.api_tx64 ~frame_id (Int64.of_int ac_id) rf_data else - Xbee.api_tx16 ~frame_id ac_id rf_data in + Xbee.api_tx16 ~frame_id ac_id rf_data in let packet = Xbee.Protocol.packet (Serial.payload_of_string frame_data) in (* Store the packet for further retry *) @@ -294,45 +294,45 @@ let udp_send = fun fd payload peername -> assert (n = len) let send = fun ac_id device payload _priority -> - Debug.call 's' (fun f -> fprintf f "%d\n" ac_id); + Debug.call 's' (fun f -> fprintf f "%d\n" ac_id); if live_aircraft ac_id then match udp_peername ac_id with - Some (Unix.ADDR_INET (peername, _port)) -> - udp_send device.fd payload peername - | _ -> - match device.transport with - Pprz -> - let o = Unix.out_channel_of_descr device.fd in - let buf = Pprz.Transport.packet payload in - Printf.fprintf o "%s" buf; flush o; - Debug.call 's' (fun f -> fprintf f "mm sending: %s\n" (Debug.xprint buf)); - | XBee -> - XB.send ~ac_id device payload + Some (Unix.ADDR_INET (peername, _port)) -> + udp_send device.fd payload peername + | _ -> + match device.transport with + Pprz -> + let o = Unix.out_channel_of_descr device.fd in + let buf = Pprz.Transport.packet payload in + Printf.fprintf o "%s" buf; flush o; + Debug.call 's' (fun f -> fprintf f "mm sending: %s\n" (Debug.xprint buf)); + | XBee -> + XB.send ~ac_id device payload let broadcast = fun device payload _priority -> if !udp then Hashtbl.iter (* Sending to all alive A/C *) (fun ac_id status -> - if live_aircraft ac_id then - match status.udp_peername with - Some (Unix.ADDR_INET (peername, _port)) -> - udp_send device.fd payload peername - | _ -> ()) + if live_aircraft ac_id then + match status.udp_peername with + Some (Unix.ADDR_INET (peername, _port)) -> + udp_send device.fd payload peername + | _ -> ()) statuss else match device.transport with - Pprz -> - let o = Unix.out_channel_of_descr device.fd in - let buf = Pprz.Transport.packet payload in - Printf.fprintf o "%s" buf; flush o; - Debug.call 'l' (fun f -> fprintf f "mm sending: %s\n" (Debug.xprint buf)); - | Pprz2 -> + Pprz -> + let o = Unix.out_channel_of_descr device.fd in + let buf = Pprz.Transport.packet payload in + Printf.fprintf o "%s" buf; flush o; + Debug.call 'l' (fun f -> fprintf f "mm sending: %s\n" (Debug.xprint buf)); + | Pprz2 -> let o = Unix.out_channel_of_descr device.fd in let buf = Pprz.TransportExtended.packet payload in - Printf.fprintf o "%s" buf; flush o; + Printf.fprintf o "%s" buf; flush o; Debug.call 'l' (fun f -> fprintf f "mm sending: %s\n" (Debug.xprint buf)); - | XBee -> + | XBee -> XB.send device payload @@ -350,27 +350,27 @@ end let parser_of_device = fun device -> match device.transport with - Pprz -> + Pprz -> + let use = fun s -> + let raw_data_size = String.length (Serial.string_of_payload s) + 4 (*stx,len,ck_a, ck_b*) in + let udp_peername = + if !udp then + Some !last_udp_peername + else + None in + use_tele_message ?udp_peername ~raw_data_size s in + PprzTransport.parse use + | Pprz2 -> let use = fun s -> - let raw_data_size = String.length (Serial.string_of_payload s) + 4 (*stx,len,ck_a, ck_b*) in - let udp_peername = - if !udp then - Some !last_udp_peername - else - None in - use_tele_message ?udp_peername ~raw_data_size s in - PprzTransport.parse use - | Pprz2 -> - let use = fun s -> - let raw_data_size = String.length (Serial.string_of_payload s) + 8 (*stx,len, timestamp, ck_a, ck_b*) in - let udp_peername = - if !udp then - Some !last_udp_peername - else - None in - use_tele_message ?udp_peername ~raw_data_size s in + let raw_data_size = String.length (Serial.string_of_payload s) + 8 (*stx,len, timestamp, ck_a, ck_b*) in + let udp_peername = + if !udp then + Some !last_udp_peername + else + None in + use_tele_message ?udp_peername ~raw_data_size s in PprzTransportExtended.parse use - | XBee -> + | XBee -> let module XbeeTransport = Serial.Transport (Xbee.Protocol) in XbeeTransport.parse (XB.use_message device) @@ -403,9 +403,9 @@ let message_uplink = fun device -> Hashtbl.iter (fun _m_id msg -> match msg.Pprz.link with - Some Pprz.Forwarded -> set_forwarder msg.Pprz.name - | Some Pprz.Broadcasted -> if !ac_info then set_broadcaster msg.Pprz.name - | _ -> ()) + Some Pprz.Forwarded -> set_forwarder msg.Pprz.name + | Some Pprz.Broadcasted -> if !ac_info then set_broadcaster msg.Pprz.name + | _ -> ()) Dl_Pprz.messages let send_ping_msg = fun device -> @@ -468,16 +468,16 @@ let () = String.length !port >= 4 && String.sub !port 0 4 = "/dev" in (* FIXME *) let fd = if !udp then begin - let sockaddr = Unix.ADDR_INET (Unix.inet_addr_any, !udp_port) - and socket = Unix.socket Unix.PF_INET Unix.SOCK_DGRAM 0 in - Unix.bind socket sockaddr; - socket + let sockaddr = Unix.ADDR_INET (Unix.inet_addr_any, !udp_port) + and socket = Unix.socket Unix.PF_INET Unix.SOCK_DGRAM 0 in + Unix.bind socket sockaddr; + socket end else if !audio then - Demod.init !port - else if on_serial_device then - Serial.opendev !port (Serial.speed_of_baudrate !baudrate) !hw_flow_control - else - Unix.openfile !port [Unix.O_RDWR] 0o640 + Demod.init !port + else if on_serial_device then + Serial.opendev !port (Serial.speed_of_baudrate !baudrate) !hw_flow_control + else + Unix.openfile !port [Unix.O_RDWR] 0o640 in (* Create the device object *) @@ -487,23 +487,23 @@ let () = (* The function to be called when data is available *) let read_fd = if !audio then - fun _io_event -> (* Demodulation *) - let (data_left, _data_right) = Demod.get_data () in - Audio.use_data data_left; - true (* Returns true to be called again *) + fun _io_event -> (* Demodulation *) + let (data_left, _data_right) = Demod.get_data () in + Audio.use_data data_left; + true (* Returns true to be called again *) else (* Buffering and parsing *) - let buffered_parser = - (* Get the specific parser for the given transport protocol *) - let parser = parser_of_device device in - let read = if !udp then udp_read else Unix.read in - (* Wrap the parser into the buffered bytes reader *) - match Serial.input ~read parser with Serial.Closure f -> f in - fun _io_event -> - begin - try buffered_parser fd with - exc -> prerr_endline (Printexc.to_string exc) - end; - true (* Returns true to be called again *) + let buffered_parser = + (* Get the specific parser for the given transport protocol *) + let parser = parser_of_device device in + let read = if !udp then udp_read else Unix.read in + (* Wrap the parser into the buffered bytes reader *) + match Serial.input ~read parser with Serial.Closure f -> f in + fun _io_event -> + begin + try buffered_parser fd with + exc -> prerr_endline (Printexc.to_string exc) + end; + true (* Returns true to be called again *) in ignore (Glib.Io.add_watch [`HUP] hangup (GMain.Io.channel_of_descr fd)); ignore (Glib.Io.add_watch [`IN] read_fd (GMain.Io.channel_of_descr fd)); @@ -516,15 +516,15 @@ let () = begin ignore (Glib.Timeout.add status_msg_period (fun () -> send_status_msg (); true)); let start_ping = fun () -> - ignore (Glib.Timeout.add ping_msg_period (fun () -> send_ping_msg device; true)); - false in + ignore (Glib.Timeout.add ping_msg_period (fun () -> send_ping_msg device; true)); + false in ignore (Glib.Timeout.add status_ping_diff start_ping); if !aerocomm then - Aerocomm.set_data_mode fd; + Aerocomm.set_data_mode fd; match transport with - XBee -> - XB.init device - | _ -> () + XBee -> + XB.init device + | _ -> () end; @@ -534,5 +534,5 @@ let () = ignore (Glib.Main.iteration true) done with - Xml.Error e -> prerr_endline (Xml.error e); exit 1 - | exn -> fprintf stderr "%s\n" (Printexc.to_string exn); exit 1 + Xml.Error e -> prerr_endline (Xml.error e); exit 1 + | exn -> fprintf stderr "%s\n" (Printexc.to_string exn); exit 1 diff --git a/sw/ground_segment/tmtc/messages.ml b/sw/ground_segment/tmtc/messages.ml index f595333ee5..40aeed971c 100644 --- a/sw/ground_segment/tmtc/messages.ml +++ b/sw/ground_segment/tmtc/messages.ml @@ -160,20 +160,20 @@ let rec one_class = fun (notebook:GPack.notebook) (ident, xml_class, sender) -> | Some "*" -> (* Waiting for a new sender in this class *) let get_one = fun sender _vs -> - if not (Hashtbl.mem senders sender) then begin - Hashtbl.add senders sender (); - one_class notebook (ident, xml_class, Some sender) - end in + if not (Hashtbl.mem senders sender) then begin + Hashtbl.add senders sender (); + one_class notebook (ident, xml_class, Some sender) + end in List.iter - (fun m -> ignore (P.message_bind (Xml.attrib m "name") get_one)) - messages + (fun m -> ignore (P.message_bind (Xml.attrib m "name") get_one)) + messages | _ -> let class_notebook = GPack.notebook ~tab_border:0 ~tab_pos:`LEFT () in let l = match sender with None -> "" | Some s -> ":"^s in let label = GMisc.label ~text:(ident^l) () in ignore (notebook#append_page ~tab_label:label#coerce class_notebook#coerce); let bind, sender_name = match sender with - None -> (fun m cb -> (P.message_bind m cb)), "*" + None -> (fun m cb -> (P.message_bind m cb)), "*" | Some sender -> (fun m cb -> (P.message_bind ~sender m cb)), sender in (** Forall messages in the class *) @@ -210,12 +210,12 @@ let _ = let xml = Pprz.messages_xml () in let class_of = fun n -> try - List.find (fun x -> ExtXml.attrib x "name" = n) (Xml.children xml) + List.find (fun x -> ExtXml.attrib x "name" = n) (Xml.children xml) with Not_found -> failwith (sprintf "Unknown messages class: %s" n) in List.map (fun x -> match Str.split (Str.regexp ":") x with - [cl; s] -> (cl, class_of cl, Some s) + [cl; s] -> (cl, class_of cl, Some s) | [cl] -> (x, class_of cl, None) | _ -> failwith (sprintf "Wrong class '%s', class[:sender] expected" x)) !classes in diff --git a/sw/ground_segment/tmtc/modem.ml b/sw/ground_segment/tmtc/modem.ml index d0dbc529e4..a1270baa10 100644 --- a/sw/ground_segment/tmtc/modem.ml +++ b/sw/ground_segment/tmtc/modem.ml @@ -25,9 +25,9 @@ open Printf module Protocol = struct -(* Header: STX, length of (payload + checksum) *) -(* Payload: tag, data *) -(* Trailer : checksum, ETX *) + (* Header: STX, length of (payload + checksum) *) + (* Payload: tag, data *) + (* Trailer : checksum, ETX *) let stx = Char.chr 0x02 let etx = 0x03 @@ -68,15 +68,15 @@ let msg_debug = 3 let msg_valim = 4 type status = { - mutable valim : float; - mutable cd : int; - mutable error : int; - mutable debug : int; - mutable nb_byte : int; - mutable nb_msg : int; - mutable nb_err : int; - mutable detected : int - } + mutable valim : float; + mutable cd : int; + mutable error : int; + mutable debug : int; + mutable nb_byte : int; + mutable nb_msg : int; + mutable nb_err : int; + mutable detected : int +} let status = { valim = 0.; @@ -88,8 +88,8 @@ let status = { nb_err = 0; detected = 0; } -(* FIXME *) - let valim = fun x -> float x *. 0.0162863 -. 1.17483 + (* FIXME *) +let valim = fun x -> float x *. 0.0162863 -. 1.17483 (* FIXME *) let parse_payload = fun payload -> @@ -104,16 +104,16 @@ let parse_payload = fun payload -> else begin begin match id with - | x when x = msg_error -> - status.error <- (Char.code payload.[1]) - | x when x = msg_cd -> - status.cd <- (Char.code payload.[1]) - | x when x = msg_debug -> - status.debug <- (Char.code payload.[1]) - | x when x = msg_valim -> - status.valim <- (valim (Char.code payload.[2] * 0x100 + Char.code payload.[1])); - | _ -> (* Uncorrect id *) - status.nb_err <- status.nb_err + 1 + | x when x = msg_error -> + status.error <- (Char.code payload.[1]) + | x when x = msg_cd -> + status.cd <- (Char.code payload.[1]) + | x when x = msg_debug -> + status.debug <- (Char.code payload.[1]) + | x when x = msg_valim -> + status.valim <- (valim (Char.code payload.[2] * 0x100 + Char.code payload.[1])); + | _ -> (* Uncorrect id *) + status.nb_err <- status.nb_err + 1 end; None end diff --git a/sw/ground_segment/tmtc/rotorcraft_server.ml b/sw/ground_segment/tmtc/rotorcraft_server.ml index 07cf7962a3..dded7be570 100644 --- a/sw/ground_segment/tmtc/rotorcraft_server.ml +++ b/sw/ground_segment/tmtc/rotorcraft_server.ml @@ -44,7 +44,7 @@ let rec norm_course = let fvalue = fun x -> match x with - Pprz.Float x -> x + Pprz.Float x -> x | Pprz.Int32 x -> Int32.to_float x | Pprz.Int x -> float_of_int x | _ -> failwith (sprintf "Receive.log_and_parse: float expected, got '%s'" (Pprz.string_of_value x)) @@ -52,28 +52,28 @@ let fvalue = fun x -> let ivalue = fun x -> match x with - Pprz.Int x -> x - | Pprz.Int32 x -> Int32.to_int x - | _ -> failwith "Receive.log_and_parse: int expected" + Pprz.Int x -> x + | Pprz.Int32 x -> Int32.to_int x + | _ -> failwith "Receive.log_and_parse: int expected" (* -let i32value = fun x -> + let i32value = fun x -> match x with - Pprz.Int32 x -> x + Pprz.Int32 x -> x | _ -> failwith "Receive.log_and_parse: int32 expected" *) let foi32value = fun x -> match x with - Pprz.Int32 x -> Int32.to_float x - | _ -> failwith "Receive.log_and_parse: int32 expected" + Pprz.Int32 x -> Int32.to_float x + | _ -> failwith "Receive.log_and_parse: int32 expected" let format_string_field = fun s -> let s = String.copy s in for i = 0 to String.length s - 1 do match s.[i] with - ' ' -> s.[i] <- '_' - | _ -> () + ' ' -> s.[i] <- '_' + | _ -> () done; s @@ -92,8 +92,8 @@ let update_waypoint = fun ac wp_id p alt -> if new_wp <> prev_wp then Hashtbl.replace ac.waypoints wp_id new_wp with - Not_found -> - Hashtbl.add ac.waypoints wp_id new_wp + Not_found -> + Hashtbl.add ac.waypoints wp_id new_wp (*let get_pprz_mode = fun ap_mode -> let mode = ref 0 in @@ -117,27 +117,27 @@ let gps_frac = 1e7 let geo_hmsl_of_ltp = fun ned nav_ref d_hmsl -> match nav_ref with - | Ltp nav_ref_ecef -> - let (geo, alt) = LL.geo_of_ecef LL.WGS84 (LL.ecef_of_ned nav_ref_ecef ned) in - (geo, alt +. d_hmsl) - | _ -> (LL.make_geo 0. 0., 0.) + | Ltp nav_ref_ecef -> + let (geo, alt) = LL.geo_of_ecef LL.WGS84 (LL.ecef_of_ned nav_ref_ecef ned) in + (geo, alt +. d_hmsl) + | _ -> (LL.make_geo 0. 0., 0.) let hmsl_of_ref = fun nav_ref d_hmsl -> match nav_ref with - | Ltp nav_ref_ecef -> - let (_, alt) = LL.geo_of_ecef LL.WGS84 nav_ref_ecef in - alt +. d_hmsl - | _ -> 0. + | Ltp nav_ref_ecef -> + let (_, alt) = LL.geo_of_ecef LL.WGS84 nav_ref_ecef in + alt +. d_hmsl + | _ -> 0. let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> let value = fun x -> try Pprz.assoc x values with Not_found -> failwith (sprintf "Error: field '%s' not found\n" x) in let fvalue = fun x -> let f = fvalue (value x) in - match classify_float f with - FP_infinite | FP_nan -> - let msg = sprintf "Non normal number: %f in '%s %s %s'" f ac_name msg.Pprz.name (string_of_values values) in - raise (Telemetry_error (ac_name, format_string_field msg)) + match classify_float f with + FP_infinite | FP_nan -> + let msg = sprintf "Non normal number: %f in '%s %s %s'" f ac_name msg.Pprz.name (string_of_values values) in + raise (Telemetry_error (ac_name, format_string_field msg)) | _ -> f and ivalue = fun x -> ivalue (value x) @@ -146,42 +146,42 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> if not (msg.Pprz.name = "DOWNLINK_STATUS") then a.last_msg_date <- U.gettimeofday (); match msg.Pprz.name with - "ROTORCRAFT_FP" -> - begin match a.nav_ref with - None -> (); (* No nav_ref yet *) - | Some nav_ref -> - let north = foi32value "north" /. pos_frac - and east = foi32value "east" /. pos_frac - and up = foi32value "up" /. pos_frac in - let (geo, h) = geo_hmsl_of_ltp (LL.make_ned [| north; east; -. up |]) nav_ref a.d_hmsl in - a.pos <- geo; - a.alt <- h; - let desired_east = foi32value "carrot_east" /. pos_frac - and desired_north = foi32value "carrot_north" /. pos_frac - and desired_alt = foi32value "carrot_up" /. pos_frac in - a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref ~z:desired_alt (desired_east, desired_north); - a.desired_altitude <- desired_alt +. (hmsl_of_ref nav_ref a.d_hmsl); - a.desired_course <- foi32value "carrot_psi" /. angle_frac - (* a.desired_climb <- ?? *) - end; - let veast = foi32value "veast" /. speed_frac - and vnorth = foi32value "vnorth" /. speed_frac in - a.gspeed <- sqrt(vnorth*.vnorth +. veast*.veast); - a.climb <- foi32value "vup" /. speed_frac; - a.agl <- a.alt -. float (try Srtm.of_wgs84 a.pos with _ -> 0); - a.course <- norm_course ((Rad>>Deg) (foi32value "psi" /. angle_frac)); - a.heading <- norm_course (foi32value "psi" /. angle_frac); - a.roll <- foi32value "phi" /. angle_frac; - a.pitch <- foi32value "theta" /. angle_frac; - a.throttle <- foi32value "thrust" /. 9600. *. 100.; - a.flight_time <- ivalue "flight_time"; - (*if a.gspeed > 3. && a.ap_mode = _AUTO2 then - Wind.update ac_name a.gspeed a.course*) - | "GPS_INT" -> + "ROTORCRAFT_FP" -> + begin match a.nav_ref with + None -> (); (* No nav_ref yet *) + | Some nav_ref -> + let north = foi32value "north" /. pos_frac + and east = foi32value "east" /. pos_frac + and up = foi32value "up" /. pos_frac in + let (geo, h) = geo_hmsl_of_ltp (LL.make_ned [| north; east; -. up |]) nav_ref a.d_hmsl in + a.pos <- geo; + a.alt <- h; + let desired_east = foi32value "carrot_east" /. pos_frac + and desired_north = foi32value "carrot_north" /. pos_frac + and desired_alt = foi32value "carrot_up" /. pos_frac in + a.desired_pos <- Aircraft.add_pos_to_nav_ref nav_ref ~z:desired_alt (desired_east, desired_north); + a.desired_altitude <- desired_alt +. (hmsl_of_ref nav_ref a.d_hmsl); + a.desired_course <- foi32value "carrot_psi" /. angle_frac + (* a.desired_climb <- ?? *) + end; + let veast = foi32value "veast" /. speed_frac + and vnorth = foi32value "vnorth" /. speed_frac in + a.gspeed <- sqrt(vnorth*.vnorth +. veast*.veast); + a.climb <- foi32value "vup" /. speed_frac; + a.agl <- a.alt -. float (try Srtm.of_wgs84 a.pos with _ -> 0); + a.course <- norm_course ((Rad>>Deg) (foi32value "psi" /. angle_frac)); + a.heading <- norm_course (foi32value "psi" /. angle_frac); + a.roll <- foi32value "phi" /. angle_frac; + a.pitch <- foi32value "theta" /. angle_frac; + a.throttle <- foi32value "thrust" /. 9600. *. 100.; + a.flight_time <- ivalue "flight_time"; + (*if a.gspeed > 3. && a.ap_mode = _AUTO2 then + Wind.update ac_name a.gspeed a.course*) + | "GPS_INT" -> a.unix_time <- LL.unix_time_of_tow (truncate (fvalue "tow" /. 1000.)); a.itow <- Int32.of_float (fvalue "tow"); a.gps_Pacc <- ivalue "pacc" - | "ROTORCRAFT_STATUS" -> + | "ROTORCRAFT_STATUS" -> a.vehicle_type <- Rotorcraft; a.fbw.rc_status <- get_rc_status (ivalue "rc_status"); a.fbw.rc_rate <- ivalue "frame_rate"; @@ -189,9 +189,9 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> a.ap_mode <- check_index (ivalue "ap_mode") rotorcraft_ap_modes "ROTORCRAFT_AP_MODE"; a.kill_mode <- ivalue "ap_motors_on" == 0; a.bat <- fvalue "vsupply" /. 10. - | "STATE_FILTER_STATUS" -> + | "STATE_FILTER_STATUS" -> a.state_filter_mode <- check_index (ivalue "state_filter_mode") state_filter_modes "STATE_FILTER_MODES" - | "INS_REF" -> + | "INS_REF" -> let x = foi32value "ecef_x0" /. 100. and y = foi32value "ecef_y0" /. 100. and z = foi32value "ecef_z0" /. 100. @@ -200,22 +200,22 @@ let log_and_parse = fun ac_name (a:Aircraft.aircraft) msg values -> let nav_ref_ecef = LL.make_ecef [| x; y; z |] in a.nav_ref <- Some (Ltp nav_ref_ecef); a.d_hmsl <- hmsl -. alt; - | "ROTORCRAFT_NAV_STATUS" -> + | "ROTORCRAFT_NAV_STATUS" -> a.block_time <- ivalue "block_time"; a.stage_time <- ivalue "stage_time"; a.cur_block <- ivalue "cur_block"; a.cur_stage <- ivalue "cur_stage"; a.horizontal_mode <- check_index (ivalue "horizontal_mode") horiz_modes "AP_HORIZ"; - (*a.dist_to_wp <- sqrt (fvalue "dist2_wp")*) - | "WP_MOVED_ENU" -> + (*a.dist_to_wp <- sqrt (fvalue "dist2_wp")*) + | "WP_MOVED_ENU" -> begin match a.nav_ref with - Some nav_ref -> - let east = foi32value "east" /. pos_frac - and north = foi32value "north" /. pos_frac - and up = foi32value "up" /. pos_frac in - let (geo, h) = geo_hmsl_of_ltp (LL.make_ned [| north; east; -. up |]) nav_ref a.d_hmsl in - update_waypoint a (ivalue "wp_id") geo h; - | None -> (); (** Can't use this message *) + Some nav_ref -> + let east = foi32value "east" /. pos_frac + and north = foi32value "north" /. pos_frac + and up = foi32value "up" /. pos_frac in + let (geo, h) = geo_hmsl_of_ltp (LL.make_ned [| north; east; -. up |]) nav_ref a.d_hmsl in + update_waypoint a (ivalue "wp_id") geo h; + | None -> (); (** Can't use this message *) end - | _ -> () + | _ -> () diff --git a/sw/ground_segment/tmtc/server.ml b/sw/ground_segment/tmtc/server.ml index 381fd79cac..4a637d3fc3 100644 --- a/sw/ground_segment/tmtc/server.ml +++ b/sw/ground_segment/tmtc/server.ml @@ -52,9 +52,9 @@ let get_indexed_value = fun t i -> let modes_of_type = fun vt -> match vt with - FixedWing -> fixedwing_ap_modes - | Rotorcraft -> rotorcraft_ap_modes - | UnknownVehicleType -> [| |] + FixedWing -> fixedwing_ap_modes + | Rotorcraft -> rotorcraft_ap_modes + | UnknownVehicleType -> [| |] (** The aircrafts store *) let aircrafts = Hashtbl.create 3 @@ -89,7 +89,7 @@ let make_element = fun t a c -> Xml.Element (t,a,c) let log_xml = fun timeofday data_file -> let conf_children = List.map - (fun x -> if Xml.tag x = "aircraft" then expand_aicraft x else x) + (fun x -> if Xml.tag x = "aircraft" then expand_aicraft x else x) (Xml.children conf_xml) in let expanded_conf = make_element (Xml.tag conf_xml) (Xml.attribs conf_xml) conf_children in make_element @@ -122,14 +122,14 @@ let logger = fun () -> let log = fun ?timestamp logging ac_name msg_name values -> match logging with - Some log -> - let s = string_of_values values in - let t = - match timestamp with - Some x -> x - | None -> U.gettimeofday () -. start_time in - fprintf log "%.3f %s %s %s\n" t ac_name msg_name s; flush log - | None -> () + Some log -> + let s = string_of_values values in + let t = + match timestamp with + Some x -> x + | None -> U.gettimeofday () -. start_time in + fprintf log "%.3f %s %s %s\n" t ac_name msg_name s; flush log + | None -> () (** Callback for a message from a registered A/C *) @@ -144,55 +144,55 @@ let ac_msg = fun messages_xml logging ac_name ac -> Fw_server.log_and_parse ac_name ac msg values; Rotorcraft_server.log_and_parse ac_name ac msg values with - Telemetry_error (ac_name, msg) -> - Ground_Pprz.message_send my_id "TELEMETRY_ERROR" ["ac_id", Pprz.String ac_name;"message", Pprz.String msg]; - prerr_endline msg - | Pprz.Unknown_msg_name (x, c) -> - fprintf stderr "Unknown message %s in class %s from %s: %s\n%!" x c ac_name m - | x -> prerr_endline (Printexc.to_string x) + Telemetry_error (ac_name, msg) -> + Ground_Pprz.message_send my_id "TELEMETRY_ERROR" ["ac_id", Pprz.String ac_name;"message", Pprz.String msg]; + prerr_endline msg + | Pprz.Unknown_msg_name (x, c) -> + fprintf stderr "Unknown message %s in class %s from %s: %s\n%!" x c ac_name m + | x -> prerr_endline (Printexc.to_string x) (** If you are 1km above the ground, an angle of 89 degrees between the vertical and -your camera axis allow you to look 57km away: it should be enough ! **) + your camera axis allow you to look 57km away: it should be enough ! **) let cam_max_angle = (Deg>>Rad) 89. let send_cam_status = fun a -> if a.gps_mode = gps_mode_3D then match a.nav_ref with - None -> () (* No geo ref for camera target *) - | Some nav_ref -> - let h = a.agl in - let phi_absolute = a.cam.phi -. a.roll - and theta_absolute = a.cam.theta +. a.pitch in - if phi_absolute > -. cam_max_angle && phi_absolute < cam_max_angle && - theta_absolute > -. cam_max_angle && theta_absolute < cam_max_angle then - let dx = h *. tan phi_absolute - and dy = h *. tan theta_absolute in - let alpha = -. a.course in - let east = dx *. cos alpha -. dy *. sin alpha - and north = dx *. sin alpha +. dy *. cos alpha in - let wgs84 = Aircraft.add_pos_to_nav_ref (Geo a.pos) (east, north) in - let twgs84 = Aircraft.add_pos_to_nav_ref nav_ref a.cam.target in - let values = ["ac_id", Pprz.String a.id; - "cam_lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); - "cam_long", Pprz.Float ((Rad>>Deg)wgs84.posn_long); - "cam_target_lat", Pprz.Float ((Rad>>Deg)twgs84.posn_lat); - "cam_target_long", Pprz.Float ((Rad>>Deg)twgs84.posn_long)] in - Ground_Pprz.message_send my_id "CAM_STATUS" values + None -> () (* No geo ref for camera target *) + | Some nav_ref -> + let h = a.agl in + let phi_absolute = a.cam.phi -. a.roll + and theta_absolute = a.cam.theta +. a.pitch in + if phi_absolute > -. cam_max_angle && phi_absolute < cam_max_angle && + theta_absolute > -. cam_max_angle && theta_absolute < cam_max_angle then + let dx = h *. tan phi_absolute + and dy = h *. tan theta_absolute in + let alpha = -. a.course in + let east = dx *. cos alpha -. dy *. sin alpha + and north = dx *. sin alpha +. dy *. cos alpha in + let wgs84 = Aircraft.add_pos_to_nav_ref (Geo a.pos) (east, north) in + let twgs84 = Aircraft.add_pos_to_nav_ref nav_ref a.cam.target in + let values = ["ac_id", Pprz.String a.id; + "cam_lat", Pprz.Float ((Rad>>Deg)wgs84.posn_lat); + "cam_long", Pprz.Float ((Rad>>Deg)wgs84.posn_long); + "cam_target_lat", Pprz.Float ((Rad>>Deg)twgs84.posn_lat); + "cam_target_long", Pprz.Float ((Rad>>Deg)twgs84.posn_long)] in + Ground_Pprz.message_send my_id "CAM_STATUS" values let send_if_calib = fun a -> let if_mode = get_indexed_value if_modes a.inflight_calib.if_mode in let values = ["ac_id", Pprz.String a.id; - "if_mode", Pprz.String if_mode; - "if_value1", Pprz.Float a.inflight_calib.if_val1; - "if_value2", Pprz.Float a.inflight_calib.if_val2] in + "if_mode", Pprz.String if_mode; + "if_value1", Pprz.Float a.inflight_calib.if_val1; + "if_value2", Pprz.Float a.inflight_calib.if_val2] in Ground_Pprz.message_send my_id "INFLIGH_CALIB" values let send_fbw = fun a -> let values = [ "ac_id", Pprz.String a.id; - "rc_mode", Pprz.String a.fbw.rc_mode; - "rc_status", Pprz.String a.fbw.rc_status; - "rc_rate", Pprz.Int a.fbw.rc_rate ] in + "rc_mode", Pprz.String a.fbw.rc_mode; + "rc_status", Pprz.String a.fbw.rc_status; + "rc_rate", Pprz.Int a.fbw.rc_rate ] in Ground_Pprz.message_send my_id "FLY_BY_WIRE" values let send_dl_values = fun a -> @@ -225,38 +225,38 @@ let send_svsinfo = fun a -> done; let f = fun s r -> (s, Pprz.String !r) in let vs = ["ac_id", Pprz.String a.id; - "pacc", Pprz.Int a.gps_Pacc; - f "svid" svid; f "flags" flags; f "qi" qi; f "msg_age" age; - f "cno" cno; f "elev" elev; f "azim" azim] in + "pacc", Pprz.Int a.gps_Pacc; + f "svid" svid; f "flags" flags; f "qi" qi; f "msg_age" age; + f "cno" cno; f "elev" elev; f "azim" azim] in Ground_Pprz.message_send my_id "SVSINFO" vs let send_horiz_status = fun a -> match a.horiz_mode with - Circle (geo, r) -> + Circle (geo, r) -> + let vs = [ "ac_id", Pprz.String a.id; + "circle_lat", Pprz.Float ((Rad>>Deg)geo.posn_lat); + "circle_long", Pprz.Float ((Rad>>Deg)geo.posn_long); + "radius", Pprz.Int r ] in + Ground_Pprz.message_send my_id "CIRCLE_STATUS" vs + | Segment (geo1, geo2) -> let vs = [ "ac_id", Pprz.String a.id; - "circle_lat", Pprz.Float ((Rad>>Deg)geo.posn_lat); - "circle_long", Pprz.Float ((Rad>>Deg)geo.posn_long); - "radius", Pprz.Int r ] in - Ground_Pprz.message_send my_id "CIRCLE_STATUS" vs - | Segment (geo1, geo2) -> - let vs = [ "ac_id", Pprz.String a.id; - "segment1_lat", Pprz.Float ((Rad>>Deg)geo1.posn_lat); - "segment1_long", Pprz.Float ((Rad>>Deg)geo1.posn_long); - "segment2_lat", Pprz.Float ((Rad>>Deg)geo2.posn_lat); - "segment2_long", Pprz.Float ((Rad>>Deg)geo2.posn_long) ] in + "segment1_lat", Pprz.Float ((Rad>>Deg)geo1.posn_lat); + "segment1_long", Pprz.Float ((Rad>>Deg)geo1.posn_long); + "segment2_lat", Pprz.Float ((Rad>>Deg)geo2.posn_lat); + "segment2_long", Pprz.Float ((Rad>>Deg)geo2.posn_long) ] in Ground_Pprz.message_send my_id "SEGMENT_STATUS" vs - | UnknownHorizMode -> () + | UnknownHorizMode -> () let send_survey_status = fun a -> match a.survey with - None -> - Ground_Pprz.message_send my_id "SURVEY_STATUS" ["ac_id", Pprz.String a.id] - | Some (geo1, geo2) -> + None -> + Ground_Pprz.message_send my_id "SURVEY_STATUS" ["ac_id", Pprz.String a.id] + | Some (geo1, geo2) -> let vs = [ "ac_id", Pprz.String a.id; - "south_lat", Pprz.Float ((Rad>>Deg)geo1.posn_lat); - "west_long", Pprz.Float ((Rad>>Deg)geo1.posn_long); - "north_lat", Pprz.Float ((Rad>>Deg)geo2.posn_lat); - "east_long", Pprz.Float ((Rad>>Deg)geo2.posn_long) ] in + "south_lat", Pprz.Float ((Rad>>Deg)geo1.posn_lat); + "west_long", Pprz.Float ((Rad>>Deg)geo1.posn_long); + "north_lat", Pprz.Float ((Rad>>Deg)geo2.posn_lat); + "east_long", Pprz.Float ((Rad>>Deg)geo2.posn_long) ] in Ground_Pprz.message_send my_id "SURVEY_STATUS" vs @@ -273,7 +273,7 @@ let send_wind = fun a -> "stddev", Pprz.Float stddev] in Ground_Pprz.message_send my_id "WIND" vs with - _exc -> () + _exc -> () let send_telemetry_status = fun a -> let id = a.id in @@ -283,18 +283,18 @@ let send_telemetry_status = fun a -> "time_since_last_msg", Pprz.Float (U.gettimeofday () -. a.last_msg_date)] in Ground_Pprz.message_send my_id "TELEMETRY_STATUS" vs with - _exc -> () + _exc -> () let send_moved_waypoints = fun a -> Hashtbl.iter (fun wp_id wp -> let geo = wp.wp_geo in let vs = - ["ac_id", Pprz.String a.id; - "wp_id", Pprz.Int wp_id; - "long", Pprz.Float ((Rad>>Deg)geo.posn_long); - "lat", Pprz.Float ((Rad>>Deg)geo.posn_lat); - "alt", Pprz.Float wp.altitude] in + ["ac_id", Pprz.String a.id; + "wp_id", Pprz.Int wp_id; + "long", Pprz.Float ((Rad>>Deg)geo.posn_long); + "lat", Pprz.Float ((Rad>>Deg)geo.posn_lat); + "alt", Pprz.Float wp.altitude] in Ground_Pprz.message_send my_id "WAYPOINT_MOVED" vs) a.waypoints @@ -308,18 +308,18 @@ let send_aircraft_msg = fun ac -> let f = fun x -> Pprz.Float x in let wgs84 = try a.pos with _ -> LL.make_geo 0. 0. in let values = ["ac_id", Pprz.String ac; - "roll", f (Geometry_2d.rad2deg a.roll); - "pitch", f (Geometry_2d.rad2deg a.pitch); - "heading", f (Geometry_2d.rad2deg a.heading); - "lat", f ((Rad>>Deg)wgs84.posn_lat); - "long", f ((Rad>>Deg) wgs84.posn_long); - "unix_time", f a.unix_time; - "itow", Pprz.Int32 a.itow; - "speed", f a.gspeed; - "course", f (Geometry_2d.rad2deg a.course); - "alt", f a.alt; - "agl", f a.agl; - "climb", f a.climb] in + "roll", f (Geometry_2d.rad2deg a.roll); + "pitch", f (Geometry_2d.rad2deg a.pitch); + "heading", f (Geometry_2d.rad2deg a.heading); + "lat", f ((Rad>>Deg)wgs84.posn_lat); + "long", f ((Rad>>Deg) wgs84.posn_long); + "unix_time", f a.unix_time; + "itow", Pprz.Int32 a.itow; + "speed", f a.gspeed; + "course", f (Geometry_2d.rad2deg a.course); + "alt", f a.alt; + "agl", f a.agl; + "climb", f a.climb] in Ground_Pprz.message_send my_id "FLIGHT_PARAM" values; (** send ACINFO messages if more than one A/C registered *) @@ -328,13 +328,13 @@ let send_aircraft_msg = fun ac -> let cm_of_m = fun f -> Pprz.Int (truncate (100. *. f)) in let pos = LL.utm_of WGS84 a.pos in let ac_info = ["ac_id", Pprz.String ac; - "utm_east", cm_of_m pos.utm_x; - "utm_north", cm_of_m pos.utm_y; - "course", Pprz.Int (truncate (10. *. (Geometry_2d.rad2deg a.course))); - "alt", cm_of_m a.alt; - "speed", cm_of_m a.gspeed; - "climb", cm_of_m a.climb; - "itow", Pprz.Int32 a.itow] in + "utm_east", cm_of_m pos.utm_x; + "utm_north", cm_of_m pos.utm_y; + "course", Pprz.Int (truncate (10. *. (Geometry_2d.rad2deg a.course))); + "alt", cm_of_m a.alt; + "speed", cm_of_m a.gspeed; + "climb", cm_of_m a.climb; + "itow", Pprz.Int32 a.itow] in Dl_Pprz.message_send my_id "ACINFO" ac_info; end; @@ -343,31 +343,31 @@ let send_aircraft_msg = fun ac -> begin match a.nav_ref with - Some nav_ref -> - let values = ["ac_id", Pprz.String ac; - "cur_block", Pprz.Int a.cur_block; - "cur_stage", Pprz.Int a.cur_stage; - "stage_time", Pprz.Int a.stage_time; - "block_time", Pprz.Int a.block_time; - "target_lat", f ((Rad>>Deg)a.desired_pos.posn_lat); - "target_long", f ((Rad>>Deg)a.desired_pos.posn_long); - "target_alt", Pprz.Float a.desired_altitude; - "target_climb", Pprz.Float a.desired_climb; - "target_course", Pprz.Float ((Rad>>Deg)a.desired_course); - "dist_to_wp", Pprz.Float a.dist_to_wp - ] in - Ground_Pprz.message_send my_id "NAV_STATUS" values - | None -> () (* No nav_ref yet *) + Some nav_ref -> + let values = ["ac_id", Pprz.String ac; + "cur_block", Pprz.Int a.cur_block; + "cur_stage", Pprz.Int a.cur_stage; + "stage_time", Pprz.Int a.stage_time; + "block_time", Pprz.Int a.block_time; + "target_lat", f ((Rad>>Deg)a.desired_pos.posn_lat); + "target_long", f ((Rad>>Deg)a.desired_pos.posn_long); + "target_alt", Pprz.Float a.desired_altitude; + "target_climb", Pprz.Float a.desired_climb; + "target_course", Pprz.Float ((Rad>>Deg)a.desired_course); + "dist_to_wp", Pprz.Float a.dist_to_wp + ] in + Ground_Pprz.message_send my_id "NAV_STATUS" values + | None -> () (* No nav_ref yet *) end; let values = ["ac_id", Pprz.String ac; - "throttle", f a.throttle; - "throttle_accu", f a.throttle_accu; - "rpm", f a.rpm; - "temp", f a.temp; - "bat", f a.bat; - "amp", f a.amp; - "energy", Pprz.Int a.energy] in + "throttle", f a.throttle; + "throttle_accu", f a.throttle_accu; + "rpm", f a.rpm; + "temp", f a.temp; + "bat", f a.bat; + "amp", f a.amp; + "energy", Pprz.Int a.energy] in Ground_Pprz.message_send my_id "ENGINE_STATUS" values; let ap_mode = get_indexed_value (modes_of_type a.vehicle_type) a.ap_mode in @@ -378,15 +378,15 @@ let send_aircraft_msg = fun ac -> let state_filter_mode = get_indexed_value state_filter_modes a.state_filter_mode and kill_mode = if a.kill_mode then "ON" else "OFF" in let values = ["ac_id", Pprz.String ac; - "flight_time", Pprz.Int a.flight_time; - "ap_mode", Pprz.String ap_mode; - "gaz_mode", Pprz.String gaz_mode; - "lat_mode", Pprz.String lat_mode; - "horiz_mode", Pprz.String horiz_mode; - "gps_mode", Pprz.String gps_mode; + "flight_time", Pprz.Int a.flight_time; + "ap_mode", Pprz.String ap_mode; + "gaz_mode", Pprz.String gaz_mode; + "lat_mode", Pprz.String lat_mode; + "horiz_mode", Pprz.String horiz_mode; + "gps_mode", Pprz.String gps_mode; "state_filter_mode", Pprz.String state_filter_mode; - "kill_mode", Pprz.String kill_mode - ] in + "kill_mode", Pprz.String kill_mode + ] in Ground_Pprz.message_send my_id "AP_STATUS" values; send_cam_status a; @@ -406,8 +406,8 @@ let send_aircraft_msg = fun ac -> Kml.update_waypoints a; send_telemetry_status a with - Not_found -> prerr_endline ac - | x -> prerr_endline (Printexc.to_string x) + Not_found -> prerr_endline ac + | x -> prerr_endline (Printexc.to_string x) (** Check if it is a replayed A/C (c.f. sw/logalizer/play.ml) *) let replayed = fun ac_id -> @@ -424,9 +424,9 @@ let get_conf = fun real_id id conf_xml -> try ExtXml.child conf_xml "aircraft" ~select:(fun x -> ExtXml.attrib x "ac_id" = id) with - Not_found -> - Hashtbl.add unknown_aircrafts real_id (); - failwith (sprintf "Error: A/C '%s' not found" id) + Not_found -> + Hashtbl.add unknown_aircrafts real_id (); + failwith (sprintf "Error: A/C '%s' not found" id) let check_md5sum = fun ac_name alive_md5sum aircraft_conf_dir -> (* Read the digest generated by sw/tools/gen_aircraft *) @@ -436,32 +436,32 @@ let check_md5sum = fun ac_name alive_md5sum aircraft_conf_dir -> try match alive_md5sum with - Pprz.Array array -> - let n = Array.length array in - assert(n = String.length md5sum / 2); - for i = 0 to n - 1 do - let x = int_of_string (sprintf "0x%c%c" md5sum.[2*i] md5sum.[2*i+1]) in - assert (x = Pprz.int_of_value array.(i)) - done - | _ -> failwith "Array expected here" + Pprz.Array array -> + let n = Array.length array in + assert(n = String.length md5sum / 2); + for i = 0 to n - 1 do + let x = int_of_string (sprintf "0x%c%c" md5sum.[2*i] md5sum.[2*i+1]) in + assert (x = Pprz.int_of_value array.(i)) + done + | _ -> failwith "Array expected here" with _ -> try match alive_md5sum with - Pprz.Array array -> - let n = Array.length array in - assert(n = String.length md5sum / 2); - for i = 0 to n - 1 do - let x = 0 in - assert (x = Pprz.int_of_value array.(i)) - done; - fprintf stderr "MD5 is ZERO, be carefull with configurations\n%!" - | _ -> failwith "Array expected here" + Pprz.Array array -> + let n = Array.length array in + assert(n = String.length md5sum / 2); + for i = 0 to n - 1 do + let x = 0 in + assert (x = Pprz.int_of_value array.(i)) + done; + fprintf stderr "MD5 is ZERO, be carefull with configurations\n%!" + | _ -> failwith "Array expected here" with _ -> - let error_message = sprintf "WARNING: live md5 signature for %s does not match current configuration, please reload your code (disable check with -no_md5_check option)" ac_name in - if !no_md5_check then - fprintf stderr "%s; continuing anyway as requested\n%!" error_message - else - failwith error_message + let error_message = sprintf "WARNING: live md5 signature for %s does not match current configuration, please reload your code (disable check with -no_md5_check option)" ac_name in + if !no_md5_check then + fprintf stderr "%s; continuing anyway as requested\n%!" error_message + else + failwith error_message let new_aircraft = fun get_alive_md5sum real_id -> @@ -471,7 +471,7 @@ let new_aircraft = fun get_alive_md5sum real_id -> let var_aircraft_dir = Env.paparazzi_home // root_dir // "var" // ac_name in if not (Sys.file_exists var_aircraft_dir) then begin - (* Let's look for a backup configuration with the md5 signature *) + (* Let's look for a backup configuration with the md5 signature *) end; let fp_file = var_aircraft_dir // "flight_plan.xml" in @@ -506,8 +506,8 @@ let check_alerts = fun a -> let send = fun level -> let vs = [ "ac_id", Pprz.String a.id; - "level", Pprz.String level; - "value", Pprz.Float a.bat] in + "level", Pprz.String level; + "value", Pprz.Float a.bat] in Alerts_Pprz.message_send my_id "BAT_LOW" vs in if a.bat < catastrophic_level then send "CATASTROPHIC" else if a.bat < critic_level then send "CRITIC" @@ -537,15 +537,15 @@ let periodic_airprox_check = fun name -> let check_airprox = fun ac -> try match Airprox.check_airprox thisac ac with - None -> () - | Some level -> - let vs = - ["ac_id", Pprz.String (thisac.id ^ "," ^ ac.id) ; "level", Pprz.String level] in - Alerts_Pprz.message_send my_id "AIR_PROX" vs + None -> () + | Some level -> + let vs = + ["ac_id", Pprz.String (thisac.id ^ "," ^ ac.id) ; "level", Pprz.String level] in + Alerts_Pprz.message_send my_id "AIR_PROX" vs with - x -> fprintf stderr "check_airprox: %s\n%!" (Printexc.to_string x) + x -> fprintf stderr "check_airprox: %s\n%!" (Printexc.to_string x) - in + in List.iter (fun ac -> @@ -578,7 +578,7 @@ let ident_msg = fun log name vs -> register_aircraft name ac; Ground_Pprz.message_send my_id "NEW_AIRCRAFT" ["ac_id", Pprz.String name] with - exc -> prerr_endline (Printexc.to_string exc) + exc -> prerr_endline (Printexc.to_string exc) let new_color = fun () -> sprintf "#%02x%02x%02x" (Random.int 256) (Random.int 256) (Random.int 256) @@ -600,9 +600,9 @@ let send_config = fun http _asker args -> let ac_name = ExtXml.attrib conf "name" in let protocol = if http then - sprintf "http://%s:8889" (Unix.gethostname ()) + sprintf "http://%s:8889" (Unix.gethostname ()) else - sprintf "file://%s" Env.paparazzi_home in + sprintf "file://%s" Env.paparazzi_home in let prefix = fun s -> sprintf "%s/%s%s" protocol root_dir s in (** Expanded flight plan and settings have been compiled in var/ *) @@ -610,7 +610,7 @@ let send_config = fun http _asker args -> and af = prefix ("conf" // ExtXml.attrib conf "airframe") and rc = prefix ("conf" // ExtXml.attrib conf "radio") and settings = if not _is_replayed then prefix ("var" // ac_name // - "settings.xml") else "file://replay" in + "settings.xml") else "file://replay" in let col = try Xml.attrib conf "gui_color" with _ -> new_color () in let ac_name = try Xml.attrib conf "name" with _ -> "" in [ "ac_id", Pprz.String ac_id; @@ -621,8 +621,8 @@ let send_config = fun http _asker args -> "default_gui_color", Pprz.String col; "ac_name", Pprz.String ac_name ] with - Not_found -> - failwith (sprintf "ground UNKNOWN %s" ac_id') + Not_found -> + failwith (sprintf "ground UNKNOWN %s" ac_id') let ivy_server = fun http -> ignore (Ground_Pprz.message_answerer my_id "AIRCRAFTS" send_aircrafts_msg); diff --git a/sw/ground_segment/tmtc/settings.ml b/sw/ground_segment/tmtc/settings.ml index 2ae22d7c14..48afb18dc7 100644 --- a/sw/ground_segment/tmtc/settings.ml +++ b/sw/ground_segment/tmtc/settings.ml @@ -60,7 +60,7 @@ let one_ac = fun (notebook:GPack.notebook) ac_name -> (* Bind to values updates *) let get_dl_value = fun _sender vs -> settings#set (Pprz.int_assoc "index" vs) (Pprz.float_assoc "value" vs) - in + in ignore (Tele_Pprz.message_bind "DL_VALUE" get_dl_value); (* Get the aiframe file *) diff --git a/sw/ground_segment/tmtc/stereo_demod.ml b/sw/ground_segment/tmtc/stereo_demod.ml index 04a834f9db..4da42da774 100644 --- a/sw/ground_segment/tmtc/stereo_demod.ml +++ b/sw/ground_segment/tmtc/stereo_demod.ml @@ -33,13 +33,13 @@ module PprzTransport = Serial.Transport(Tele_Pprz) (** Monitoring of the message reception *) type status = { - mutable ac_id : string; - mutable rx_byte : int; - mutable rx_msg : int; - mutable rx_err : int - } + mutable ac_id : string; + mutable rx_byte : int; + mutable rx_msg : int; + mutable rx_err : int +} (** Ivy messages are initially tagged "modem" and with the A/C -id as soon as it is identified (IDENT message) *) + id as soon as it is identified (IDENT message) *) let make_status = fun id -> { ac_id = id; rx_byte = 0; rx_msg = 0; rx_err = 0 } @@ -69,13 +69,13 @@ let listen_pprz_modem = fun pprz_message_cb devdsp -> (** Callback for available chars *) let cb = fun status buffer data -> (** Accumulate in a buffer *) - let b = !buffer ^ data in - Debug.call 'M' (fun f -> fprintf f "Pprz buffer: %s\n" (Debug.xprint b)); + let b = !buffer ^ data in + Debug.call 'M' (fun f -> fprintf f "Pprz buffer: %s\n" (Debug.xprint b)); (** Parse as pprz message and ... *) - let x = PprzTransport.parse (use_pprz_buf status) b in - status.rx_err <- !PprzTransport.nb_err; + let x = PprzTransport.parse (use_pprz_buf status) b in + status.rx_err <- !PprzTransport.nb_err; (** ... remove from the buffer the chars which have been used *) - buffer := String.sub b x (String.length b - x) + buffer := String.sub b x (String.length b - x) in let buffer_left = ref "" and buffer_right = ref "" in let cb_stereo = fun _ -> @@ -100,12 +100,12 @@ let send_modem_msg = fun status -> rx_msg := status.rx_msg; rx_byte := status.rx_byte; let vs = ["run_time", Pprz.Int t; - "rx_bytes_rate", Pprz.Float byte_rate; - "rx_msgs_rate", Pprz.Float msg_rate; - "rx_err", Pprz.Int status.rx_err; - "rx_bytes", Pprz.Int status.rx_byte; - "rx_msgs", Pprz.Int status.rx_msg - ] in + "rx_bytes_rate", Pprz.Float byte_rate; + "rx_msgs_rate", Pprz.Float msg_rate; + "rx_err", Pprz.Int status.rx_err; + "rx_bytes", Pprz.Int status.rx_byte; + "rx_msgs", Pprz.Int status.rx_msg + ] in Tele_Pprz.message_send status.ac_id "DOWNLINK_STATUS" vs (* main loop *) diff --git a/sw/ground_segment/tmtc/wind.ml b/sw/ground_segment/tmtc/wind.ml index 944b7d335a..924a55f0ca 100644 --- a/sw/ground_segment/tmtc/wind.ml +++ b/sw/ground_segment/tmtc/wind.ml @@ -24,26 +24,26 @@ (* Wind speed and direction are estimated from a dataset of ground speeds, -with the hypothesis that the airspeed is constant. This estimation is computed -by solving an optimization problem. The Nelder-Mead method is used -(http://en.wikipedia.org/wiki/Nelder-Mead_method). + with the hypothesis that the airspeed is constant. This estimation is computed + by solving an optimization problem. The Nelder-Mead method is used + (http://en.wikipedia.org/wiki/Nelder-Mead_method). - Let GS(i) a set of n recorded ground speed vectors and W the wind speed. -The norm of the (hypothetically constant) mean airspeed is + Let GS(i) a set of n recorded ground speed vectors and W the wind speed. + The norm of the (hypothetically constant) mean airspeed is as = 1/n sum(norm(GS(i)-W)) -Let + Let stderr = 1/n sum (norm(GS(i)-W)-as)^2 -The minimization of stderr, on the W decision variable, returns an estimation -of W. + The minimization of stderr, on the W decision variable, returns an estimation + of W. -Remarks: - - GS(i) actually is the sequence of the _last_ recorded ground speeds. - - In the "isotropic" implementation, each sample is weighted by its relative -difference in direction to the other samples. + Remarks: + - GS(i) actually is the sequence of the _last_ recorded ground speeds. + - In the "isotropic" implementation, each sample is weighted by its relative + difference in direction to the other samples. *) @@ -91,23 +91,23 @@ let simplex p fmax step max_iter precision = let vr = calcnew vs.c.p vb (-1.) in let fvr = f vr in let new_vs = - if fvr > vs.a.f then - let ve = calcnew vs.c.p vb (-2.) in - let fve = f ve in - if fve > fvr then shift ve fve vs - else shift vr fvr vs - else - let vc = calcnew vs.c.p vb 0.5 in - let fvc = f vc in - if fvc > vs.b.f || fvr > vs.b.f then - let v = if fvr > fvc then {p = vr; f = fvr} else {p = vc; f = fvc} in - if v.f <= vs.b.f then {vs with c = v} - else if v.f > vs.a.f then shiftpv v vs - else {vs with b = v; c = vs.b} - else - let vcb = calcnew vs.b.p vs.a.p 0.5 - and vcc = calcnew vs.c.p vs.a.p 0.5 in - triangle_sort {vs with b = {p = vcb; f = f vcb}; c = {p = vcc; f = f vcc}} in + if fvr > vs.a.f then + let ve = calcnew vs.c.p vb (-2.) in + let fve = f ve in + if fve > fvr then shift ve fve vs + else shift vr fvr vs + else + let vc = calcnew vs.c.p vb 0.5 in + let fvc = f vc in + if fvc > vs.b.f || fvr > vs.b.f then + let v = if fvr > fvc then {p = vr; f = fvr} else {p = vc; f = fvc} in + if v.f <= vs.b.f then {vs with c = v} + else if v.f > vs.a.f then shiftpv v vs + else {vs with b = v; c = vs.b} + else + let vcb = calcnew vs.b.p vs.a.p 0.5 + and vcc = calcnew vs.c.p vs.a.p 0.5 in + triangle_sort {vs with b = {p = vcb; f = f vcb}; c = {p = vcc; f = f vcc}} in loop (num_iter + 1) new_vs end else vs.a in @@ -123,15 +123,15 @@ let isotropic_wind wind_init speeds precision = let air_speeds = Array.map (fun speed -> cart2polar (vect_sub speed wind)) speeds in let weights = Array.mapi - (fun i airi -> - let sum = ref 0. in - for j = 0 to n-1 do - if j <> i then - sum := !sum +. - norm_angle_rad (abs_float (airi.theta2D -. air_speeds.(j).theta2D)) /. m_pi - done; - !sum /. (float (n-1))) - air_speeds in + (fun i airi -> + let sum = ref 0. in + for j = 0 to n-1 do + if j <> i then + sum := !sum +. + norm_angle_rad (abs_float (airi.theta2D -. air_speeds.(j).theta2D)) /. m_pi + done; + !sum /. (float (n-1))) + air_speeds in let sum_weights = Array.fold_left (+.) 0. weights in let mean = ref 0. in @@ -157,7 +157,7 @@ let isotropic_wind wind_init speeds precision = (* val wind : Geometry_2d.pt_2D -> Geometry_2d.pt_2D array -> float - -> (Geometry_2d.pt_2Dfloat * float * float) *) + -> (Geometry_2d.pt_2Dfloat * float * float) *) (** [wind wind_init speeds precision] returns the wind and air speed mean and std dev. *) let wind wind_init speeds precision = let mean wind = @@ -171,10 +171,10 @@ let wind wind_init speeds precision = let m = mean wind in let sum = Array.fold_left - (fun acc speed -> - let err = vect_norm (vect_sub speed wind) -. m in - acc +. err *. err) - 0. speeds in + (fun acc speed -> + let err = vect_norm (vect_sub speed wind) -. m in + acc +. err *. err) + 0. speeds in sum /. float (Array.length speeds) in let step = 2. and max_iter = 100 in @@ -183,11 +183,11 @@ let wind wind_init speeds precision = (wind.p, mean wind.p, -.wind.f) type wind_ac = { - speeds : Geometry_2d.pt_2D option array; - mutable index : int; - mutable length : int; - mutable wind_init : Geometry_2d.pt_2D - } + speeds : Geometry_2d.pt_2D option array; + mutable index : int; + mutable length : int; + mutable wind_init : Geometry_2d.pt_2D +} let h = Hashtbl.create 17 @@ -210,7 +210,7 @@ let update = fun id r course -> let speed = polar2cart {r2D = r; theta2D = theta} in let wind_ac = Hashtbl.find h id in let i = truncate (float (Array.length wind_ac.speeds) *. course /. 2. /. Latlong.pi) in -(* Printf.printf "i=%d\n%!" i; *) + (* Printf.printf "i=%d\n%!" i; *) wind_ac.speeds.(i) <- Some speed let compute = fun compute_wind id -> @@ -218,7 +218,7 @@ let compute = fun compute_wind id -> let wind_ac = Hashtbl.find h id in let speeds = List.fold_right (fun s r -> match s with Some s -> s::r | None -> r) (Array.to_list wind_ac.speeds) [] in let speeds = Array.of_list speeds in -(* Printf.printf "l=%d\n%!" (Array.length speeds); *) + (* Printf.printf "l=%d\n%!" (Array.length speeds); *) if Array.length speeds >= 3 then begin let wind_init = wind_ac.wind_init in let (wind, mean, stddev) = compute_wind wind_init speeds precision in diff --git a/sw/lib/ocaml/base64.ml b/sw/lib/ocaml/base64.ml index ad5e54eabc..922ca78923 100644 --- a/sw/lib/ocaml/base64.ml +++ b/sw/lib/ocaml/base64.ml @@ -28,7 +28,7 @@ (** Exception raised when there's an attempt to encode a chunk incorrectly *) exception Invalid_encode_chunk of int - (** The character map of all base64 characters *) +(** The character map of all base64 characters *) let char_map = [| 'A'; 'B'; 'C'; 'D'; 'E'; 'F'; 'G'; 'H'; 'I'; 'J'; 'K'; 'L'; 'M'; @@ -37,12 +37,12 @@ let char_map = [| 'n'; 'o'; 'p'; 'q'; 'r'; 's'; 't'; 'u'; 'v'; 'w'; 'x'; 'y'; 'z'; '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; '+'; '/'|] - (** - Functions for encoding - *) +(** + Functions for encoding +*) - (** Encode a chunk. The chunk is either a 1, 2, or 3 element array. *) +(** Encode a chunk. The chunk is either a 1, 2, or 3 element array. *) let encode_chunk chars = let llength = List.length chars in @@ -56,7 +56,7 @@ let encode_chunk chars = if (llength < 2) then ( chunk.[1] <- char_map.(tmpa); chunk; - ) else ( + ) else ( let b = List.nth chars 1 in let tmpb = ((Char.code b) lsr 4) in let tmpa2 = ((Char.code b) land 0x0f) lsl 2 in @@ -64,18 +64,18 @@ let encode_chunk chars = if (llength < 3) then ( chunk.[2] <- char_map.(tmpa2); chunk - ) else ( + ) else ( let c = List.nth chars 2 in let tmpb2 = ((Char.code c) land 0xc0) lsr 6 in chunk.[2] <- char_map.(tmpa2 lor tmpb2); chunk.[3] <- char_map.((Char.code c) land 0x3f); chunk - ) - ) + ) + ) - (** Stream chunk encoder. +(** Stream chunk encoder. - Use ``Stream.from'' to produce a stream of encoded data from a data stream. *) + Use ``Stream.from'' to produce a stream of encoded data from a data stream. *) let encode_stream_chunk data_stream cnt = let stream_empty s = @@ -85,42 +85,42 @@ let encode_stream_chunk data_stream cnt = with Stream.Failure -> false in if (stream_empty data_stream) then ( None - ) else ( + ) else ( let next = Stream.npeek 3 data_stream in List.iter (fun x -> Stream.junk data_stream) next; (* We don't do 76 here as they're in blocks of 4. *) Some (encode_chunk next ^ - (if (((cnt + 1) mod 19) = 0) then "\013\n" else "")) - ) + (if (((cnt + 1) mod 19) = 0) then "\013\n" else "")) + ) - (** Get a Stream of encoded data from the given stream of data. *) +(** Get a Stream of encoded data from the given stream of data. *) let encode data_stream = Stream.from (encode_stream_chunk data_stream) - (** Base64 encode the string data into a base64 encoded string. *) +(** Base64 encode the string data into a base64 encoded string. *) let encode_to_string data_stream = let buf = Buffer.create 512 in Stream.iter (fun c -> Buffer.add_string buf c) (encode data_stream); Buffer.contents buf - (** Base64 encode a string *) +(** Base64 encode a string *) let encode_string s = encode_to_string (Stream.of_string s) (* ---------------------------------------------------------------------- *) - (** - Functions for decoding - *) +(** + Functions for decoding +*) - (** Exception raised when there's a problem with the input stream. *) +(** Exception raised when there's a problem with the input stream. *) exception Invalid_decode_chunk of int - (** Reverse mapping of character to its index in the char_map *) +(** Reverse mapping of character to its index in the char_map *) let char_index = let rv = Array.make 256 (-1) in @@ -130,34 +130,34 @@ let char_index = done; rv - (** Is the given character a valid base64 character? *) +(** Is the given character a valid base64 character? *) let is_base64_char c = char_index.(Char.code c) != -1 - (** Decode a chunk represented as a list of characters. The chunk must be 2, 3, or 4 elements large. *) +(** Decode a chunk represented as a list of characters. The chunk must be 2, 3, or 4 elements large. *) let decode_chunk chars = let rv = Buffer.create 3 in let fchars = (List.filter (fun c -> c != '=') chars) in let packer = List.fold_left (fun o x -> (o lsl 6) lor x) 0 - (List.map (fun c -> char_index.(Char.code c)) fchars) in + (List.map (fun c -> char_index.(Char.code c)) fchars) in ( - match List.length fchars with - | 4 -> - Buffer.add_char rv (Char.chr (0xff land (packer lsr 16))); - Buffer.add_char rv (Char.chr (0xff land (packer lsr 8))); - Buffer.add_char rv (Char.chr (0xff land packer)); - | 3 -> - Buffer.add_char rv (Char.chr (0xff land ((packer lsl 6) lsr 16))); - Buffer.add_char rv (Char.chr (0xff land ((packer lsl 6) lsr 8))); - | 2 -> - Buffer.add_char rv (Char.chr (0xff land ((packer lsl 12) lsr 16))); - | _ -> raise (Invalid_decode_chunk(List.length fchars)); + match List.length fchars with + | 4 -> + Buffer.add_char rv (Char.chr (0xff land (packer lsr 16))); + Buffer.add_char rv (Char.chr (0xff land (packer lsr 8))); + Buffer.add_char rv (Char.chr (0xff land packer)); + | 3 -> + Buffer.add_char rv (Char.chr (0xff land ((packer lsl 6) lsr 16))); + Buffer.add_char rv (Char.chr (0xff land ((packer lsl 6) lsr 8))); + | 2 -> + Buffer.add_char rv (Char.chr (0xff land ((packer lsl 12) lsr 16))); + | _ -> raise (Invalid_decode_chunk(List.length fchars)); ); Buffer.contents rv - (** Decode a stream of base64 characters into a stream of 3 or fewer byte strings. *) +(** Decode a stream of base64 characters into a stream of 3 or fewer byte strings. *) let decode data_stream = let rec find_next x = @@ -169,35 +169,35 @@ let decode data_stream = if (is_base64_char(rv)) then Some rv else (find_next x) - ) in + ) in let clean_stream = Stream.from find_next in let get_block x = try let chunk = Stream.npeek 4 clean_stream in List.iter (fun x -> Stream.junk clean_stream) chunk; match chunk with - [] -> None - | _ -> Some(decode_chunk chunk) + [] -> None + | _ -> Some(decode_chunk chunk) with Stream.Failure -> None in Stream.from get_block - (** Base64 decode the stream of base64 encoded data into a string. *) +(** Base64 decode the stream of base64 encoded data into a string. *) let decode_to_string data_stream = let buf = Buffer.create 512 in Stream.iter (fun c -> Buffer.add_string buf c) (decode data_stream); Buffer.contents buf - (** Base64 decode a string to a string *) +(** Base64 decode a string to a string *) let decode_string s = decode_to_string (Stream.of_string s) - (** - Functions for testing - *) +(** + Functions for testing +*) - (** Simple test function. *) +(** Simple test function. *) let test() = let wordlist = ["A";"AB";"ABC";"Dustin";String.create 128] in @@ -208,7 +208,7 @@ let test() = List.iter (fun x -> Stream.iter print_string (encode (Stream.of_string x)); print_newline() - ) wordlist; + ) wordlist; print_endline("Decode:"); List.iter (fun x -> print_endline(decode_string (encode_string x))) wordlist diff --git a/sw/lib/ocaml/debug.ml b/sw/lib/ocaml/debug.ml index f92da81da0..2367497663 100644 --- a/sw/lib/ocaml/debug.ml +++ b/sw/lib/ocaml/debug.ml @@ -1,4 +1,4 @@ - (* +(* * Debugging facilities * * Copyright (C) 2004 CENA/ENAC, Pascal Brisset, Antoine Drouin @@ -26,12 +26,12 @@ let level = ref (try Sys.getenv "PPRZ_DEBUG" with Not_found -> "") let log = ref stderr let call lev f = assert( (* assert permet au compilo de tout virer avec l'option -noassert *) - if (String.contains !level '*' || String.contains !level lev) - then begin - f !log; - flush !log - end; - true) + if (String.contains !level '*' || String.contains !level lev) + then begin + f !log; + flush !log + end; + true) let trace lev s = call lev (fun f -> Printf.fprintf f "%s\n" s) diff --git a/sw/lib/ocaml/defivybus.ml b/sw/lib/ocaml/defivybus.ml index 9ef648f1ee..b87b0a1e4d 100644 --- a/sw/lib/ocaml/defivybus.ml +++ b/sw/lib/ocaml/defivybus.ml @@ -23,8 +23,8 @@ *) let default_ivy_bus = String.copy ( try (Sys.getenv "IVY_BUS" ) - with Not_found -> - (if Os_calls.contains (Os_calls.os_name) "Darwin" then + with Not_found -> + (if Os_calls.contains (Os_calls.os_name) "Darwin" then "224.255.255.255:2010" - else + else "127.255.255.255:2010")) diff --git a/sw/lib/ocaml/editAirframe.ml b/sw/lib/ocaml/editAirframe.ml index 22a34b4489..989df21640 100644 --- a/sw/lib/ocaml/editAirframe.ml +++ b/sw/lib/ocaml/editAirframe.ml @@ -30,29 +30,29 @@ exception No_param of string let get = fun xml param -> let rec iter_get prefix xml = - match xml with - Nethtml.Element ("define", params, children) - when List.exists (fun (p, v) -> p = "name" && (prefix^v) = param) params -> - let old_val = snd (List.find (fun (p, v) -> p = "value") params) - and units = - try Some (snd (List.find (fun (p, v) -> p = "unit") params)) - with Not_found -> None - and code_units = - try Some (snd (List.find (fun (p, v) -> p = "code_unit") params)) - with Not_found -> None - in - raise (Got_it (old_val, units, code_units)) - | Nethtml.Element (block, params, children) -> - let new_prefix = - List.fold_left (fun acc (p, v) -> if p = "prefix" then v^acc else acc) prefix params in - List.iter (iter_get new_prefix) children - | Nethtml.Data s -> () + match xml with + Nethtml.Element ("define", params, children) + when List.exists (fun (p, v) -> p = "name" && (prefix^v) = param) params -> + let old_val = snd (List.find (fun (p, v) -> p = "value") params) + and units = + try Some (snd (List.find (fun (p, v) -> p = "unit") params)) + with Not_found -> None + and code_units = + try Some (snd (List.find (fun (p, v) -> p = "code_unit") params)) + with Not_found -> None + in + raise (Got_it (old_val, units, code_units)) + | Nethtml.Element (block, params, children) -> + let new_prefix = + List.fold_left (fun acc (p, v) -> if p = "prefix" then v^acc else acc) prefix params in + List.iter (iter_get new_prefix) children + | Nethtml.Data s -> () in try iter_get "" xml; raise (No_param param) with - Got_it result -> result + Got_it result -> result @@ -61,13 +61,13 @@ let set = fun xml param newval -> let update_param params = List.map (fun (p, v) -> if p = "value" then (p, newval) else (p, v)) params in match xml with - Nethtml.Element ("define", params, children) - when List.exists (fun (p, v) -> p = "name" && (prefix^v) = param) params -> - Nethtml.Element ("define", update_param params, children) - | Nethtml.Element (block, params, children) -> - let new_prefix = - List.fold_left (fun acc (p, v) -> if p = "prefix" then v^acc else acc) prefix params in - Nethtml.Element (block, params, List.map (iter_replace new_prefix) children) - | Nethtml.Data s -> Nethtml.Data s + Nethtml.Element ("define", params, children) + when List.exists (fun (p, v) -> p = "name" && (prefix^v) = param) params -> + Nethtml.Element ("define", update_param params, children) + | Nethtml.Element (block, params, children) -> + let new_prefix = + List.fold_left (fun acc (p, v) -> if p = "prefix" then v^acc else acc) prefix params in + Nethtml.Element (block, params, List.map (iter_replace new_prefix) children) + | Nethtml.Data s -> Nethtml.Data s in iter_replace "" xml diff --git a/sw/lib/ocaml/env.ml b/sw/lib/ocaml/env.ml index c2e4ab1c5d..cf98beaed2 100644 --- a/sw/lib/ocaml/env.ml +++ b/sw/lib/ocaml/env.ml @@ -32,13 +32,13 @@ let paparazzi_src = try Sys.getenv "PAPARAZZI_SRC" with - _ -> "/usr/share/paparazzi" + _ -> "/usr/share/paparazzi" let paparazzi_home = try Sys.getenv "PAPARAZZI_HOME" with - _ -> Filename.concat (Sys.getenv "HOME") "paparazzi" + _ -> Filename.concat (Sys.getenv "HOME") "paparazzi" let flight_plans_path = paparazzi_home // "conf" // "flight_plans" @@ -59,13 +59,13 @@ let expand_ac_xml = fun ?(raise_exception = true) ac_conf -> try ExtXml.parse_file file with - Failure msg -> - if raise_exception then - failwith msg - else begin - prerr_endline msg; - make_element "parse error" ["file",a; "msg", msg] [] - end in + Failure msg -> + if raise_exception then + failwith msg + else begin + prerr_endline msg; + make_element "parse error" ["file",a; "msg", msg] [] + end in let parse = fun a -> List.map diff --git a/sw/lib/ocaml/expr_syntax.ml b/sw/lib/ocaml/expr_syntax.ml index 22571d48fd..d94a1cfe71 100644 --- a/sw/lib/ocaml/expr_syntax.ml +++ b/sw/lib/ocaml/expr_syntax.ml @@ -40,18 +40,18 @@ type expression = let c_var_of_ident = fun x -> "_var_" ^ x let rec sprint = function - Ident i when i.[0] = '$' -> sprintf "%s" (c_var_of_ident (String.sub i 1 (String.length i - 1))) +Ident i when i.[0] = '$' -> sprintf "%s" (c_var_of_ident (String.sub i 1 (String.length i - 1))) | Ident i -> sprintf "%s" i | Int i -> sprintf "%d" i | Float i -> sprintf "%f" i | CallOperator (op, [e1;e2]) -> - sprintf "(%s%s%s)" (sprint e1) op (sprint e2) + sprintf "(%s%s%s)" (sprint e1) op (sprint e2) | CallOperator (op, [e1]) -> - sprintf "%s(%s)" op (sprint e1) + sprintf "%s(%s)" op (sprint e1) | CallOperator (_,_) -> failwith "Operator should be binary or unary" | Call (i, es) -> - let ses = List.map sprint es in - sprintf "%s(%s)" i (String.concat "," ses) + let ses = List.map sprint es in + sprintf "%s(%s)" i (String.concat "," ses) | Index (i,e) -> sprintf "%s[%s]" i (sprint e) | Field (i,f) -> sprintf "%s.%s" i f | Deref (e,f) -> sprintf "(%s)->%s" (sprint e) f @@ -97,21 +97,21 @@ let unexpected = fun kind x -> let rec check_expression = fun e -> match e with - Ident i when i.[0] = '$' -> () - | Ident i -> + Ident i when i.[0] = '$' -> () + | Ident i -> if not (List.mem i variables) then - unexpected "ident" i - | Int _ | Float _ | CallOperator _ -> () - | Call (i, es) -> + unexpected "ident" i + | Int _ | Float _ | CallOperator _ -> () + | Call (i, es) -> if not (List.mem i functions) then - unexpected "function" i; + unexpected "function" i; List.iter check_expression es - | Index (i,e) -> + | Index (i,e) -> if not (List.mem i variables) then - unexpected "ident" i; + unexpected "ident" i; check_expression e - | Field (i, _field) -> + | Field (i, _field) -> if not (List.mem i variables) then - unexpected "ident" i - | Deref (e, _field) -> + unexpected "ident" i + | Deref (e, _field) -> check_expression e diff --git a/sw/lib/ocaml/extXml.ml b/sw/lib/ocaml/extXml.ml index 5058c2043c..cc9489876a 100644 --- a/sw/lib/ocaml/extXml.ml +++ b/sw/lib/ocaml/extXml.ml @@ -30,14 +30,14 @@ let sep = Str.regexp "\\." let child xml ?select c = let rec find = function - Xml.Element (tag, _attributes, _children) as elt :: elts -> - if tag = c then - match select with - None -> elt - | Some p -> - if p elt then elt else find elts - else - find elts + Xml.Element (tag, _attributes, _children) as elt :: elts -> + if tag = c then + match select with + None -> elt + | Some p -> + if p elt then elt else find elts + else + find elts | _ :: elts -> find elts | [] -> raise Not_found in @@ -46,14 +46,14 @@ let child xml ?select c = (* Let's try with a numeric index *) try (Array.of_list children).(int_of_string c) with - Failure "int_of_string" -> (* Bad luck. Go through the children *) - find children + Failure "int_of_string" -> (* Bad luck. Go through the children *) + find children let get xml path = let p = Str.split sep path in let rec iter xml = function - [] -> failwith "ExtXml.get: empty path" + [] -> failwith "ExtXml.get: empty path" | [x] -> ( try if Xml.tag xml <> x then raise Not_found else xml with _ -> raise Not_found ) | x::xs -> iter (child xml x) xs in iter xml p @@ -63,14 +63,14 @@ let get_attrib xml path attr = let sprint_fields = fun () l -> "<"^ - List.fold_right (fun (a, b) -> (^) (Printf.sprintf "%s=\"%s\" " a b)) l ">" + List.fold_right (fun (a, b) -> (^) (Printf.sprintf "%s=\"%s\" " a b)) l ">" let attrib = fun x a -> try Xml.attrib x a with - Xml.No_attribute _ -> - raise (Error (Printf.sprintf "Error: Attribute '%s' expected in <%a>" a sprint_fields (Xml.attribs x))) + Xml.No_attribute _ -> + raise (Error (Printf.sprintf "Error: Attribute '%s' expected in <%a>" a sprint_fields (Xml.attribs x))) let tag_is = fun x v -> String.lowercase (Xml.tag x) = String.lowercase v @@ -92,52 +92,52 @@ let buffer_attr = fun indent tab (n,v) -> let l = String.length v in for p = 0 to l-1 do match v.[p] with - | '\\' -> Buffer.add_string tmp "\\\\" - | '"' -> Buffer.add_string tmp "\\\"" + | '\\' -> Buffer.add_string tmp "\\\\" + | '"' -> Buffer.add_string tmp "\\\"" | c -> Buffer.add_char tmp c done; Buffer.add_char tmp '"'; - if indent then - Buffer.add_char tmp '\n' + if indent then + Buffer.add_char tmp '\n' let buffer_pcdata = Buffer.add_string tmp let my_to_string_fmt = fun tab_attribs x -> let rec loop ?(newl=false) tab = function | Xml.Element (tag,alist,[]) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - if tab_attribs then Buffer.add_char tmp '\n'; - List.iter (buffer_attr tab_attribs tab) alist; - if tab_attribs then Buffer.add_string tmp tab; - Buffer.add_string tmp "/>"; - if newl then Buffer.add_char tmp '\n'; + Buffer.add_string tmp tab; + Buffer.add_char tmp '<'; + Buffer.add_string tmp tag; + if tab_attribs then Buffer.add_char tmp '\n'; + List.iter (buffer_attr tab_attribs tab) alist; + if tab_attribs then Buffer.add_string tmp tab; + Buffer.add_string tmp "/>"; + if newl then Buffer.add_char tmp '\n'; | Xml.Element (tag,alist,[Xml.PCData text]) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter (buffer_attr tab_attribs tab) alist; - Buffer.add_string tmp ">"; - buffer_pcdata text; - Buffer.add_string tmp "'; - if newl then Buffer.add_char tmp '\n'; + Buffer.add_string tmp tab; + Buffer.add_char tmp '<'; + Buffer.add_string tmp tag; + List.iter (buffer_attr tab_attribs tab) alist; + Buffer.add_string tmp ">"; + buffer_pcdata text; + Buffer.add_string tmp "'; + if newl then Buffer.add_char tmp '\n'; | Xml.Element (tag,alist,l) -> - Buffer.add_string tmp tab; - Buffer.add_char tmp '<'; - Buffer.add_string tmp tag; - List.iter (buffer_attr tab_attribs tab) alist; - Buffer.add_string tmp ">\n"; - List.iter (loop ~newl:true (tab^" ")) l; - Buffer.add_string tmp tab; - Buffer.add_string tmp "'; - if newl then Buffer.add_char tmp '\n'; + Buffer.add_string tmp tab; + Buffer.add_char tmp '<'; + Buffer.add_string tmp tag; + List.iter (buffer_attr tab_attribs tab) alist; + Buffer.add_string tmp ">\n"; + List.iter (loop ~newl:true (tab^" ")) l; + Buffer.add_string tmp tab; + Buffer.add_string tmp "'; + if newl then Buffer.add_char tmp '\n'; | Xml.PCData text -> - buffer_pcdata text; - if newl then Buffer.add_char tmp '\n'; + buffer_pcdata text; + if newl then Buffer.add_char tmp '\n'; in Buffer.reset tmp; loop "" x; @@ -150,11 +150,11 @@ let my_to_string_fmt = fun tab_attribs x -> let to_string_fmt = fun ?(tab_attribs = false) xml -> let l = String.lowercase in let rec lower = function - Xml.PCData _ as x -> x + Xml.PCData _ as x -> x | Xml.Element (t, ats, cs) -> - Xml.Element(l t, - List.map (fun (a,v) -> (l a, v)) ats, - List.map lower cs) in + Xml.Element(l t, + List.map (fun (a,v) -> (l a, v)) ats, + List.map lower cs) in my_to_string_fmt tab_attribs (lower xml) @@ -162,47 +162,47 @@ let subst_attrib = fun attrib value xml -> let u = String.uppercase in let uattrib = u attrib in match xml with - Xml.Element (tag, attrs, children) -> - let rec loop = function - [] -> [(attrib, value)] - | (a,_v) as c::ats -> - if u a = uattrib then loop ats else c::loop ats in - Xml.Element (tag, - loop attrs, - children) - | Xml.PCData _ -> xml + Xml.Element (tag, attrs, children) -> + let rec loop = function + [] -> [(attrib, value)] + | (a,_v) as c::ats -> + if u a = uattrib then loop ats else c::loop ats in + Xml.Element (tag, + loop attrs, + children) + | Xml.PCData _ -> xml let subst_child = fun ?(select= fun _ -> true) t x xml -> match xml with - Xml.Element (tag, attrs, children) -> - let found = ref false in - let new_children = - List.map - (fun xml -> if tag_is xml t && select xml then (found := true; x) else xml) - children in - if !found then - Xml.Element (tag, attrs, new_children) - else - raise Not_found - | Xml.PCData _ -> xml + Xml.Element (tag, attrs, children) -> + let found = ref false in + let new_children = + List.map + (fun xml -> if tag_is xml t && select xml then (found := true; x) else xml) + children in + if !found then + Xml.Element (tag, attrs, new_children) + else + raise Not_found + | Xml.PCData _ -> xml let subst_or_add_child = fun t x xml -> try subst_child t x xml with Not_found -> match xml with - Xml.Element (tag, attrs, children) -> - Xml.Element (tag, attrs, x::children) - | Xml.PCData _ -> xml + Xml.Element (tag, attrs, children) -> + Xml.Element (tag, attrs, x::children) + | Xml.PCData _ -> xml let remove_child = fun ?(select= fun _ -> true) t xml -> match xml with - Xml.Element (tag, attrs, children) -> - Xml.Element (tag, - attrs, - List.fold_right (fun xml rest -> if tag_is xml t && select xml then rest else xml::rest) children []) - | Xml.PCData _ -> xml + Xml.Element (tag, attrs, children) -> + Xml.Element (tag, + attrs, + List.fold_right (fun xml rest -> if tag_is xml t && select xml then rest else xml::rest) children []) + | Xml.PCData _ -> xml let float_attrib = fun xml a -> @@ -210,19 +210,19 @@ let float_attrib = fun xml a -> try float_of_string v with - _ -> failwith (Printf.sprintf "Error: float expected in '%s'" v) + _ -> failwith (Printf.sprintf "Error: float expected in '%s'" v) let int_attrib = fun xml a -> let v = attrib xml a in try int_of_string v with - _ -> failwith (Printf.sprintf "Error: integer expected in '%s'" v) + _ -> failwith (Printf.sprintf "Error: integer expected in '%s'" v) (* When an .xml is coming through http, the dtd is not available. We disable -the DTD proving feature in this case. FIXME: We should use the resolve -feature *) + the DTD proving feature in this case. FIXME: We should use the resolve + feature *) let my_xml_parse_file = let parser = XmlParser.make () in XmlParser.prove parser false; @@ -234,11 +234,11 @@ let parse_file = fun ?(noprovedtd = false) file -> try (if noprovedtd then my_xml_parse_file else Xml.parse_file) file with - Xml.Error e -> failwith (sprintf "%s: %s" file (Xml.error e)) - | Xml.File_not_found f -> failwith (sprintf "File not found: %s" f) - | Dtd.Prove_error e -> failwith (sprintf "%s: %s" file (Dtd.prove_error e)) - | Dtd.Check_error e -> failwith (sprintf "%s: %s" file (Dtd.check_error e)) - | Dtd.Parse_error e -> failwith (sprintf "%s: %s" file (Dtd.parse_error e)) + Xml.Error e -> failwith (sprintf "%s: %s" file (Xml.error e)) + | Xml.File_not_found f -> failwith (sprintf "File not found: %s" f) + | Dtd.Prove_error e -> failwith (sprintf "%s: %s" file (Dtd.prove_error e)) + | Dtd.Check_error e -> failwith (sprintf "%s: %s" file (Dtd.check_error e)) + | Dtd.Parse_error e -> failwith (sprintf "%s: %s" file (Dtd.parse_error e)) @@ -262,9 +262,9 @@ module Gconf = struct let entry = fun application name value -> Xml.Element ("entry", ["name", name; - "value", value; - "application", application], - []) + "value", value; + "application", application], + []) let add_entry = fun xml appli name value -> let entry = entry appli name value in diff --git a/sw/lib/ocaml/fig.ml b/sw/lib/ocaml/fig.ml index 7976f0d124..36d60f562c 100644 --- a/sw/lib/ocaml/fig.ml +++ b/sw/lib/ocaml/fig.ml @@ -49,15 +49,15 @@ let cap_style_of_int = Obj.magic type polyline = Polyline | Box | Polygon | ArcBox | PictureBB of int*string let int_of_polyline = function - Polyline -> 1 | Box -> 2 | Polygon -> 3 | ArcBox -> 4 | PictureBB _ -> 5 +Polyline -> 1 | Box -> 2 | Polygon -> 3 | ArcBox -> 4 | PictureBB _ -> 5 let polyline_of_int = fun ?(flipped=0) ?(pict="") i -> match i with - 1 -> Polyline - | 2 -> Box - | 3 -> Polygon - | 4 -> ArcBox - | 5 -> PictureBB (flipped, pict) - | _ -> invalid_arg "polyline_of_int" + 1 -> Polyline + | 2 -> Box + | 3 -> Polygon + | 4 -> ArcBox + | 5 -> PictureBB (flipped, pict) + | _ -> invalid_arg "polyline_of_int" type arc = Open | Closed let int_of_arc x = Obj.magic x + 1 @@ -65,14 +65,14 @@ let arc_of_int x = Obj.magic (x - 1) type spline = Approximated | Interpolated | XSpline let int_of_spline = function - (Open, Approximated) -> 0 +(Open, Approximated) -> 0 | (Closed, Approximated) -> 1 | (Open, Interpolated) -> 2 | (Closed, Interpolated) -> 3 | (Open, XSpline) -> 4 | (Closed, XSpline) -> 5 let spline_of_int = function - 0 -> (Open, Approximated) +0 -> (Open, Approximated) | 1 -> (Closed, Approximated) | 2 -> (Open, Interpolated) | 3-> (Closed, Interpolated) @@ -86,12 +86,12 @@ let ellipse_of_int x = (Obj.magic (x-1) : ellipse) type arrow = { - arrow_type: int; - arrow_style: int; - arrow_thickness: float; - arrow_width: float; - arrow_height: float - } + arrow_type: int; + arrow_style: int; + arrow_thickness: float; + arrow_width: float; + arrow_height: float +} type depth = int @@ -171,7 +171,7 @@ type latex_font = type font = Postscript of postscript_font | Latex of latex_font let int_of_font = function - Postscript f -> Obj.magic f +Postscript f -> Obj.magic f | Latex f -> Obj.magic f let font_of_int ps i = @@ -196,37 +196,37 @@ type papersize = string type multiple_page = Single | Multiple let string_of_orientation = function - Landscape -> "Landscape" | Portrait -> "Portrait" +Landscape -> "Landscape" | Portrait -> "Portrait" let string_of_just = function - Center -> "Center" | FlushLeft -> "FlushLeft" +Center -> "Center" | FlushLeft -> "FlushLeft" let string_of_units_name = function - Metric -> "Metric" | Inches -> "Inches" +Metric -> "Metric" | Inches -> "Inches" let string_of_multiple_page = function - Single -> "Single" | Multiple -> "Multiple" +Single -> "Single" | Multiple -> "Multiple" let orientation_of_string = function - "Landscape" -> Landscape | "Portrait" -> Portrait | _ -> invalid_arg "orientation_of_string" +"Landscape" -> Landscape | "Portrait" -> Portrait | _ -> invalid_arg "orientation_of_string" let just_of_string = function - "Center" -> Center | "Flush Left" -> FlushLeft | "Flush left" -> FlushLeft | _ -> invalid_arg "just_of_string" +"Center" -> Center | "Flush Left" -> FlushLeft | "Flush left" -> FlushLeft | _ -> invalid_arg "just_of_string" let units_name_of_string = function - "Metric" -> Metric | "Inches" -> Inches | _ -> invalid_arg "units_name_of_string" +"Metric" -> Metric | "Inches" -> Inches | _ -> invalid_arg "units_name_of_string" let multiple_page_of_string = function - "Single" -> Single | "Multiple" -> Multiple | _ -> invalid_arg "multiple_page_of_string" +"Single" -> Single | "Multiple" -> Multiple | _ -> invalid_arg "multiple_page_of_string" type t = { - version : string; - orientation : orientation; - justification : just; - units : units_name; - papersize : papersize; - magnification : float; - multiple_page : multiple_page; - transparent_color : int; - comments : string list; - resolution : units * int; - body : fig_object list - } + version : string; + orientation : orientation; + justification : just; + units : units_name; + papersize : papersize; + magnification : float; + multiple_page : multiple_page; + transparent_color : int; + comments : string list; + resolution : units * int; + body : fig_object list +} let black = 0 let blue = 1 @@ -247,7 +247,7 @@ let color = fun ?number r g b -> short b; let n = match number with - None -> incr user_color; !user_color + None -> incr user_color; !user_color | Some x -> x in if n < 32 || n > 543 then invalid_arg "Fig.color: color number out of bound"; (n, (["User color"], UserColor (n, (r, g, b)))) @@ -268,8 +268,8 @@ let one = fun x -> if x = None then 0 else 1 let arrow = fun f x -> match x with - None -> () - | Some t -> fprintf f "\t%d %d %.2f %.2f %.2f\n" t.arrow_type t.arrow_style t.arrow_thickness t.arrow_width t.arrow_height + None -> () + | Some t -> fprintf f "\t%d %d %.2f %.2f %.2f\n" t.arrow_type t.arrow_style t.arrow_thickness t.arrow_width t.arrow_height let point = fun f (x,y) -> fprintf f " %d %d" x y @@ -278,183 +278,183 @@ let comment = fun lines (c, o) -> (c @ lines, o) (* Environment *) let create = fun ?(comments = ["Generated by fig.ml"]) - ?(orientation = Landscape) - ?(justification = Center) - ?(units = Metric) - ?(papersize = "A4") - ?(magnification = 100.0) - ?(multiple_page = Single) - ?(transparent_color = -2) - ?(resolution=(1200,2)) - objects -> - { version = "3.2"; - orientation = orientation; - justification = justification; - units = units; - papersize = papersize; - magnification = magnification; - multiple_page = multiple_page; - transparent_color = transparent_color; - comments = comments; - resolution = resolution; - body = objects } + ?(orientation = Landscape) + ?(justification = Center) + ?(units = Metric) + ?(papersize = "A4") + ?(magnification = 100.0) + ?(multiple_page = Single) + ?(transparent_color = -2) + ?(resolution=(1200,2)) + objects -> + { version = "3.2"; + orientation = orientation; + justification = justification; + units = units; + papersize = papersize; + magnification = magnification; + multiple_page = multiple_page; + transparent_color = transparent_color; + comments = comments; + resolution = resolution; + body = objects } (* Polyline *) let polyline = fun - ?(sub_type = Polyline) - ?(line_style = Solid) - ?(thickness = 1) - ?(pen_color = black) - ?(fill_color = white) - ?(depth = 50) - ?(area_fill = -1) - ?(style_val = 4.0) - ?(join_style = Miter) - ?(cap_style = Butt) - ?(radius = 7) - ?forward_arrow - ?backward_arrow - list -> - let list = (* Checking and fixing nb of points *) - match sub_type, list with - Polyline, _::_ -> list - | Polygon, first::rest -> - if List.hd (List.rev list) <> first then begin - prerr_endline "Fig.polyline: closing Polygon"; - list @ [first] - end else - list - | _box, [(x0,y0);(x1, y1)] -> (* Opposed corners *) - [(x0,y0);(x1, y0);(x1,y1);(x0,y1);(x0,y0)] - | _ -> invalid_arg "Fig.polyline" - in - let attributes = { - line_style = line_style; - line_thickness = thickness; - pen_color = pen_color; - fill_color = fill_color; - depth = depth; - area_fill = area_fill; - style_val = style_val; - cap_style = cap_style; - forward_arrow = forward_arrow; - backward_arrow = backward_arrow - } in + ?(sub_type = Polyline) + ?(line_style = Solid) + ?(thickness = 1) + ?(pen_color = black) + ?(fill_color = white) + ?(depth = 50) + ?(area_fill = -1) + ?(style_val = 4.0) + ?(join_style = Miter) + ?(cap_style = Butt) + ?(radius = 7) + ?forward_arrow + ?backward_arrow + list -> + let list = (* Checking and fixing nb of points *) + match sub_type, list with + Polyline, _::_ -> list + | Polygon, first::rest -> + if List.hd (List.rev list) <> first then begin + prerr_endline "Fig.polyline: closing Polygon"; + list @ [first] + end else + list + | _box, [(x0,y0);(x1, y1)] -> (* Opposed corners *) + [(x0,y0);(x1, y0);(x1,y1);(x0,y1);(x0,y0)] + | _ -> invalid_arg "Fig.polyline" + in + let attributes = { + line_style = line_style; + line_thickness = thickness; + pen_color = pen_color; + fill_color = fill_color; + depth = depth; + area_fill = area_fill; + style_val = style_val; + cap_style = cap_style; + forward_arrow = forward_arrow; + backward_arrow = backward_arrow + } in - (["Polyline"], GrObj (attributes, Polylines (sub_type, join_style, (if sub_type = ArcBox then radius else -1), list))) + (["Polyline"], GrObj (attributes, Polylines (sub_type, join_style, (if sub_type = ArcBox then radius else -1), list))) (* Arc *) let arc = fun - ?(sub_type = Open) - ?(line_style = Solid) - ?(thickness = 1) - ?(pen_color = black) - ?(fill_color = white) - ?(depth = 50) - ?(area_fill = -1) - ?(style_val = 0.0) - ?(cap_style = Butt) - ?forward_arrow - ?backward_arrow - (center_x, center_y) radius alpha1 alpha2 -> - let attributes = { - line_style = line_style; - line_thickness = thickness; - pen_color = pen_color; - fill_color = fill_color; - depth = depth; - area_fill = area_fill; - style_val = style_val; - cap_style = cap_style; - forward_arrow = forward_arrow; - backward_arrow = backward_arrow - } in - let direction = if alpha2 >0. then Clockwise else CounterClockwise in - let p1 = (int_of_float (center_x +. (radius *. cos alpha1)), - int_of_float (center_y +. (radius *. sin alpha1))) - and p2 = (int_of_float (center_x +. (radius *. cos (alpha1+.alpha2/.2.))), - int_of_float (center_y +. (radius *. sin (alpha1+.alpha2/.2.)))) - and p3 = (int_of_float (center_x +. (radius *. cos (alpha1+.alpha2))), - int_of_float (center_y +. (radius *. sin (alpha1+.alpha2)))) in - (["Arc"], GrObj (attributes, Arc (sub_type, direction, (center_x, center_y), p1, p2, p3))) + ?(sub_type = Open) + ?(line_style = Solid) + ?(thickness = 1) + ?(pen_color = black) + ?(fill_color = white) + ?(depth = 50) + ?(area_fill = -1) + ?(style_val = 0.0) + ?(cap_style = Butt) + ?forward_arrow + ?backward_arrow + (center_x, center_y) radius alpha1 alpha2 -> + let attributes = { + line_style = line_style; + line_thickness = thickness; + pen_color = pen_color; + fill_color = fill_color; + depth = depth; + area_fill = area_fill; + style_val = style_val; + cap_style = cap_style; + forward_arrow = forward_arrow; + backward_arrow = backward_arrow + } in + let direction = if alpha2 >0. then Clockwise else CounterClockwise in + let p1 = (int_of_float (center_x +. (radius *. cos alpha1)), + int_of_float (center_y +. (radius *. sin alpha1))) + and p2 = (int_of_float (center_x +. (radius *. cos (alpha1+.alpha2/.2.))), + int_of_float (center_y +. (radius *. sin (alpha1+.alpha2/.2.)))) + and p3 = (int_of_float (center_x +. (radius *. cos (alpha1+.alpha2))), + int_of_float (center_y +. (radius *. sin (alpha1+.alpha2)))) in + (["Arc"], GrObj (attributes, Arc (sub_type, direction, (center_x, center_y), p1, p2, p3))) (* Ellipse *) let ellipse = fun - ?(line_style = Solid) - ?(thickness = 1) - ?(pen_color = black) - ?(fill_color = white) - ?(depth = 50) - ?(area_fill = -1) - ?(style_val = 0.0) - ?(direction = Clockwise) - ?(angle = 0.0) - (center_x, center_y) radius_x radius_y -> - let attributes = { - line_style = line_style; - line_thickness = thickness; - pen_color = pen_color; - fill_color = fill_color; - depth = depth; - area_fill = area_fill; - style_val = style_val; - cap_style = Butt; (* Unused *) - forward_arrow = None; - backward_arrow = None - } in - (["Ellipse"], GrObj (attributes, Ellipse (EllipseRadius, direction, angle, (center_x, center_y), radius_x, radius_y, (center_x, center_y), (center_x + radius_x, center_y + radius_y)))) + ?(line_style = Solid) + ?(thickness = 1) + ?(pen_color = black) + ?(fill_color = white) + ?(depth = 50) + ?(area_fill = -1) + ?(style_val = 0.0) + ?(direction = Clockwise) + ?(angle = 0.0) + (center_x, center_y) radius_x radius_y -> + let attributes = { + line_style = line_style; + line_thickness = thickness; + pen_color = pen_color; + fill_color = fill_color; + depth = depth; + area_fill = area_fill; + style_val = style_val; + cap_style = Butt; (* Unused *) + forward_arrow = None; + backward_arrow = None + } in + (["Ellipse"], GrObj (attributes, Ellipse (EllipseRadius, direction, angle, (center_x, center_y), radius_x, radius_y, (center_x, center_y), (center_x + radius_x, center_y + radius_y)))) let factors = fun points spline -> let _f = match spline with (_, Interpolated) -> -1.0 | _ -> 1.0 in let rec loop = function - [] -> [] + [] -> [] | [_] -> [0.] | _ :: xs -> -1. :: loop xs in match points with - [] -> [] - | _ :: xs -> 0. :: loop xs + [] -> [] + | _ :: xs -> 0. :: loop xs (* Spline *) let spline = fun - ?(sub_type = Open, Approximated) - ?(line_style = Solid) - ?(thickness = 1) - ?(pen_color = black) - ?(fill_color = white) - ?(depth = 50) - ?(area_fill = -1) - ?(style_val = 0.0) - ?(cap_style = Butt) - ?forward_arrow - ?backward_arrow - list -> - let list = (* Checking and fixing nb of points *) - match fst sub_type, list with - Open, _::_ -> list - | Closed, first::rest -> - if List.hd (List.rev list) <> first then begin - prerr_endline "Fig.spline: closing spline"; - list @ [first] - end else - list - | _ -> invalid_arg "Fig.spline" - in - let attributes = { - line_style = line_style; - line_thickness = thickness; - pen_color = pen_color; - fill_color = fill_color; - depth = depth; - area_fill = area_fill; - style_val = style_val; - cap_style = cap_style; - forward_arrow = forward_arrow; - backward_arrow = backward_arrow - } in - (["Spline"], GrObj (attributes, Spline (sub_type, list, factors list sub_type))) + ?(sub_type = Open, Approximated) + ?(line_style = Solid) + ?(thickness = 1) + ?(pen_color = black) + ?(fill_color = white) + ?(depth = 50) + ?(area_fill = -1) + ?(style_val = 0.0) + ?(cap_style = Butt) + ?forward_arrow + ?backward_arrow + list -> + let list = (* Checking and fixing nb of points *) + match fst sub_type, list with + Open, _::_ -> list + | Closed, first::rest -> + if List.hd (List.rev list) <> first then begin + prerr_endline "Fig.spline: closing spline"; + list @ [first] + end else + list + | _ -> invalid_arg "Fig.spline" + in + let attributes = { + line_style = line_style; + line_thickness = thickness; + pen_color = pen_color; + fill_color = fill_color; + depth = depth; + area_fill = area_fill; + style_val = style_val; + cap_style = cap_style; + forward_arrow = forward_arrow; + backward_arrow = backward_arrow + } in + (["Spline"], GrObj (attributes, Spline (sub_type, list, factors list sub_type))) (* Text *) let bit x d = @@ -474,19 +474,19 @@ let code_string = fun f s -> done let text = fun - ?(sub_type = LeftJustified) - ?(color = black) - ?(depth = 50) - ?(font = Postscript TimesRoman) - ?(font_size = 12) - ?(angle = 0.0) - ?(rigid = true) - ?(special = false) - ?(hidden = false) - (x,y) string -> + ?(sub_type = LeftJustified) + ?(color = black) + ?(depth = 50) + ?(font = Postscript TimesRoman) + ?(font_size = 12) + ?(angle = 0.0) + ?(rigid = true) + ?(special = false) + ?(hidden = false) + (x,y) string -> (* Null height and length automatically updated by xfig *) - let ff = font_flags rigid special font hidden in - (["Text"], Text (sub_type, color, depth, font, font_size, angle, ff, 0., 0., (x, y), string)) + let ff = font_flags rigid special font hidden in + (["Text"], Text (sub_type, color, depth, font, font_size, angle, ff, 0., 0., (x, y), string)) let compound = fun objects -> (* Null box automatically updated by xfig *) @@ -499,8 +499,8 @@ let rec read_comments = fun s -> bscanf s " %0c" (fun c -> if c = '#' then bscanf s " %s@\n" (fun l -> - let n = String.length l in - String.sub l 2 (n-2) :: read_comments s) + let n = String.length l in + String.sub l 2 (n-2) :: read_comments s) else []) @@ -521,37 +521,37 @@ let read_ellipse = fun s -> let p1 = read_point s in let p2 = read_point s in GrObj ({line_style = line_style_of_int ls; - line_thickness = thick; - pen_color = pc; - fill_color = fc; - depth = depth; - area_fill = af; - style_val = sv; - cap_style = Butt; (* Unused *) - forward_arrow = None; - backward_arrow = None}, (Ellipse (ellipse_of_int st, direction_of_int dirct, angle, c, rx, ry, p1, p2)))) + line_thickness = thick; + pen_color = pc; + fill_color = fc; + depth = depth; + area_fill = af; + style_val = sv; + cap_style = Butt; (* Unused *) + forward_arrow = None; + backward_arrow = None}, (Ellipse (ellipse_of_int st, direction_of_int dirct, angle, c, rx, ry, p1, p2)))) let read_arrow = fun s flag -> if flag = 0 then None else - bscanf s " %d %d %f %f %f" (fun at s thick w h -> - Some { arrow_type = at; - arrow_style= s; - arrow_thickness= thick; - arrow_width = w; - arrow_height= h - }) + bscanf s " %d %d %f %f %f" (fun at s thick w h -> + Some { arrow_type = at; + arrow_style= s; + arrow_thickness= thick; + arrow_width = w; + arrow_height= h + }) let read_picture = fun s -> bscanf s " %d %s" (fun flip name -> PictureBB (flip, name)) let rec read_points s n = if n = 0 then [] else - let p = read_point s in - p :: read_points s (n-1) + let p = read_point s in + p :: read_points s (n-1) let rec read_floats s n = if n = 0 then [] else - bscanf s " %f" (fun f -> f :: read_floats s (n-1)) + bscanf s " %f" (fun f -> f :: read_floats s (n-1)) let read_polyline = fun s -> @@ -561,15 +561,15 @@ let read_polyline = fun s -> let st = if st = 5 then read_picture s else polyline_of_int st in let points = read_points s n in let com = {line_style = line_style_of_int ls; - line_thickness = thick; - pen_color = pc; - fill_color = fc; - depth = depth; - area_fill = af; - style_val = sv; - cap_style = cap_style_of_int cs; - forward_arrow = fa; - backward_arrow = ba} in + line_thickness = thick; + pen_color = pc; + fill_color = fc; + depth = depth; + area_fill = af; + style_val = sv; + cap_style = cap_style_of_int cs; + forward_arrow = fa; + backward_arrow = ba} in GrObj (com, Polylines (st, join_style_of_int js, rad, points))) @@ -580,15 +580,15 @@ let read_spline = fun s -> let points = read_points s n in let shape_factors = read_floats s n in let com = {line_style = line_style_of_int ls; - line_thickness = thick; - pen_color = pc; - fill_color = fc; - depth = depth; - area_fill = af; - style_val = sv; - cap_style = cap_style_of_int cs; - forward_arrow = fa; - backward_arrow = ba} in + line_thickness = thick; + pen_color = pc; + fill_color = fc; + depth = depth; + area_fill = af; + style_val = sv; + cap_style = cap_style_of_int cs; + forward_arrow = fa; + backward_arrow = ba} in GrObj (com, Spline (spline_of_int st, points, shape_factors))) let read_arc = fun s -> @@ -600,15 +600,15 @@ let read_arc = fun s -> let ba = read_arrow s baf in let com = { line_style = line_style_of_int ls; - line_thickness = thick; - pen_color = pc; - fill_color = fc; - depth = depth; - area_fill = af; - style_val = sv; - cap_style = cap_style_of_int cs; - forward_arrow = fa; - backward_arrow = ba} in + line_thickness = thick; + pen_color = pc; + fill_color = fc; + depth = depth; + area_fill = af; + style_val = sv; + cap_style = cap_style_of_int cs; + forward_arrow = fa; + backward_arrow = ba} in GrObj(com, Arc (arc_of_int st, direction_of_int dirct, (cx, cy), p1, p2, p3))) @@ -633,12 +633,12 @@ let rec read_objects = fun s -> let comments = read_comments s in bscanf s " %d" (fun code -> if 0 <= code && code <= 6 then - let o = read_object.(code) s in - (comments, o) :: read_objects s + let o = read_object.(code) s in + (comments, o) :: read_objects s else if code = -6 then [] else failwith ("read_objects: "^string_of_int code)) with - End_of_file -> [] + End_of_file -> [] and read_compound = fun s -> bscanf s " %d %d %d %d" (fun x1 y1 x2 y2 -> Compound ((x1,y1), (x2,y2), read_objects s)) @@ -657,105 +657,105 @@ let read = fun file -> let os = read_objects s in { - version = v; - orientation = orientation_of_string o; - justification = just_of_string j; - units = units_name_of_string u; - papersize = p; - magnification = m; - multiple_page = multiple_page_of_string multi; - transparent_color = t; - comments = comments; - resolution = (resolution, coord_system); - body = os - })) + version = v; + orientation = orientation_of_string o; + justification = just_of_string j; + units = units_name_of_string u; + papersize = p; + magnification = m; + multiple_page = multiple_page_of_string multi; + transparent_color = t; + comments = comments; + resolution = (resolution, coord_system); + body = os + })) let fprint_point f (x, y) = fprintf f " %d %d" x y let arrow_flag = function - None -> 0 +None -> 0 | Some _ -> 1 let fprint_arrow f = function - None -> () +None -> () | Some a -> - fprintf f "\t%d %d %.2f %.2f %.2f\n" a.arrow_type a.arrow_style a.arrow_thickness a.arrow_width a.arrow_height + fprintf f "\t%d %d %.2f %.2f %.2f\n" a.arrow_type a.arrow_style a.arrow_thickness a.arrow_width a.arrow_height let fprint_picture f = function - PictureBB (flip, name) -> - fprintf f "%d %s\n" flip name +PictureBB (flip, name) -> + fprintf f "%d %s\n" flip name | _ -> () let write_graphic_object f com = function - Ellipse (ellipse, direction, angle, center, rx, ry, p1, p2) -> - fprintf f "1 %d %d %d %d %d %d -1 %d %.3f " - (int_of_ellipse ellipse) - (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color - com.depth com.area_fill com.style_val; - fprintf f "%d %.4f%a%a%a%a\n" - (int_of_direction direction) angle fprint_point center fprint_point (rx,ry) - fprint_point p1 fprint_point p2 +Ellipse (ellipse, direction, angle, center, rx, ry, p1, p2) -> + fprintf f "1 %d %d %d %d %d %d -1 %d %.3f " + (int_of_ellipse ellipse) + (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color + com.depth com.area_fill com.style_val; + fprintf f "%d %.4f%a%a%a%a\n" + (int_of_direction direction) angle fprint_point center fprint_point (rx,ry) + fprint_point p1 fprint_point p2 | Polylines (polyline, join_style, radius, points) -> - fprintf f "2 %d %d %d %d %d %d 0 %d %.3f " - (int_of_polyline polyline) - (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color - com.depth com.area_fill com.style_val; - fprintf f "%d %d %d " (int_of_join_style join_style) (int_of_cap_style com.cap_style) radius; - fprintf f "%d %d %d\n" (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow) (List.length points); - fprint_arrow f com.forward_arrow; - fprint_arrow f com.backward_arrow; - fprint_picture f polyline; - fprintf f "\t"; List.iter (fprint_point f) points; fprintf f "\n"; + fprintf f "2 %d %d %d %d %d %d 0 %d %.3f " + (int_of_polyline polyline) + (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color + com.depth com.area_fill com.style_val; + fprintf f "%d %d %d " (int_of_join_style join_style) (int_of_cap_style com.cap_style) radius; + fprintf f "%d %d %d\n" (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow) (List.length points); + fprint_arrow f com.forward_arrow; + fprint_arrow f com.backward_arrow; + fprint_picture f polyline; + fprintf f "\t"; List.iter (fprint_point f) points; fprintf f "\n"; | Spline ((arc,spline), points, factors) -> - fprintf f "3 %d %d %d %d %d %d 0 %d %f " - (int_of_spline (arc,spline)) - (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color - com.depth com.area_fill com.style_val; - fprintf f "%d " (int_of_cap_style com.cap_style); - fprintf f "%d %d %d\n" (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow) (List.length points); - fprint_arrow f com.forward_arrow; - fprint_arrow f com.backward_arrow; - fprintf f "\t"; List.iter (fprint_point f) points; fprintf f "\n"; - fprintf f "\t"; List.iter (fun x -> fprintf f " %.3f" x) factors; fprintf f "\n" + fprintf f "3 %d %d %d %d %d %d 0 %d %f " + (int_of_spline (arc,spline)) + (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color + com.depth com.area_fill com.style_val; + fprintf f "%d " (int_of_cap_style com.cap_style); + fprintf f "%d %d %d\n" (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow) (List.length points); + fprint_arrow f com.forward_arrow; + fprint_arrow f com.backward_arrow; + fprintf f "\t"; List.iter (fprint_point f) points; fprintf f "\n"; + fprintf f "\t"; List.iter (fun x -> fprintf f " %.3f" x) factors; fprintf f "\n" | Arc (arc, direction, (cx, cy), p1, p2, p3) -> - fprintf f "5 %d %d %d %d %d %d 0 %d %f " - (int_of_arc arc) - (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color - com.depth com.area_fill com.style_val; - fprintf f "%d %d " (int_of_cap_style com.cap_style) (direction_of_int direction); - fprintf f "%d %d " (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow); - fprintf f "%f %f " cx cy; - fprintf f "%a %a %a\n" fprint_point p1 fprint_point p2 fprint_point p3; - fprint_arrow f com.forward_arrow; - fprint_arrow f com.backward_arrow + fprintf f "5 %d %d %d %d %d %d 0 %d %f " + (int_of_arc arc) + (int_of_line_style com.line_style) com.line_thickness com.pen_color com.fill_color + com.depth com.area_fill com.style_val; + fprintf f "%d %d " (int_of_cap_style com.cap_style) (direction_of_int direction); + fprintf f "%d %d " (arrow_flag com.forward_arrow) (arrow_flag com.backward_arrow); + fprintf f "%f %f " cx cy; + fprintf f "%a %a %a\n" fprint_point p1 fprint_point p2 fprint_point p3; + fprint_arrow f com.forward_arrow; + fprint_arrow f com.backward_arrow let rec write_object f (comments, obj) = List.iter (fun x -> fprintf f "# %s\n" x) comments; match obj with - UserColor (color, (r, g, b)) -> fprintf f "0 %d #%02x%02x%02x\n" color r g b - | Compound (p1, p2, objects) -> + UserColor (color, (r, g, b)) -> fprintf f "0 %d #%02x%02x%02x\n" color r g b + | Compound (p1, p2, objects) -> fprintf f "6%a%a\n" fprint_point p1 fprint_point p2; List.iter (write_object f) objects; fprintf f "-6\n" - | Text (justification, color, depth, font, font_size, angle, font_flags, h, l, point, string) -> + | Text (justification, color, depth, font, font_size, angle, font_flags, h, l, point, string) -> fprintf f "4 %d %d %d 0 %d %d %.4f %d %.0f %.0f%a %a\\001\n" - (int_of_justification justification) color depth (int_of_font font) font_size angle font_flags h l fprint_point point code_string string - | GrObj (graphic_common, graphic_object) -> + (int_of_justification justification) color depth (int_of_font font) font_size angle font_flags h l fprint_point point code_string string + | GrObj (graphic_common, graphic_object) -> write_graphic_object f graphic_common graphic_object let write_out f { version = v; - orientation = o; - justification = j; - units = u; - papersize = p; - magnification = m; - multiple_page = multi; - transparent_color = t; - comments = comments; - resolution = (resolution, coord_system); - body = os - } = + orientation = o; + justification = j; + units = u; + papersize = p; + magnification = m; + multiple_page = multi; + transparent_color = t; + comments = comments; + resolution = (resolution, coord_system); + body = os + } = fprintf f "#FIG %s\n%s\n%s\n%s\n%s\n%.2f\n%s\n%d\n" v (string_of_orientation o) (string_of_just j) (string_of_units_name u) p m (string_of_multiple_page multi) t; List.iter (fun x -> fprintf f "# %s\n" x) comments; fprintf f "%d %d\n" resolution coord_system; diff --git a/sw/lib/ocaml/geometry_2d.ml b/sw/lib/ocaml/geometry_2d.ml index 5353324841..eb0513cfcb 100644 --- a/sw/lib/ocaml/geometry_2d.ml +++ b/sw/lib/ocaml/geometry_2d.ml @@ -44,7 +44,7 @@ type poly_2D = pt_2D list (* T_OUT_SEG_PTx : intersection hors d'un segment. Le point d'intersection se *) (* situe du cote du point x *) type t_crossing = T_IN_SEG1 | T_IN_SEG2 | T_ON_PT1 | T_ON_PT2 | T_ON_PT3 -| T_ON_PT4 | T_OUT_SEG_PT1 | T_OUT_SEG_PT2 | T_OUT_SEG_PT3 | T_OUT_SEG_PT4 + | T_ON_PT4 | T_OUT_SEG_PT1 | T_OUT_SEG_PT2 | T_OUT_SEG_PT3 | T_OUT_SEG_PT4 (* Type de polygone : convexe, concave ou indefini *) type t_conv = CONVEX | CONCAVE | CONV_UNDEFINED @@ -57,10 +57,10 @@ let cc x = x*.x (* Type des points utilises pour la triangulation *) type vertex = {pos : pt_2D; - num : int ; - mutable prev : int ; - mutable next : int ; - mutable ear : bool} + num : int ; + mutable prev : int ; + mutable next : int ; + mutable ear : bool} (* ============================================================================= *) (* = Manipulations d'angles = *) @@ -156,8 +156,8 @@ let barycenter lst_pts = let weighted_barycenter lst_pts lst_coeffs = let (v, somme_coeffs) = - List.fold_left2 (fun (p, s) pt c -> (vect_add_mul_scal c p pt, s+.c)) - (null_vector, 0.0) lst_pts lst_coeffs in + List.fold_left2 (fun (p, s) pt c -> (vect_add_mul_scal c p pt, s+.c)) + (null_vector, 0.0) lst_pts lst_coeffs in vect_mul_scal v (1.0/.somme_coeffs) (* ============================================================================= *) @@ -202,21 +202,21 @@ let point_project_on_segment pt a b = let point_project_on_segments_list pt lst_points = let proj = ref None and dist = ref 0. in let rec f l = - match l with - a::b::reste -> - (match point_project_on_segment pt a b with - None -> () - | Some p -> - (* Le point se projete sur le segment ab, on teste si la distance *) - (* de pt au segment ab est inferieure a la distance courante, si *) - (* oui alors le point p est le point recherche *) - let d = distance p pt in - (match !proj with - None -> dist:= d; proj:=Some p - | Some _ -> if d < !dist then begin dist:= d; proj:=Some p end - )) ; - f (b::reste) - | _ -> !proj + match l with + a::b::reste -> + (match point_project_on_segment pt a b with + None -> () + | Some p -> + (* Le point se projete sur le segment ab, on teste si la distance *) + (* de pt au segment ab est inferieure a la distance courante, si *) + (* oui alors le point p est le point recherche *) + let d = distance p pt in + (match !proj with + None -> dist:= d; proj:=Some p + | Some _ -> if d < !dist then begin dist:= d; proj:=Some p end + )) ; + f (b::reste) + | _ -> !proj in f lst_points @@ -239,8 +239,8 @@ let distance_point_line pt a u = (* ============================================================================= *) let distance_point_segments_list pt lst_points = match point_project_on_segments_list pt lst_points with - None -> None - | Some p -> Some (distance p pt) + None -> None + | Some p -> Some (distance p pt) (* ============================================================================= *) @@ -261,27 +261,27 @@ let crossing_point a u c v = and denom = -.(cross_product u v) in if denom = 0. then - (* Les deux vecteurs sont paralleles *) - None + (* Les deux vecteurs sont paralleles *) + None else begin - let r = num1 /. denom and s = num2 /. denom in - let type_intersection_seg1 = - if abs_float r < epsilon then T_ON_PT1 - else if abs_float (r-.1.0) < epsilon then T_ON_PT2 - else if r<0.0 then T_OUT_SEG_PT1 - else if r>1.0 then T_OUT_SEG_PT2 - else T_IN_SEG1 + let r = num1 /. denom and s = num2 /. denom in + let type_intersection_seg1 = + if abs_float r < epsilon then T_ON_PT1 + else if abs_float (r-.1.0) < epsilon then T_ON_PT2 + else if r<0.0 then T_OUT_SEG_PT1 + else if r>1.0 then T_OUT_SEG_PT2 + else T_IN_SEG1 - and type_intersection_seg2 = - if abs_float s < epsilon then T_ON_PT3 - else if abs_float (s-.1.0) < epsilon then T_ON_PT4 - else if s<0.0 then T_OUT_SEG_PT3 - else if s>1.0 then T_OUT_SEG_PT4 - else T_IN_SEG2 + and type_intersection_seg2 = + if abs_float s < epsilon then T_ON_PT3 + else if abs_float (s-.1.0) < epsilon then T_ON_PT4 + else if s<0.0 then T_OUT_SEG_PT3 + else if s>1.0 then T_OUT_SEG_PT4 + else T_IN_SEG2 - and pt_intersection = vect_add_mul_scal r a u in + and pt_intersection = vect_add_mul_scal r a u in - Some (type_intersection_seg1, type_intersection_seg2, pt_intersection) + Some (type_intersection_seg1, type_intersection_seg2, pt_intersection) end (* ============================================================================= *) @@ -289,7 +289,7 @@ let crossing_point a u c v = (* ============================================================================= *) let test_in_segment t = (t=T_IN_SEG1)||(t=T_ON_PT1)||(t=T_ON_PT2)|| - (t=T_IN_SEG2)||(t=T_ON_PT3)||(t=T_ON_PT4) + (t=T_IN_SEG2)||(t=T_ON_PT3)||(t=T_ON_PT4) let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) (* ============================================================================= *) @@ -297,18 +297,18 @@ let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) (* ============================================================================= *) let crossing_seg_seg a b c d = match crossing_point a (vect_make a b) c (vect_make c d) with - None -> false - | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) + None -> false + | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) (* ============================================================================= *) (* = Teste l'intersection d'un segment (a,b) et d'une demi-droite (c,v) = *) (* ============================================================================= *) let crossing_seg_hl a b c v = match crossing_point a (vect_make a b) c v with - None -> false - | Some (type1, type2, _pt) -> - (* OK si intersection sur la demi-droite *) - (test_in_segment type1) && (test_on_hl type2) + None -> false + | Some (type1, type2, _pt) -> + (* OK si intersection sur la demi-droite *) + (test_in_segment type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux demi-droites = *) @@ -316,16 +316,16 @@ let crossing_seg_hl a b c v = let crossing_hl_hl a u c v = let inter = crossing_point a u c v in match inter with - None -> false - | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) + None -> false + | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux droites et renvoie le point s'il existe = *) (* ============================================================================= *) let crossing_lines a u c v = match crossing_point a u c v with - None -> (false, null_vector) - | Some (_type1, _type2, pt) -> (true, pt) + None -> (false, null_vector) + | Some (_type1, _type2, pt) -> (true, pt) (* ============================================================================= *) @@ -353,8 +353,8 @@ let poly_close poly = (* ============================================================================= *) let poly_close2 poly = if List.length poly < 2 then Array.of_list poly else begin - let poly = if poly_is_closed poly then poly else poly@[List.hd poly] in - Array.of_list (poly@[List.hd (List.tl poly)]) + let poly = if poly_is_closed poly then poly else poly@[List.hd poly] in + Array.of_list (poly@[List.hd (List.tl poly)]) end (* ============================================================================= *) @@ -364,9 +364,9 @@ let point_in_poly pt poly = let p = Array.of_list poly in let do_func {x2D=xi; y2D=yi} {x2D=xj; y2D=yj} {x2D=x; y2D=y} c = - if (((yi<=y) && (y do_func p0 p.(!j) pt is_in ; j := i) p ; @@ -384,32 +384,32 @@ let point_in_circle pt (center, r) = distance pt center <= r (* ============================================================================= *) let convex_hull poly = let det a b = - match cross_product a b with 0.0 -> 0.0 | n when n>0.0 -> 1.0 | _ -> -1.0 + match cross_product a b with 0.0 -> 0.0 | n when n>0.0 -> 1.0 | _ -> -1.0 in let du_meme_cote a b c d = - let u = vect_make a b and v = vect_make a c and w = vect_make a d in - (det u v)*.(det u w)>0.0 + let u = vect_make a b and v = vect_make a c and w = vect_make a d in + (det u v)*.(det u w)>0.0 in let plus_proche a b c d = - (d=a) or ((not(c=a)) & - ((du_meme_cote b c d a) or ( - let u = vect_make b c and v = vect_make b d in - (det u v)=0.0 & (abs_float(u.x2D)+.abs_float(u.y2D)> - abs_float(v.x2D)+.abs_float(v.y2D))))) + (d=a) or ((not(c=a)) & + ((du_meme_cote b c d a) or ( + let u = vect_make b c and v = vect_make b d in + (det u v)=0.0 & (abs_float(u.x2D)+.abs_float(u.y2D)> + abs_float(v.x2D)+.abs_float(v.y2D))))) in let extract_mini p l = - let rec aux reste vu mini = + let rec aux reste vu mini = match reste with - t::q -> - if (try(p mini t) with _ -> false) then aux q (t::vu) mini - else aux q (mini::vu) t - | [] -> mini,vu - in match l with - t::q -> aux q [] t - | [] -> raise Exit + t::q -> + if (try(p mini t) with _ -> false) then aux q (t::vu) mini + else aux q (mini::vu) t + | [] -> mini,vu + in match l with + t::q -> aux q [] t + | [] -> raise Exit in let p a b = a.x2Db.y2D) in @@ -428,28 +428,28 @@ let convex_hull poly = let crossing_seg_poly a b poly = (* Supprime les doublons dans une liste triee *) let supprime_doublons_points l = - let (_p, new_l) = List.fold_left (fun (old, lst) pt -> - match old with - None -> (Some pt, [pt]) - | Some p -> if point_same p pt then (old, lst) else (Some pt, pt :: lst) - ) (None, []) l in - List.rev new_l + let (_p, new_l) = List.fold_left (fun (old, lst) pt -> + match old with + None -> (Some pt, [pt]) + | Some p -> if point_same p pt then (old, lst) else (Some pt, pt :: lst) + ) (None, []) l in + List.rev new_l in let u = vect_make a b and pol = Array.of_list poly and lst_pts_inter = ref [] in for i = 0 to (Array.length pol-1) do - let c = pol.(i) and - (* Rappel : le polygone n'est pas ferme... *) - d = if i < (Array.length pol) -1 then pol.(i+1) else pol.(0) in - let inter = crossing_point a u c (vect_make c d) in - match inter with - None -> () (* Pas d'intersection entre le segment et l'arrete *) - | Some (type1, type2, pt) -> - if (test_in_segment type1) && (test_in_segment type2) then - (* L'intersection est bien sur les 2 segments *) - lst_pts_inter := pt :: !lst_pts_inter + let c = pol.(i) and + (* Rappel : le polygone n'est pas ferme... *) + d = if i < (Array.length pol) -1 then pol.(i+1) else pol.(0) in + let inter = crossing_point a u c (vect_make c d) in + match inter with + None -> () (* Pas d'intersection entre le segment et l'arrete *) + | Some (type1, type2, pt) -> + if (test_in_segment type1) && (test_in_segment type2) then + (* L'intersection est bien sur les 2 segments *) + lst_pts_inter := pt :: !lst_pts_inter done ; (* Suppression des doublons dans la liste des points d'intersection *) @@ -461,20 +461,20 @@ let crossing_seg_poly a b poly = (* ============================================================================= *) let crossing_seg_poly_exclusive a b poly = let u = vect_make a b and - pol = Array.of_list poly and - lst_pts_inter = ref [] in + pol = Array.of_list poly and + lst_pts_inter = ref [] in for i = 0 to (Array.length pol-1) do - let c = pol.(i) and - (* Rappel : le polygone n'est pas ferme... *) - d = if i < (Array.length pol) -1 then pol.(i+1) else pol.(0) in - let inter = crossing_point a u c (vect_make c d) in - match inter with - None -> () (* Pas d'intersection entre le segment et l'arrete *) - | Some (type1, type2, pt) -> - if (type1=T_IN_SEG1) && (type2=T_IN_SEG2) then - (* L'intersection est bien sur les 2 segments *) - lst_pts_inter := pt :: !lst_pts_inter ; + let c = pol.(i) and + (* Rappel : le polygone n'est pas ferme... *) + d = if i < (Array.length pol) -1 then pol.(i+1) else pol.(0) in + let inter = crossing_point a u c (vect_make c d) in + match inter with + None -> () (* Pas d'intersection entre le segment et l'arrete *) + | Some (type1, type2, pt) -> + if (type1=T_IN_SEG1) && (type2=T_IN_SEG2) then + (* L'intersection est bien sur les 2 segments *) + lst_pts_inter := pt :: !lst_pts_inter ; done ; !lst_pts_inter @@ -485,13 +485,13 @@ let crossing_seg_poly_exclusive a b poly = let circumcircle {x2D=x1; y2D=y1} {x2D=x2; y2D=y2} {x2D=x3; y2D=y3} = (* Determinants de matrices 3x3 *) let eval_det a1 a2 a3 b1 b2 b3 c1 c2 c3 = - a1*.b2*.c3-.a1*.b3*.c2-.a2*.b1*.c3+.a2*.b3*.c1+.a3*.b1*.c2-.a3*.b2*.c1 in + a1*.b2*.c3-.a1*.b3*.c2-.a2*.b1*.c3+.a2*.b3*.c1+.a3*.b1*.c2-.a3*.b2*.c1 in let eval_det1 a1 a2 b1 b2 c1 c2 = eval_det a1 a2 1. b1 b2 1. c1 c2 1. in let a = eval_det1 x1 y1 x2 y2 x3 y3 in let s1 = (cc x1)+.(cc y1) and s2 = (cc x2)+.(cc y2) and s3 = (cc x3)+.(cc y3) in let bx = eval_det1 s1 y1 s2 y2 s3 y3 in - let by = -.(eval_det1 s1 x1 s2 x2 s3 x3) in + let by = -.(eval_det1 s1 x1 s2 x2 s3 x3) in let c = -.(eval_det s1 x1 y1 s2 x2 y2 s3 x3 y3) in let a = 2.*.a in let xc = bx/.a and yc = by/.a in @@ -513,12 +513,12 @@ let ccw_angle p0 p1 p2 = (* ============================================================================= *) let poly_test_convex l = if List.length l > 2 then begin - (* l = [A; B; C; D] -> t = [|A; B; C; D; A; B|] *) - let t = poly_close2 l in - let n = Array.length t in - let sign = ccw_angle t.(0) t.(1) t.(2) and i = ref 1 in - while !i t = [|A; B; C; D; A; B|] *) + let t = poly_close2 l in + let n = Array.length t in + let sign = ccw_angle t.(0) t.(1) t.(2) and i = ref 1 in + while !i 2 then begin - let t = Array.of_list (poly_close l) in - if poly_test_convex l = CONVEX then ccw_angle t.(0) t.(1) t.(2) - else begin - let s = ref 0. in - for i = 0 to (Array.length t-2) do - s:= !s+.cross_product t.(i) t.(i+1) - done ; - if !s>0. then CCW else if !s<0. then CW else CCW_UNDEFINED - end + let t = Array.of_list (poly_close l) in + if poly_test_convex l = CONVEX then ccw_angle t.(0) t.(1) t.(2) + else begin + let s = ref 0. in + for i = 0 to (Array.length t-2) do + s:= !s+.cross_product t.(i) t.(i+1) + done ; + if !s>0. then CCW else if !s<0. then CW else CCW_UNDEFINED + end end else CCW_UNDEFINED (* ============================================================================= *) @@ -545,12 +545,12 @@ let poly_signed_area poly = (* plus efficace et plus precise *) if List.length poly < 2 then 0. else begin - let poly = poly_close2 poly in - let n = Array.length poly -2 and area = ref 0. in - for i = 1 to n do - area:=!area+.poly.(i).x2D*.(poly.(i+1).y2D-.poly.(i-1).y2D) - done ; - !area/.2. + let poly = poly_close2 poly in + let n = Array.length poly -2 and area = ref 0. in + for i = 1 to n do + area:=!area+.poly.(i).x2D*.(poly.(i+1).y2D-.poly.(i-1).y2D) + done ; + !area/.2. end (* ============================================================================= *) @@ -569,29 +569,29 @@ let poly_centroid poly = (* Centroide d'un triangle *) let centroid_triangle p1 p2 p3 = - {x2D=(p1.x2D+.p2.x2D+.p3.x2D)/.3.; y2D=(p1.y2D+.p2.y2D+.p3.y2D)/.3.} in + {x2D=(p1.x2D+.p2.x2D+.p3.x2D)/.3.; y2D=(p1.y2D+.p2.y2D+.p3.y2D)/.3.} in (* Aire signee d'un triangle, pas besoin de poly_area... *) let area_triangle p1 p2 p3 = - (cross_product (vect_make p1 p2) (vect_make p1 p3))/.2. + (cross_product (vect_make p1 p2) (vect_make p1 p3))/.2. in let rec f p0 l centroid = - match l with - p1::p2::reste -> - let new_centroid = vect_add_mul_scal (area_triangle p0 p1 p2) centroid - (centroid_triangle p0 p1 p2) in - f p0 (p2::reste) new_centroid - | _ -> - let area = poly_signed_area poly in - vect_mul_scal centroid (1./.area) + match l with + p1::p2::reste -> + let new_centroid = vect_add_mul_scal (area_triangle p0 p1 p2) centroid + (centroid_triangle p0 p1 p2) in + f p0 (p2::reste) new_centroid + | _ -> + let area = poly_signed_area poly in + vect_mul_scal centroid (1./.area) in match poly with - [] -> null_vector - | p::[] -> p - | p1::p2::[] -> point_middle p1 p2 - | _ -> f (List.hd poly) (List.tl poly) null_vector + [] -> null_vector + | p::[] -> p + | p1::p2::[] -> point_middle p1 p2 + | _ -> f (List.hd poly) (List.tl poly) null_vector (* ============================================================================= *) (* = = *) @@ -607,51 +607,51 @@ let poly_centroid poly = let in_tesselation poly = (* On teste si le polygone est bien CCW, s'il ne l'est pas on l'inverse *) let (switched, l)= - match poly_test_ccw poly with - CW -> (true, List.rev poly) - | _ -> (false, poly) + match poly_test_ccw poly with + CW -> (true, List.rev poly) + | _ -> (false, poly) in (* Creation du tableau des points sous la forme necessaire a la triangulation *) let vertices = - let t = Array.of_list l and n = List.length l and vertices = ref [] in - Array.iteri (fun i pt -> - vertices:={pos=pt; num=i; ear=false; - prev=if i=0 then n-1 else i-1; - next=if i=n-1 then 0 else i+1}::!vertices) t ; - Array.of_list (List.rev !vertices) + let t = Array.of_list l and n = List.length l and vertices = ref [] in + Array.iteri (fun i pt -> + vertices:={pos=pt; num=i; ear=false; + prev=if i=0 then n-1 else i-1; + next=if i=n-1 then 0 else i+1}::!vertices) t ; + Array.of_list (List.rev !vertices) in (* Fonction testant si les points d'indices n1 et n2 forment une diagonale *) (* completement contenue dans le polygone *) let is_diagonal n1 n2 = - let lefton a b c = cross_product (vect_make a b) (vect_make a c) >= 0. in - let left a b c = cross_product (vect_make a b) (vect_make a c) > 0. in + let lefton a b c = cross_product (vect_make a b) (vect_make a c) >= 0. in + let left a b c = cross_product (vect_make a b) (vect_make a c) > 0. in - let is_in_cone a b = - let a1=vertices.(a.next) and a0=vertices.(a.prev) in + let is_in_cone a b = + let a1=vertices.(a.next) and a0=vertices.(a.prev) in - (* Point A convexe ? *) - if lefton a.pos a1.pos a0.pos then - (left a.pos b.pos a0.pos) && (left b.pos a.pos a1.pos) - else not ((lefton a.pos b.pos a1.pos) && (lefton b.pos a.pos a0.pos)) - in + (* Point A convexe ? *) + if lefton a.pos a1.pos a0.pos then + (left a.pos b.pos a0.pos) && (left b.pos a.pos a1.pos) + else not ((lefton a.pos b.pos a1.pos) && (lefton b.pos a.pos a0.pos)) + in - let a = vertices.(n1) and b = vertices.(n2) in + let a = vertices.(n1) and b = vertices.(n2) in -(* AAA if is_in_cone a b && is_in_cone b a then begin *) - if is_in_cone a b or is_in_cone b a then begin - let rec f l = - match l with - c::reste -> - let c1 = vertices.(c.next) in - if c.num<>a.num && c1.num<>a.num && c.num<>b.num && c1.num<>b.num && - crossing_seg_seg a.pos b.pos c.pos c1.pos then false - else f reste - | [] -> true - in - f (Array.to_list vertices) - end else false + (* AAA if is_in_cone a b && is_in_cone b a then begin *) + if is_in_cone a b or is_in_cone b a then begin + let rec f l = + match l with + c::reste -> + let c1 = vertices.(c.next) in + if c.num<>a.num && c1.num<>a.num && c.num<>b.num && c1.num<>b.num && + crossing_seg_seg a.pos b.pos c.pos c1.pos then false + else f reste + | [] -> true + in + f (Array.to_list vertices) + end else false in (* Initialisation des oreilles *) @@ -661,37 +661,37 @@ let in_tesselation poly = let current_idx = ref 0 and earfound = ref false and lst_triangles = ref [] and n = ref (Array.length vertices) in while !n>=3 do - earfound:=false ; - let v2 = ref !current_idx and finished = ref false in - while not !finished && not !earfound do - if vertices.(!v2).ear then begin - (* Le point courant correspond a une oreille, on va le supprimer *) - earfound:=true ; + earfound:=false ; + let v2 = ref !current_idx and finished = ref false in + while not !finished && not !earfound do + if vertices.(!v2).ear then begin + (* Le point courant correspond a une oreille, on va le supprimer *) + earfound:=true ; - (* 5 points consecutifs, v2 est au 'milieu' des 5 *) - let v1=vertices.(!v2).prev and v3=vertices.(!v2).next in - let v0=vertices.(v1).prev and v4=vertices.(v3).next in + (* 5 points consecutifs, v2 est au 'milieu' des 5 *) + let v1=vertices.(!v2).prev and v3=vertices.(!v2).next in + let v0=vertices.(v1).prev and v4=vertices.(v3).next in - (* Sauvegarde du triangle. Pas sous la forme v1, v2, v3 sinon *) - (* il n'est pas CCW et donc pb de normale exterieure a l'affichage *) - lst_triangles := (v3, !v2, v1)::!lst_triangles ; + (* Sauvegarde du triangle. Pas sous la forme v1, v2, v3 sinon *) + (* il n'est pas CCW et donc pb de normale exterieure a l'affichage *) + lst_triangles := (v3, !v2, v1)::!lst_triangles ; - (* Mise a jour des oreilles *) - vertices.(v1).ear <- is_diagonal v0 v3 ; - vertices.(v3).ear <- is_diagonal v1 v4 ; + (* Mise a jour des oreilles *) + vertices.(v1).ear <- is_diagonal v0 v3 ; + vertices.(v3).ear <- is_diagonal v1 v4 ; - (* Suppression du point v2 *) - vertices.(v1).next <- v3 ; - vertices.(v3).prev <- v1 ; - current_idx:=v3 ; + (* Suppression du point v2 *) + vertices.(v1).next <- v3 ; + vertices.(v3).prev <- v1 ; + current_idx:=v3 ; - (* Un triangle de moins a chercher *) - decr n - end else v2:=vertices.(!v2).next ; + (* Un triangle de moins a chercher *) + decr n + end else v2:=vertices.(!v2).next ; - (* C'est fini quand on revient sur le point initial *) - finished:= !v2 = !current_idx - done ; + (* C'est fini quand on revient sur le point initial *) + finished:= !v2 = !current_idx + done ; done ; if not !earfound then begin Printf.printf "No ear !\n"; flush stdout end ; @@ -701,9 +701,9 @@ let in_tesselation poly = (* par l'utilisateur. On remet alors les numeros comme ils etaients lors *) (* de l'appel a la fonction de triangulation *) if switched then begin - let n = List.length poly in - lst_triangles:=List.map (fun (p1, p2, p3) -> (n-1-p1, n-1-p2, n-1-p3) - ) !lst_triangles + let n = List.length poly in + lst_triangles:=List.map (fun (p1, p2, p3) -> (n-1-p1, n-1-p2, n-1-p3) + ) !lst_triangles end ; !lst_triangles @@ -724,63 +724,63 @@ let in_tesselation_fans l = let tt = Array.mapi (fun i _x -> (i, 0)) t in let add_val x = let (p, n) = tt.(x) in tt.(x) <- (p, n+1) in List.iter (fun (p1, p2, p3) -> - add_val p1; add_val p2; add_val p3) l ; + add_val p1; add_val p2; add_val p3) l ; let lst = List.fast_sort (fun (_, n1) (_, n2) -> n2-n1) (Array.to_list tt) in let tt2 = Array.create (Array.length tt) (0, []) in let i = ref 0 in List.iter (fun (x, _) -> tt2.(x) <- (!i, []); incr i) lst ; List.iter (fun (p1, p2, p3) -> - let (t1, l1) = tt2.(p1) and (t2, l2) = tt2.(p2) and (t3, l3) = tt2.(p3) in - if t1 - let l0 = ref [] in - let add_element (a, b) = - let rec f deb fin = - match fin with - [] -> (a, b, [a; b])::!l0 - | (c, d, lst)::reste -> - if b=c then begin - (* Insertion avant *) - (List.rev ((a, d, a::lst)::deb))@reste - end else if a=d then begin - (* Insertion apres *) - (List.rev ((c, b, lst@[b])::deb))@reste - end else f ((c, d, lst)::deb) reste - in - l0:=f [] !l0 - in - let merge_lists () = - let rec in_merge (a, b, l1) ll0 ll = - match ll with - (c, d, l2)::reste -> - if b=c then - (true, ((a, d, l1@(List.tl l2))::ll0)@reste) - else if d=a then - (true, ((c, b, l2@(List.tl l1))::ll0)@reste) - else in_merge (a, b, l1) ((c, d, l2)::ll0) reste - | [] -> (false, ll0) - in - let rec f l ll = - match l with - l1::reste -> - let (merged, newl) = in_merge l1 [] reste in - if merged then f newl ll - else f reste (l1::ll) - | [] -> ll - in - l0:=f !l0 [] - in + let l0 = ref [] in + let add_element (a, b) = + let rec f deb fin = + match fin with + [] -> (a, b, [a; b])::!l0 + | (c, d, lst)::reste -> + if b=c then begin + (* Insertion avant *) + (List.rev ((a, d, a::lst)::deb))@reste + end else if a=d then begin + (* Insertion apres *) + (List.rev ((c, b, lst@[b])::deb))@reste + end else f ((c, d, lst)::deb) reste + in + l0:=f [] !l0 + in + let merge_lists () = + let rec in_merge (a, b, l1) ll0 ll = + match ll with + (c, d, l2)::reste -> + if b=c then + (true, ((a, d, l1@(List.tl l2))::ll0)@reste) + else if d=a then + (true, ((c, b, l2@(List.tl l1))::ll0)@reste) + else in_merge (a, b, l1) ((c, d, l2)::ll0) reste + | [] -> (false, ll0) + in + let rec f l ll = + match l with + l1::reste -> + let (merged, newl) = in_merge l1 [] reste in + if merged then f newl ll + else f reste (l1::ll) + | [] -> ll + in + l0:=f !l0 [] + in - if l<>[] then begin - List.iter (fun x -> add_element x; merge_lists ()) l ; - List.iter (fun (_, _, l) -> - lst_fans := (i::l)::!lst_fans) !l0 - end) tt2 ; + if l<>[] then begin + List.iter (fun x -> add_element x; merge_lists ()) l ; + List.iter (fun (_, _, l) -> + lst_fans := (i::l)::!lst_fans) !l0 + end) tt2 ; (t, !lst_fans) @@ -791,7 +791,7 @@ let in_tesselation_fans l = triangle_fan OpenGL. En sortie est renvoyee une liste contenant des listes de points. Chacune de ces listes de points contient soit 3 points (triangle) soit plus de 3 points (pour un triangle_fan) - *) +*) let tesselation_fans l = let (t, l) = in_tesselation_fans l in @@ -902,26 +902,26 @@ let slice_polygon = fun poly -> begin try while !i <= n do - while poly.(!d).y2D = !last_y && !i <= n do - let d' = prev !d in - if (d' = !g && poly.(!d).y2D = poly.(!g).y2D) then raise Exit; - alpha_d := slope !d d'; - d := d'; - incr i - done; - while poly.(!g).y2D = !last_y && !i <= n do - let g' = next !g in - alpha_g := slope !g g'; - g := g'; - incr i - done; - let yd = poly.(!d).y2D - and yg = poly.(!g).y2D in - let ym = min yd yg in - let xd = poly.(!d).x2D -. !alpha_d *. (yd -. ym) in - let xg = poly.(!g).x2D -. !alpha_g *. (yg -. ym) in - l := {top = ym; left_side=(xg, !alpha_g); right_side=(xd, !alpha_d)} :: !l; - last_y := ym + while poly.(!d).y2D = !last_y && !i <= n do + let d' = prev !d in + if (d' = !g && poly.(!d).y2D = poly.(!g).y2D) then raise Exit; + alpha_d := slope !d d'; + d := d'; + incr i + done; + while poly.(!g).y2D = !last_y && !i <= n do + let g' = next !g in + alpha_g := slope !g g'; + g := g'; + incr i + done; + let yd = poly.(!d).y2D + and yg = poly.(!g).y2D in + let ym = min yd yg in + let xd = poly.(!d).x2D -. !alpha_d *. (yd -. ym) in + let xg = poly.(!g).x2D -. !alpha_g *. (yg -. ym) in + l := {top = ym; left_side=(xg, !alpha_g); right_side=(xd, !alpha_d)} :: !l; + last_y := ym done with Exit -> () (* Flat polygon *) end; diff --git a/sw/lib/ocaml/geometry_3d.ml b/sw/lib/ocaml/geometry_3d.ml index 99ab07cca4..1c968b8802 100644 --- a/sw/lib/ocaml/geometry_3d.ml +++ b/sw/lib/ocaml/geometry_3d.ml @@ -41,7 +41,7 @@ let cc x = x*.x let epsilon = 0.0001 type t_crossing3d = T_IN_SEG1 | T_IN_SEG2 | T_ON_PT1 | T_ON_PT2 | T_ON_PT3 -| T_ON_PT4 | T_OUT_SEG_PT1 | T_OUT_SEG_PT2 | T_OUT_SEG_PT3 | T_OUT_SEG_PT4 + | T_ON_PT4 | T_OUT_SEG_PT1 | T_OUT_SEG_PT2 | T_OUT_SEG_PT3 | T_OUT_SEG_PT4 (* Type pour les differents axes *) type t_axis3d = T_X3D | T_Y3D | T_Z3D @@ -73,7 +73,7 @@ let point_same pt1 pt2 = (* = Creation d'un vecteur = *) (* ============================================================================= *) let vect_make pt1 pt2 = {x3D=pt2.x3D -. pt1.x3D; y3D=pt2.y3D -. pt1.y3D; - z3D=pt2.z3D -. pt1.z3D} + z3D=pt2.z3D -. pt1.z3D} (* ============================================================================= *) (* = Norme d'un vecteur = *) @@ -126,7 +126,7 @@ let vect_inverse v = vect_mul_scal v (-1.) (* = Milieu d'un segment = *) (* ============================================================================= *) let point_middle p1 p2 = {x3D=(p1.x3D+.p2.x3D)/.2.; y3D=(p1.y3D+.p2.y3D)/.2.; - z3D=(p1.z3D+.p2.z3D)/.2.} + z3D=(p1.z3D+.p2.z3D)/.2.} (* ============================================================================= *) (* = Barycentre d'une liste de points avec ou sans coefficients = *) @@ -137,8 +137,8 @@ let barycenter lst_pts = let weighted_barycenter lst_pts lst_coeffs = let (v, somme_coeffs) = - List.fold_left2 (fun (p, s) pt c -> (vect_add_mul_scal c p pt, s+.c)) - (null_vector, 0.0) lst_pts lst_coeffs in + List.fold_left2 (fun (p, s) pt c -> (vect_add_mul_scal c p pt, s+.c)) + (null_vector, 0.0) lst_pts lst_coeffs in vect_mul_scal v (1.0/.somme_coeffs) (* ============================================================================= *) @@ -150,8 +150,8 @@ let dot_product u v = u.x3D*.v.x3D +. u.y3D*.v.y3D +. u.z3D*.v.z3D (* = Produit vectoriel = *) (* ============================================================================= *) let cross_product u v = {x3D=u.y3D*.v.z3D -. u.z3D*.v.y3D; - y3D=u.z3D*.v.x3D -. u.x3D*.v.z3D; - z3D=u.x3D*.v.y3D -. u.y3D*.v.x3D} + y3D=u.z3D*.v.x3D -. u.x3D*.v.z3D; + z3D=u.x3D*.v.y3D -. u.y3D*.v.x3D} (* ============================================================================= *) (* = Normale unitaire a un deux vecteurs = *) @@ -187,37 +187,37 @@ let crossing_point a u c v = let n2 = vect_norm n in let n2 = cc n2 in (* Si s<>0 alors les vecteurs ne sont pas coplanaires *) - let s = dot_product n w in + let s = dot_product n w in (* Si n est nul alors les vecteurs sont paralleles *) - if n2 = 0.0 or s <> 0. then None else begin - let r = (dot_product (cross_product w v) n)/.n2 - and s = (dot_product (cross_product w u) n)/.n2 in - let type_intersection_seg1 = - if abs_float r < epsilon then T_ON_PT1 - else if abs_float (r-.1.0) < epsilon then T_ON_PT2 - else if r<0.0 then T_OUT_SEG_PT1 - else if r>1.0 then T_OUT_SEG_PT2 - else T_IN_SEG1 + if n2 = 0.0 or s <> 0. then None else begin + let r = (dot_product (cross_product w v) n)/.n2 + and s = (dot_product (cross_product w u) n)/.n2 in + let type_intersection_seg1 = + if abs_float r < epsilon then T_ON_PT1 + else if abs_float (r-.1.0) < epsilon then T_ON_PT2 + else if r<0.0 then T_OUT_SEG_PT1 + else if r>1.0 then T_OUT_SEG_PT2 + else T_IN_SEG1 - and type_intersection_seg2 = - if abs_float s < epsilon then T_ON_PT3 - else if abs_float (s-.1.0) < epsilon then T_ON_PT4 - else if s<0.0 then T_OUT_SEG_PT3 - else if s>1.0 then T_OUT_SEG_PT4 - else T_IN_SEG2 + and type_intersection_seg2 = + if abs_float s < epsilon then T_ON_PT3 + else if abs_float (s-.1.0) < epsilon then T_ON_PT4 + else if s<0.0 then T_OUT_SEG_PT3 + else if s>1.0 then T_OUT_SEG_PT4 + else T_IN_SEG2 - and pt_intersection = vect_add_mul_scal r a u in + and pt_intersection = vect_add_mul_scal r a u in - Some (type_intersection_seg1, type_intersection_seg2, pt_intersection) - end + Some (type_intersection_seg1, type_intersection_seg2, pt_intersection) + end (* ============================================================================= *) (* = Test du type d'intersection = *) (* ============================================================================= *) let test_in_segment t = (t=T_IN_SEG1)||(t=T_ON_PT1)||(t=T_ON_PT2)|| - (t=T_IN_SEG2)||(t=T_ON_PT3)||(t=T_ON_PT4) + (t=T_IN_SEG2)||(t=T_ON_PT3)||(t=T_ON_PT4) let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) (* ============================================================================= *) @@ -225,18 +225,18 @@ let test_on_hl t = (test_in_segment t)||(t=T_OUT_SEG_PT4)||(t=T_OUT_SEG_PT2) (* ============================================================================= *) let crossing_seg_seg a b c d = match crossing_point a (vect_make a b) c (vect_make c d) with - None -> false - | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) + None -> false + | Some (type1, type2, _pt) -> (test_in_segment type1)&&(test_in_segment type2) (* ============================================================================= *) (* = Teste l'intersection d'un segment (a,b) et d'une demi-droite (c,v) = *) (* ============================================================================= *) let crossing_seg_hl a b c v = match crossing_point a (vect_make a b) c v with - None -> false - | Some (type1, type2, _pt) -> - (* OK si intersection sur la demi-droite *) - (test_in_segment type1) && (test_on_hl type2) + None -> false + | Some (type1, type2, _pt) -> + (* OK si intersection sur la demi-droite *) + (test_in_segment type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux demi-droites = *) @@ -244,31 +244,31 @@ let crossing_seg_hl a b c v = let crossing_hl_hl a u c v = let inter = crossing_point a u c v in match inter with - None -> false - | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) + None -> false + | Some (type1, type2, _pt) -> (test_on_hl type1) && (test_on_hl type2) (* ============================================================================= *) (* = Teste l'intersection de deux droites et renvoie le point s'il existe = *) (* ============================================================================= *) let crossing_lines a u c v = match crossing_point a u c v with - None -> (false, null_vector) - | Some (_type1, _type2, pt) -> (true, pt) + None -> (false, null_vector) + | Some (_type1, _type2, pt) -> (true, pt) (* ============================================================================= *) (* = Intersection d'une droite (a, u) et d'un plan (c, d, e) = *) (* ============================================================================= *) let crossing_line_plane a u c d e = let num = eval_det4 - 1. 1. 1. 1. - c.x3D d.x3D e.x3D a.x3D - c.y3D d.y3D e.y3D a.y3D - c.z3D d.z3D e.z3D a.z3D + 1. 1. 1. 1. + c.x3D d.x3D e.x3D a.x3D + c.y3D d.y3D e.y3D a.y3D + c.z3D d.z3D e.z3D a.z3D and denom = eval_det4 - 1. 1. 1. 0. - c.x3D d.x3D e.x3D u.x3D - c.y3D d.y3D e.y3D u.y3D - c.z3D d.z3D e.z3D u.z3D + 1. 1. 1. 0. + c.x3D d.x3D e.x3D u.x3D + c.y3D d.y3D e.y3D u.y3D + c.z3D d.z3D e.z3D u.z3D in if denom=0. then None else Some (vect_add_mul_scal (num/.denom) a u) @@ -278,21 +278,21 @@ let crossing_line_plane a u c d e = (* ============================================================================= *) let crossing_hline_plane a u c d e = let num = eval_det4 - 1. 1. 1. 1. - c.x3D d.x3D e.x3D a.x3D - c.y3D d.y3D e.y3D a.y3D - c.z3D d.z3D e.z3D a.z3D + 1. 1. 1. 1. + c.x3D d.x3D e.x3D a.x3D + c.y3D d.y3D e.y3D a.y3D + c.z3D d.z3D e.z3D a.z3D and denom = eval_det4 - 1. 1. 1. 0. - c.x3D d.x3D e.x3D u.x3D - c.y3D d.y3D e.y3D u.y3D - c.z3D d.z3D e.z3D u.z3D + 1. 1. 1. 0. + c.x3D d.x3D e.x3D u.x3D + c.y3D d.y3D e.y3D u.y3D + c.z3D d.z3D e.z3D u.z3D in if denom=0. then None else begin - let s = (-.num)/.denom in - if s >= 0. then Some (vect_add_mul_scal s a u) - else None + let s = (-.num)/.denom in + if s >= 0. then Some (vect_add_mul_scal s a u) + else None end @@ -322,8 +322,8 @@ let poly_close poly = (* ============================================================================= *) let poly_close2 poly = if List.length poly < 2 then Array.of_list poly else begin - let poly = if poly_is_closed poly then poly else poly@[List.hd poly] in - Array.of_list (poly@[List.hd (List.tl poly)]) + let poly = if poly_is_closed poly then poly else poly@[List.hd poly] in + Array.of_list (poly@[List.hd (List.tl poly)]) end (* ============================================================================= *) @@ -331,9 +331,9 @@ let poly_close2 poly = (* ============================================================================= *) let pt_3d_to_pt_2d axis pt = match axis with - T_X3D -> {x2D=pt.y3D; y2D=pt.z3D} - | T_Y3D -> {x2D=pt.x3D; y2D=pt.z3D} - | T_Z3D -> {x2D=pt.x3D; y2D=pt.y3D} + T_X3D -> {x2D=pt.y3D; y2D=pt.z3D} + | T_Y3D -> {x2D=pt.x3D; y2D=pt.z3D} + | T_Z3D -> {x2D=pt.x3D; y2D=pt.y3D} (* ============================================================================= *) (* = Transformation d'un polygone 3D en polygone 2D en supprimant une coord = *) @@ -345,10 +345,10 @@ let poly_3d_to_poly_2d axis poly = List.map (pt_3d_to_pt_2d axis) poly (* ============================================================================= *) let point_in_plane pt a b c = let det = eval_det4 - pt.x3D pt.y3D pt.z3D 1. - a.x3D a.y3D a.z3D 1. - b.x3D b.y3D b.z3D 1. - c.x3D c.y3D c.z3D 1. + pt.x3D pt.y3D pt.z3D 1. + a.x3D a.y3D a.z3D 1. + b.x3D b.y3D b.z3D 1. + c.x3D c.y3D c.z3D 1. in abs_float det < epsilon @@ -358,16 +358,16 @@ let point_in_plane pt a b c = (* ============================================================================= *) let span_poly poly = let set_min_max valeur min max = - if valeur < !min then min:=valeur else if valeur > !max then max:=valeur + if valeur < !min then min:=valeur else if valeur > !max then max:=valeur in let p = List.hd (poly) in let minx = ref p.x3D and maxx = ref p.y3D and miny = ref p.y3D and maxy = ref p.y3D and minz = ref p.z3D and maxz = ref p.z3D in List.iter (fun p -> - set_min_max p.x3D minx maxx ; - set_min_max p.y3D miny maxy ; - set_min_max p.z3D minz maxz) (List.tl poly) ; + set_min_max p.x3D minx maxx ; + set_min_max p.y3D miny maxy ; + set_min_max p.z3D minz maxz) (List.tl poly) ; (* Renvoie les etendues sur chaque axe *) (!maxx-. !minx, !maxy-. !miny, !maxz-. !minz) @@ -377,8 +377,8 @@ let span_poly poly = let poly_3d_to_poly_2d_smallest_span poly = let (dx, dy, dz) = span_poly poly in let axis = - if dx= 3 then begin - (* Simplification du polygone *) - let (new_poly, axis) = poly_3d_to_poly_2d_smallest_span poly in - (* Simplification du point a tester suivant le meme axe *) - let new_pt = pt_3d_to_pt_2d axis pt in - (* Utilisation de la fonction 2D pour tester l'inclusion *) - Geometry_2d.point_in_poly new_pt new_poly + (* Simplification du polygone *) + let (new_poly, axis) = poly_3d_to_poly_2d_smallest_span poly in + (* Simplification du point a tester suivant le meme axe *) + let new_pt = pt_3d_to_pt_2d axis pt in + (* Utilisation de la fonction 2D pour tester l'inclusion *) + Geometry_2d.point_in_poly new_pt new_poly end else false (* ============================================================================= *) @@ -401,11 +401,11 @@ let point_in_poly_2D pt poly = (* ============================================================================= *) let poly_normal poly = if List.length poly >= 3 then begin - (* 3 points du polygone qui definissent le plan le contenant *) - let a = List.hd poly and b = List.hd (List.tl poly) - and c = List.hd (List.tl (List.tl poly)) in - (* Normale unitaire au plan contenant le polygone *) - normal (vect_make a b) (vect_make b c) + (* 3 points du polygone qui definissent le plan le contenant *) + let a = List.hd poly and b = List.hd (List.tl poly) + and c = List.hd (List.tl (List.tl poly)) in + (* Normale unitaire au plan contenant le polygone *) + normal (vect_make a b) (vect_make b c) end else null_vector (* ============================================================================= *) @@ -413,15 +413,15 @@ let poly_normal poly = (* ============================================================================= *) let point_in_poly pt poly = if List.length poly >= 3 then begin - (* 3 points du polygone qui definissent le plan le contenant *) - let a = List.hd poly and b = List.hd (List.tl poly) - and c = List.hd (List.tl (List.tl poly)) in + (* 3 points du polygone qui definissent le plan le contenant *) + let a = List.hd poly and b = List.hd (List.tl poly) + and c = List.hd (List.tl (List.tl poly)) in - (* Le point est-il dans le plan contenant le polygone ? *) - if point_in_plane pt a b c then - (* Oui, on teste alors en projetant en 2D *) - point_in_poly_2D pt poly - else false + (* Le point est-il dans le plan contenant le polygone ? *) + if point_in_plane pt a b c then + (* Oui, on teste alors en projetant en 2D *) + point_in_poly_2D pt poly + else false end else false (* ============================================================================= *) @@ -429,12 +429,12 @@ let point_in_poly pt poly = (* ============================================================================= *) let poly_signed_area poly = if List.length poly >= 3 then begin - let poly_closed = poly_close2 poly and vect = ref null_vector in - for i = 0 to (List.length poly)-1 do - vect := vect_add !vect (cross_product poly_closed.(i) poly_closed.(i+1)) - done ; + let poly_closed = poly_close2 poly and vect = ref null_vector in + for i = 0 to (List.length poly)-1 do + vect := vect_add !vect (cross_product poly_closed.(i) poly_closed.(i+1)) + done ; - (dot_product (poly_normal poly) !vect)/.2. + (dot_product (poly_normal poly) !vect)/.2. end else 0. (* ============================================================================= *) @@ -453,33 +453,33 @@ let poly_centroid poly = (* Centroide d'un triangle *) let centroid_triangle p1 p2 p3 = - {x3D=(p1.x3D+.p2.x3D+.p3.x3D)/.3.; - y3D=(p1.y3D+.p2.y3D+.p3.y3D)/.3.; - z3D=(p1.z3D+.p2.z3D+.p3.z3D)/.3.} in + {x3D=(p1.x3D+.p2.x3D+.p3.x3D)/.3.; + y3D=(p1.y3D+.p2.y3D+.p3.y3D)/.3.; + z3D=(p1.z3D+.p2.z3D+.p3.z3D)/.3.} in (* Normale au plan contenant le polygone *) let n = poly_normal poly in (* Aire signee d'un triangle, pas besoin de poly_area... *) let area_triangle p1 p2 p3 = - (dot_product n (cross_product (vect_make p1 p2) (vect_make p1 p3)))/.2. in + (dot_product n (cross_product (vect_make p1 p2) (vect_make p1 p3)))/.2. in let rec f p0 l centroid = - match l with - p1::p2::reste -> - let new_centroid = vect_add_mul_scal (area_triangle p0 p1 p2) centroid - (centroid_triangle p0 p1 p2) in - f p0 (p2::reste) new_centroid - | _ -> - let area = poly_signed_area poly in - vect_mul_scal centroid (1./.area) + match l with + p1::p2::reste -> + let new_centroid = vect_add_mul_scal (area_triangle p0 p1 p2) centroid + (centroid_triangle p0 p1 p2) in + f p0 (p2::reste) new_centroid + | _ -> + let area = poly_signed_area poly in + vect_mul_scal centroid (1./.area) in match poly with - [] -> null_vector - | p::[] -> p - | p1::p2::[] -> point_middle p1 p2 - | _ -> f (List.hd poly) (List.tl poly) null_vector + [] -> null_vector + | p::[] -> p + | p1::p2::[] -> point_middle p1 p2 + | _ -> f (List.hd poly) (List.tl poly) null_vector (* ============================================================================= *) (* = Teste si un point est contenu dans un volume = *) @@ -489,51 +489,51 @@ let point_in_volume pt vol = (* Ajout des points a une hashtable pour compter les points en double/triple *) let add_point pt = - try let nb = Hashtbl.find t pt in Hashtbl.replace t pt (nb+1) - with Not_found -> Hashtbl.add t pt 1 + try let nb = Hashtbl.find t pt in Hashtbl.replace t pt (nb+1) + with Not_found -> Hashtbl.add t pt 1 in (* Teste si le point d'intersection est sur une des aretes du volume *) let rec point_on_one_segment pt l = - match l with - poly::reste -> - let rec f l = - match l with - p1::p2::reste -> - if point_on_segment pt p1 p2 then true else f (p2::reste) - | _ -> false - in - if f (poly_close poly) then true else point_on_one_segment pt reste - | [] -> false + match l with + poly::reste -> + let rec f l = + match l with + p1::p2::reste -> + if point_on_segment pt p1 p2 then true else f (p2::reste) + | _ -> false + in + if f (poly_close poly) then true else point_on_one_segment pt reste + | [] -> false in (* Test supplementaire pour voir si les points d'intersections se trouvent sur *) (* un des sommets ou une des aretes *) let traite_pts_inter is_in = - Hashtbl.iter (fun pt n -> - (* n=2 -> arete, n=3 -> sommet *) - if (n=2 or n=3) && point_on_one_segment pt vol then is_in:=not !is_in) t + Hashtbl.iter (fun pt n -> + (* n=2 -> arete, n=3 -> sommet *) + if (n=2 or n=3) && point_on_one_segment pt vol then is_in:=not !is_in) t in let rec find_direction lst_faces = - match lst_faces with - poly::reste -> - (* On essaie avec la direction entre le point et le centroide *) - (* de la face courante *) - let centroid = poly_centroid poly in - let dir = vect_normalize (vect_make pt centroid) in + match lst_faces with + poly::reste -> + (* On essaie avec la direction entre le point et le centroide *) + (* de la face courante *) + let centroid = poly_centroid poly in + let dir = vect_normalize (vect_make pt centroid) in - (* Normale au plan du polygone pour avoir l'angle *) - let n = poly_normal poly in + (* Normale au plan du polygone pour avoir l'angle *) + let n = poly_normal poly in - (* Rappel : les deux vecteurs dir et n sont normalises donc pas besoin *) - (* de diviser par le produit des normes pour avoir l'angle *) - let s = dot_product dir n in + (* Rappel : les deux vecteurs dir et n sont normalises donc pas besoin *) + (* de diviser par le produit des normes pour avoir l'angle *) + let s = dot_product dir n in - (* On conserve cette direction si l'angle est inferieur a ~85 degres *) - if abs_float s >=0.1 then dir - else find_direction reste - | [] -> {x3D=1.; y3D=0.; z3D=0.} + (* On conserve cette direction si l'angle est inferieur a ~85 degres *) + if abs_float s >=0.1 then dir + else find_direction reste + | [] -> {x3D=1.; y3D=0.; z3D=0.} in (* Choix d'une 'bonne' direction *) @@ -544,23 +544,23 @@ let point_in_volume pt vol = let is_in = ref false in List.iter (fun poly_face -> - if List.length poly_face>=3 then begin - (* 3 points definissant le plan contenant la face *) - let a = List.hd poly_face and b = List.hd (List.tl poly_face) - and c = List.hd (List.tl (List.tl poly_face)) in + if List.length poly_face>=3 then begin + (* 3 points definissant le plan contenant la face *) + let a = List.hd poly_face and b = List.hd (List.tl poly_face) + and c = List.hd (List.tl (List.tl poly_face)) in - (* Evaluation du point P' projete de P, suivant dir, sur le plan contenant *) - (* la face poly_face *) - match crossing_hline_plane pt dir a b c with - None -> () (* Pas d'intersection *) - | Some p -> - add_point p ; + (* Evaluation du point P' projete de P, suivant dir, sur le plan contenant *) + (* la face poly_face *) + match crossing_hline_plane pt dir a b c with + None -> () (* Pas d'intersection *) + | Some p -> + add_point p ; - (* Le point projete est-il dans le polygone constituant la face ? *) - if point_in_poly_2D p poly_face then - (* Oui -> une intersection de plus *) - is_in:=not !is_in - end) vol ; + (* Le point projete est-il dans le polygone constituant la face ? *) + if point_in_poly_2D p poly_face then + (* Oui -> une intersection de plus *) + is_in:=not !is_in + end) vol ; (* Test supplementaires pour les sommets et les aretes *) traite_pts_inter is_in ; diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 737f7fe0c3..73fb6b3efd 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -34,16 +34,16 @@ let zoom_min = 18 let cache_path = ref "/var/tmp" type tile_t = { - key : string; - sw_corner : Latlong.geographic; - width : float; (* Longitude difference *) - height : float (* Latitude difference *) - } + key : string; + sw_corner : Latlong.geographic; + width : float; (* Longitude difference *) + height : float (* Latitude difference *) +} type maps_source = Google | OSM | MS | MQ | MQ_Aerial let maps_sources = [Google; OSM; MS; MQ; MQ_Aerial] let string_of_maps_source = function - Google -> "Google" | OSM -> "OpenStreetMap" | MS -> "Bing" | MQ -> "MapQuest OSM" | MQ_Aerial -> "MapQuest Open Aerial" +Google -> "Google" | OSM -> "OpenStreetMap" | MS -> "Bing" | MQ -> "MapQuest OSM" | MQ_Aerial -> "MapQuest Open Aerial" let maps_source = ref Google let set_maps_source = fun s -> maps_source := s @@ -78,7 +78,7 @@ let gm_pos_and_scale = fun keyholeString tLat latHeight tLon lonWidth -> (** Returns a keyhole string for a longitude (x), latitude (y), and zoom - for Google Maps (http://www.ponies.me.uk/maps/GoogleTileUtils.java) *) + for Google Maps (http://www.ponies.me.uk/maps/GoogleTileUtils.java) *) let tile_of_geo = fun ?level wgs84 zoom -> let max = match level with | None -> zoom_max @@ -135,13 +135,13 @@ let tile_of_key = fun keyholeStr -> latLonSize /.= 2.; match keyholeStr.[i] with - 's' -> lon +.= !latLonSize - | 'r' -> + 's' -> lon +.= !latLonSize + | 'r' -> lat +.= !latLonSize; lon +.= !latLonSize - | 'q' -> lat +.= !latLonSize - | 't' -> () - | _ -> invalid_arg ("gm_get_lat_long " ^ keyholeStr) + | 'q' -> lat +.= !latLonSize + | 't' -> () + | _ -> invalid_arg ("gm_get_lat_long " ^ keyholeStr) done; gm_pos_and_scale keyholeStr !lat !latLonSize !lon !latLonSize @@ -149,7 +149,7 @@ let tile_of_key = fun keyholeStr -> let is_prefix = fun a b -> String.length b >= String.length a && - a = String.sub b 0 (String.length a) + a = String.sub b 0 (String.length a) (** Get the tile or one which contains it from the cache *) @@ -168,7 +168,7 @@ let get_from_cache = fun dir f -> loop (i+1) else raise Not_found - in + in loop 0 (** Translate the old quadtree naming policy into new (x,y) coordinates @@ -181,11 +181,11 @@ let xyz_of_qsrt = fun s -> x := !x * 2; y := !y * 2; match s.[i] with - 'q' -> () - | 'r' -> incr x - | 's' -> incr x; incr y - | 't' -> incr y - | _ -> failwith "xyz_of_qsrt" + 'q' -> () + | 'r' -> incr x + | 's' -> incr x; incr y + | 't' -> incr y + | _ -> failwith "xyz_of_qsrt" done; (!x, !y, n-1) @@ -196,11 +196,11 @@ let ms_key = fun key -> for i = 1 to n - 1 do ms_key.[i-1] <- match key.[i] with - 'q' -> '0' - | 'r' -> '1' - | 's' -> '3' - | 't' -> '2' - | _ -> invalid_arg "Gm.ms_key" + 'q' -> '0' + | 'r' -> '1' + | 's' -> '3' + | 't' -> '2' + | _ -> invalid_arg "Gm.ms_key" done; (ms_key, ms_key.[n-2]) @@ -209,22 +209,22 @@ let google_version = Maps_support.google_version let url_of_tile_key = fun maps_source s -> let (x, y, z) = xyz_of_qsrt s in match maps_source with - Google -> sprintf "http://khm0.google.com/kh/v=%d&x=%d&s=&y=%d&z=%d" google_version x y z - | OSM -> sprintf "http://tile.openstreetmap.org/%d/%d/%d.png" z x y - | MQ -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/osm/%d/%d/%d.png" z x y - | MQ_Aerial -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/sat/%d/%d/%d.png" z x y - | MS -> + Google -> sprintf "http://khm0.google.com/kh/v=%d&x=%d&s=&y=%d&z=%d" google_version x y z + | OSM -> sprintf "http://tile.openstreetmap.org/%d/%d/%d.png" z x y + | MQ -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/osm/%d/%d/%d.png" z x y + | MQ_Aerial -> sprintf "http://otile1.mqcdn.com/tiles/1.0.0/sat/%d/%d/%d.png" z x y + | MS -> let (key, last_char) = ms_key s in (* That's the old naming scheme, that still works as of 1st August 2010 - sprintf "http://a0.ortho.tiles.virtualearth.net/tiles/a%s.jpeg?g=%d" key (z+32) + sprintf "http://a0.ortho.tiles.virtualearth.net/tiles/a%s.jpeg?g=%d" key (z+32) *) (* That's the new code, which conforms to MS naming scheme as of 1st August 2010 *) sprintf "http://ecn.t%c.tiles.virtualearth.net/tiles/a%s.jpeg?g=516" last_char key - (**) +(**) let get_cache_dir = function - Google -> !cache_path (* Historic ! Should be // Google *) +Google -> !cache_path (* Historic ! Should be // Google *) | OSM -> !cache_path // "OSM" | MQ -> !cache_path // "MapQuest" | MQ_Aerial -> !cache_path // "MapQuestAerial" @@ -235,7 +235,7 @@ exception Not_available type policy = CacheOrHttp | NoHttp | NoCache let string_of_policy = function - CacheOrHttp -> "CacheOrHttp" +CacheOrHttp -> "CacheOrHttp" | NoHttp -> "NoHttp" | NoCache -> "NoCache" let policies = [CacheOrHttp; NoHttp; NoCache] @@ -277,7 +277,7 @@ let get_image = fun key -> try get_from_http key with _ -> (t, f) else (t, f) with - | Not_found -> + | Not_found -> if !policy = NoHttp then raise Not_available; get_from_http key diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index 80bc47173e..e550751dff 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -29,11 +29,11 @@ val tile_coverage : float -> int -> float * float (** [tile_coverage wgs84_lat zoom] Returns (width,height) *) type tile_t = { - key : string; (* [qrst] string *) - sw_corner : Latlong.geographic; - width : float; (* Longitude difference *) - height : float (* Latitude difference *) - } + key : string; (* [qrst] string *) + sw_corner : Latlong.geographic; + width : float; (* Longitude difference *) + height : float (* Latitude difference *) +} type maps_source = Google | OSM | MS | MQ | MQ_Aerial val string_of_maps_source : maps_source -> string @@ -44,11 +44,11 @@ val get_maps_source : unit -> maps_source val tile_of_geo : ?level:int -> Latlong.geographic -> int -> tile_t (** [tile_string geo zoom] Returns the tile description containing a - given point with a the smallest available zoom greater or equal to [zoom]. *) + given point with a the smallest available zoom greater or equal to [zoom]. *) val tile_of_key : string -> tile_t (** [tile_of_key google_maps_tile_key] Returns tile description of a - named tile. *) + named tile. *) val cache_path : string ref diff --git a/sw/lib/ocaml/gtk_3d.ml b/sw/lib/ocaml/gtk_3d.ml index b32d9ca355..7846955033 100644 --- a/sw/lib/ocaml/gtk_3d.ml +++ b/sw/lib/ocaml/gtk_3d.ml @@ -108,79 +108,79 @@ type t_triangulation = (* Volume 3D *) type vol3d = { - vol3d_contour : glpoint3d list ; (* Faces verticales (quad_strip) *) - vol3d_up : t_triangulation ; (* Face horizontale superieure *) - vol3d_down : t_triangulation ; (* Face horizontale inferieure *) - mutable vol3d_color : glcolor ; (* Couleur du volume *) - mutable vol3d_filled : bool (* Volume plein ou fil de fer *) - } + vol3d_contour : glpoint3d list ; (* Faces verticales (quad_strip) *) + vol3d_up : t_triangulation ; (* Face horizontale superieure *) + vol3d_down : t_triangulation ; (* Face horizontale inferieure *) + mutable vol3d_color : glcolor ; (* Couleur du volume *) + mutable vol3d_filled : bool (* Volume plein ou fil de fer *) +} (* Volume d'une enveloppe 3D *) type env3d ={ - env3d_contour : glpoint3d list ; (* Faces laterales (quad_strip) *) - mutable env3d_color : glcolor ; (* Couleur du volume *) - mutable env3d_filled : bool (* Volume plein ou fil de fer *) - } + env3d_contour : glpoint3d list ; (* Faces laterales (quad_strip) *) + mutable env3d_color : glcolor ; (* Couleur du volume *) + mutable env3d_filled : bool (* Volume plein ou fil de fer *) +} (* Volume d'une enveloppe 3D *) type env3d_double ={ - env3d_double_contour_out : glpoint3d list ; (* Faces laterales externes (quad_strip) *) - env3d_double_contour_in : glpoint3d list ; (* Faces laterales internes (quad_strip) *) - mutable env3d_double_color_out : glcolor ; (* Couleur des faces externes *) - mutable env3d_double_color_in : glcolor ; (* Couleur des faces internes *) - mutable env3d_double_filled : bool (* Volume plein ou fil de fer *) - } + env3d_double_contour_out : glpoint3d list ; (* Faces laterales externes (quad_strip) *) + env3d_double_contour_in : glpoint3d list ; (* Faces laterales internes (quad_strip) *) + mutable env3d_double_color_out : glcolor ; (* Couleur des faces externes *) + mutable env3d_double_color_in : glcolor ; (* Couleur des faces internes *) + mutable env3d_double_filled : bool (* Volume plein ou fil de fer *) +} (* Contour 3D *) type out3d = { - out3d_contour : glpoint3d list ; (* Liste des points du contour *) - mutable out3d_color_in : glcolor ; (* Couleur interieure *) - mutable out3d_color_out : glcolor ; (* Couleur du contour *) - mutable out3d_filled : bool (* Contour plein ou fil de fer *) - } + out3d_contour : glpoint3d list ; (* Liste des points du contour *) + mutable out3d_color_in : glcolor ; (* Couleur interieure *) + mutable out3d_color_out : glcolor ; (* Couleur du contour *) + mutable out3d_filled : bool (* Contour plein ou fil de fer *) +} (* Ligne 3D *) type line3d = { - line3d_points : glpoint3d list ; (* Points de la ligne *) - mutable line3d_width : int ; (* Epaisseur *) - mutable line3d_color : glcolor ; (* Couleur *) - mutable line3d_with_bars : bool ; (* Barres verticales *) - mutable line3d_filled : bool (* Surface jusqu'au sol *) - } + line3d_points : glpoint3d list ; (* Points de la ligne *) + mutable line3d_width : int ; (* Epaisseur *) + mutable line3d_color : glcolor ; (* Couleur *) + mutable line3d_with_bars : bool ; (* Barres verticales *) + mutable line3d_filled : bool (* Surface jusqu'au sol *) +} (* Fleche 3D *) type arr3d = { - arr3d_contour : (glpoint3d list) list ; (* Faces verticales (quad_strip) *) - arr3d_pt : glpoint3d ; (* Deplacement et rotation de la fleche car *) - arr3d_vect : glpoint3d ; (* elle est creee le long de l'axe X. Il faut*) - arr3d_angle_xy : float ; (* donc la remettre dans la bonne direction *) - arr3d_angle_z : float ; - mutable arr3d_color : glcolor ; (* Couleur de la fleche *) - mutable arr3d_filled : bool (* Fleche pleine ? *) - } + arr3d_contour : (glpoint3d list) list ; (* Faces verticales (quad_strip) *) + arr3d_pt : glpoint3d ; (* Deplacement et rotation de la fleche car *) + arr3d_vect : glpoint3d ; (* elle est creee le long de l'axe X. Il faut*) + arr3d_angle_xy : float ; (* donc la remettre dans la bonne direction *) + arr3d_angle_z : float ; + mutable arr3d_color : glcolor ; (* Couleur de la fleche *) + mutable arr3d_filled : bool (* Fleche pleine ? *) +} (* Point 3D *) type point3d ={ - p3d_pos : glpoint3d ; (* Position 3D du point *) - p3d_pos2 : glpoint3d ; (* Position du nom du point *) - p3d_name : string ; (* Nom du point *) - mutable p3d_with_name : bool ; (* Affichage du nom *) - mutable p3d_color : glcolor (* Couleur du point *) - } + p3d_pos : glpoint3d ; (* Position 3D du point *) + p3d_pos2 : glpoint3d ; (* Position du nom du point *) + p3d_name : string ; (* Nom du point *) + mutable p3d_with_name : bool ; (* Affichage du nom *) + mutable p3d_color : glcolor (* Couleur du point *) +} (* Surface triangulee en 3D *) type surf3d = { - s3d_pts : (glpoint3d*glcolor) array array ; - mutable s3d_filled : bool - } + s3d_pts : (glpoint3d*glcolor) array array ; + mutable s3d_filled : bool +} (* Surface triangulee en 3D avec une texture *) type surf3d_tex = { - s3d_tex_pts : glpoint3d array array ; (* Tableau des points de la surface *) - s3d_tex_texture_id : GlTex.texture_id (* Id de la texture a appliquer *) - } + s3d_tex_pts : glpoint3d array array ; (* Tableau des points de la surface *) + s3d_tex_texture_id : GlTex.texture_id (* Id de la texture a appliquer *) +} (* Type contenant tous les objets 3D possibles *) type tobj3d = @@ -192,10 +192,10 @@ type tobj3d = (* Stockage d'un objet 3D *) type obj3d = {o_obj : tobj3d ; (* L'objet *) - o_id : int ; (* Son identifiant unique *) - mutable o_compiled : GlList.t ; (* L'objet compile *) - mutable o_show : bool (* Objet affiche ou pas *) - } + o_id : int ; (* Son identifiant unique *) + mutable o_compiled : GlList.t ; (* L'objet compile *) + mutable o_show : bool (* Objet affiche ou pas *) + } (* module OImages = OImage *) (* module Images = Image *) @@ -240,7 +240,7 @@ let create_texture_from_image texture_filename = (* renvoie les informations relatives a la version d'OpenGL utilisee *) let get_gl_infos () = let l = [("Vendor", `vendor); ("Renderer", `renderer); - ("Version", `version); ("Extensions", `extensions)] in + ("Version", `version); ("Extensions", `extensions)] in let s = ref "" in List.iter (fun (str, t) -> s:=!s^str^" : "^(GlMisc.get_string t)^"\n") l ; !s @@ -268,14 +268,14 @@ let get_coord (x, y, z) axis = match axis with X_AXIS->x | Y_AXIS->y | Z_AXIS->z par [axis] *) let add_coord (x, y, z) axis d = match axis with - X_AXIS -> (x+.d, y, z) | Y_AXIS -> (x, y+.d, z) | Z_AXIS -> (x, y, z+.d) + X_AXIS -> (x+.d, y, z) | Y_AXIS -> (x, y+.d, z) | Z_AXIS -> (x, y, z+.d) (* [add_coord_360 (x, y, z) axis delta] meme chose modulo 360 *) let add_coord_360 (x, y, z) axis d = match axis with - X_AXIS -> (mod_360 (x+.d), y, z) - | Y_AXIS -> (x, mod_360 (y+.d), z) - | Z_AXIS -> (x, y, mod_360 (z+.d)) + X_AXIS -> (mod_360 (x+.d), y, z) + | Y_AXIS -> (x, mod_360 (y+.d), z) + | Z_AXIS -> (x, y, mod_360 (z+.d)) (* ============================================================================= *) (* = Encapsulation de fonctions 3D = *) @@ -293,7 +293,7 @@ let geom_normal p1 p2 p3 = let p1 = glpoint3d_to_pt_3d p1 and p2 = glpoint3d_to_pt_3d p2 and p3 = glpoint3d_to_pt_3d p3 in let n = Geometry_3d.normal (Geometry_3d.vect_make p1 p2) - (Geometry_3d.vect_make p1 p3) in + (Geometry_3d.vect_make p1 p3) in glpoint3d_of_pt_3d n let geom_scal_mult n (x, y, z) = (x*.n, y*.n, z*.n) @@ -354,9 +354,9 @@ let normal_down () = GlDraw.normal3 (0., 0., -.1.) (* [rotate axis angle] effectue une rotation suivant un axe donne *) let rotate axis angle = match axis with - X_AXIS -> GlMat.rotate ~angle ~x:1.0 () - | Y_AXIS -> GlMat.rotate ~angle ~y:1.0 () - | Z_AXIS -> GlMat.rotate ~angle ~z:1.0 () + X_AXIS -> GlMat.rotate ~angle ~x:1.0 () + | Y_AXIS -> GlMat.rotate ~angle ~y:1.0 () + | Z_AXIS -> GlMat.rotate ~angle ~z:1.0 () (* [rotate_some angles axis_list] rotation suivant les axes indiques par [axis_list]. @@ -380,21 +380,21 @@ let get_surface_normals tt = Array.mapi (fun i t0 -> Array.mapi (fun j p -> if i>0 && i < Array.length tt-1 then begin - if j>0 && j < Array.length t0-1 then begin - let n1 = geom_normal_in p tt.(i-1).(j) tt.(i).(j-1) - and n2 = geom_normal_in p tt.(i-1).(j+1) tt.(i-1).(j) - and n3 = geom_normal_in p tt.(i).(j+1) tt.(i-1).(j+1) - and n4 = geom_normal_in p tt.(i+1).(j) tt.(i).(j+1) - and n5 = geom_normal_in p tt.(i+1).(j-1) tt.(i+1).(j) - and n6 = geom_normal_in p tt.(i).(j-1) tt.(i+1).(j-1) in - let n = Geometry_3d.vect_add n1 n2 in - let n = Geometry_3d.vect_add n n3 in - let n = Geometry_3d.vect_add n n4 in - let n = Geometry_3d.vect_add n n5 in - let n = Geometry_3d.vect_add n n6 in - let n = Geometry_3d.vect_normalize n in - glpoint3d_of_pt_3d n - end else (0., 0., 1.) + if j>0 && j < Array.length t0-1 then begin + let n1 = geom_normal_in p tt.(i-1).(j) tt.(i).(j-1) + and n2 = geom_normal_in p tt.(i-1).(j+1) tt.(i-1).(j) + and n3 = geom_normal_in p tt.(i).(j+1) tt.(i-1).(j+1) + and n4 = geom_normal_in p tt.(i+1).(j) tt.(i).(j+1) + and n5 = geom_normal_in p tt.(i+1).(j-1) tt.(i+1).(j) + and n6 = geom_normal_in p tt.(i).(j-1) tt.(i+1).(j-1) in + let n = Geometry_3d.vect_add n1 n2 in + let n = Geometry_3d.vect_add n n3 in + let n = Geometry_3d.vect_add n n4 in + let n = Geometry_3d.vect_add n n5 in + let n = Geometry_3d.vect_add n n6 in + let n = Geometry_3d.vect_normalize n in + glpoint3d_of_pt_3d n + end else (0., 0., 1.) end else (0., 0., 1.)) t0) tt (* ============================================================================= *) @@ -403,66 +403,66 @@ let get_surface_normals tt = (* [get_object_color objet] renvoie la couleur de l'objet *) let get_object_color obj = match obj with - OUTLINE_3D o -> o.out3d_color_out - | LINE_3D l -> l.line3d_color - | VOLUME1_3D v -> v.vol3d_color - | ENVELOPPE_3D e -> e.env3d_color - | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_color_out - | ARROW_3D a -> a.arr3d_color - | POINT_3D p -> p.p3d_color - | SURFACE_3D _s -> glcolor_white - | SURFACE_3D_TEX _s -> glcolor_white + OUTLINE_3D o -> o.out3d_color_out + | LINE_3D l -> l.line3d_color + | VOLUME1_3D v -> v.vol3d_color + | ENVELOPPE_3D e -> e.env3d_color + | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_color_out + | ARROW_3D a -> a.arr3d_color + | POINT_3D p -> p.p3d_color + | SURFACE_3D _s -> glcolor_white + | SURFACE_3D_TEX _s -> glcolor_white (* [set_object_color objet color] met a jour la couleur de l'objet *) let set_object_color obj color = match obj with - OUTLINE_3D o -> o.out3d_color_out <- color - | LINE_3D l -> l.line3d_color <- color - | VOLUME1_3D v -> v.vol3d_color <- color - | ENVELOPPE_3D e -> e.env3d_color <- color - | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_color_out<- color - | ARROW_3D a -> a.arr3d_color <- color - | POINT_3D p -> p.p3d_color <- color - | _ -> () + OUTLINE_3D o -> o.out3d_color_out <- color + | LINE_3D l -> l.line3d_color <- color + | VOLUME1_3D v -> v.vol3d_color <- color + | ENVELOPPE_3D e -> e.env3d_color <- color + | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_color_out<- color + | ARROW_3D a -> a.arr3d_color <- color + | POINT_3D p -> p.p3d_color <- color + | _ -> () (* [get_outline_in_color objet id] renvoie la couleur de remplissage d'un objet de type [OUTLINE_3D]. Si l'objet n'est pas de ce type, l'exception {!Gtk_3d.NOT_A_3D_OUTLINE} est levee *) let get_outline_in_color obj id = match obj with OUTLINE_3D o -> o.out3d_color_in - | _ -> raise (NOT_A_3D_OUTLINE id) + | _ -> raise (NOT_A_3D_OUTLINE id) (* [set_outline_in_color objet color id] met a jour la couleur de remplissage pour un objet de type [OUTLINE_3D]. Si l'objet n'est pas de ce type, l'exception {!Gtk_3d.NOT_A_3D_OUTLINE} est levee *) let set_outline_in_color obj color id = match obj with OUTLINE_3D o -> o.out3d_color_in <- color - | _ -> raise (NOT_A_3D_OUTLINE id) + | _ -> raise (NOT_A_3D_OUTLINE id) (* [get_object_fill objet] indique si l'objet est rempli ou en fil de fer *) let get_object_fill obj = match obj with - OUTLINE_3D o -> o.out3d_filled - | LINE_3D l -> l.line3d_filled - | VOLUME1_3D v -> v.vol3d_filled - | ENVELOPPE_3D e -> e.env3d_filled - | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled - | ARROW_3D a -> a.arr3d_filled - | POINT_3D _p -> false - | SURFACE_3D s -> s.s3d_filled - | SURFACE_3D_TEX _s -> true + OUTLINE_3D o -> o.out3d_filled + | LINE_3D l -> l.line3d_filled + | VOLUME1_3D v -> v.vol3d_filled + | ENVELOPPE_3D e -> e.env3d_filled + | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled + | ARROW_3D a -> a.arr3d_filled + | POINT_3D _p -> false + | SURFACE_3D s -> s.s3d_filled + | SURFACE_3D_TEX _s -> true (* [set_object_filled objet filled] force l'objet en mode plein ou fil de fer *) let set_object_fill obj filled = match obj with - OUTLINE_3D o -> o.out3d_filled <- filled - | LINE_3D l -> l.line3d_filled <- filled - | VOLUME1_3D v -> v.vol3d_filled <- filled - | ENVELOPPE_3D e -> e.env3d_filled <- filled - | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled <- filled - | ARROW_3D a -> a.arr3d_filled <- filled - | POINT_3D _p -> () - | SURFACE_3D s -> s.s3d_filled <- filled - | SURFACE_3D_TEX _s -> () + OUTLINE_3D o -> o.out3d_filled <- filled + | LINE_3D l -> l.line3d_filled <- filled + | VOLUME1_3D v -> v.vol3d_filled <- filled + | ENVELOPPE_3D e -> e.env3d_filled <- filled + | ENVELOPPE_3D_DOUBLE e -> e.env3d_double_filled <- filled + | ARROW_3D a -> a.arr3d_filled <- filled + | POINT_3D _p -> () + | SURFACE_3D s -> s.s3d_filled <- filled + | SURFACE_3D_TEX _s -> () (* [get_line_width objet id] renvoie l'epaisseur d'un objet ligne. Si l'objet passe n'est pas du type [LINE_3D] alors l'exception {!Gtk_3d.NOT_A_3D_LINE} @@ -509,7 +509,7 @@ let set_point_name obj name id = - [with_status_bar] permet la creation d'une barre d'infos optionnelle - [name] designe le nom a donner a la zone d'affichage (eventuellement affichee en haut a gauche de la zone) - *) +*) class widget_3d pack with_status_bar n = (* Creation de la GtkGlArea avec ou sans barre d'infos *) let (area, setstatus) = @@ -524,581 +524,581 @@ class widget_3d pack with_status_bar n = fun _msg -> ()) in - object (self) +object (self) - (* Numero du widget 3D *) - val nb = !nb_objects + (* Numero du widget 3D *) + val nb = !nb_objects - (* Nom de la fenetre eventuellement affiche en haut a gauche *) - val mutable name = n - (* Indique si le nom de la fenetre doit etre affiche *) - val mutable show_name = true + (* Nom de la fenetre eventuellement affiche en haut a gauche *) + val mutable name = n + (* Indique si le nom de la fenetre doit etre affiche *) + val mutable show_name = true - (* Contient la largeur de la fenetre apres redimensionnement *) - val mutable width = -1 - (* Contient la hauteur de la fenetre apres redimensionnement *) - val mutable height = -1 - (* Position utilisateur *) - val mutable depl = (0., 0., -.1.5) - (* Rotation utilisateur *) - val mutable rot = (290., 0., 0.) - (* Position de la source de lumiere *) - val mutable lightpos = (-.0.3, -.0.3, 0.6) - (* Rotation de la source de lumiere *) - val mutable lightrot = pt_null + (* Contient la largeur de la fenetre apres redimensionnement *) + val mutable width = -1 + (* Contient la hauteur de la fenetre apres redimensionnement *) + val mutable height = -1 + (* Position utilisateur *) + val mutable depl = (0., 0., -.1.5) + (* Rotation utilisateur *) + val mutable rot = (290., 0., 0.) + (* Position de la source de lumiere *) + val mutable lightpos = (-.0.3, -.0.3, 0.6) + (* Rotation de la source de lumiere *) + val mutable lightrot = pt_null - (* Couleur du fond *) - val mutable back_color = glcolor_black + (* Couleur du fond *) + val mutable back_color = glcolor_black - (* Point central de la scene *) - val mutable extents = pt_null - (* Rayon de la scene *) - val mutable rs = 1. - (* Extremes minis *) - val mutable extreme_min = pt_undefined - (* Extremes maxis *) - val mutable extreme_max = pt_undefined + (* Point central de la scene *) + val mutable extents = pt_null + (* Rayon de la scene *) + val mutable rs = 1. + (* Extremes minis *) + val mutable extreme_min = pt_undefined + (* Extremes maxis *) + val mutable extreme_max = pt_undefined - (* indique si l'initialisation a ete faite *) - val mutable done_init = false - (* Action souris en cours s'il y en a une *) - val mutable current_action = ACTION_NONE - (* indique si les lumieres sont utilisees *) - val mutable use_lights = true - (* indique si la source de lumiere est affichee *) - val mutable show_light = false - (* smoothing ? *) - val mutable use_smooth = true + (* indique si l'initialisation a ete faite *) + val mutable done_init = false + (* Action souris en cours s'il y en a une *) + val mutable current_action = ACTION_NONE + (* indique si les lumieres sont utilisees *) + val mutable use_lights = true + (* indique si la source de lumiere est affichee *) + val mutable show_light = false + (* smoothing ? *) + val mutable use_smooth = true - (* repertoire pour les captures ecran *) - val mutable screenshot_path = "Captures/" - (* nom par defaut de la capture *) - val mutable screenshot_name = "capture3d.png" + (* repertoire pour les captures ecran *) + val mutable screenshot_path = "Captures/" + (* nom par defaut de la capture *) + val mutable screenshot_name = "capture3d.png" - (* [triangle_fan] ou [triangle] pour afficher les surfaces triangulees *) - val mutable use_fans_for_tesselation = true + (* [triangle_fan] ou [triangle] pour afficher les surfaces triangulees *) + val mutable use_fans_for_tesselation = true - (* increment d'eloignement lie aux touches *) - val dist_incr = -.0.1 - (* increment de rotation lie aux touches *) - val rot_incr = 2. + (* increment d'eloignement lie aux touches *) + val dist_incr = -.0.1 + (* increment de rotation lie aux touches *) + val rot_incr = 2. - (* Rotation pendant l'animation *) - val rot_anim = 0.1 + (* Rotation pendant l'animation *) + val rot_anim = 0.1 - (* Compteur des objets pour les identifiants uniques *) - val mutable cpt_obj = 0 - (* Liste des objets 3D definis dans le widget 3D *) - val mutable objects = ([]:obj3d list) + (* Compteur des objets pour les identifiants uniques *) + val mutable cpt_obj = 0 + (* Liste des objets 3D definis dans le widget 3D *) + val mutable objects = ([]:obj3d list) - (* indique si la rosace doit etre affichee *) - val mutable show_rosace = true - (* Objet rosace *) - val mutable rosace = None + (* indique si la rosace doit etre affichee *) + val mutable show_rosace = true + (* Objet rosace *) + val mutable rosace = None - (* Fonte OpenGL si disponible (i.e sous Unix) *) - val mutable fontbase = Obj.magic ~-1 + (* Fonte OpenGL si disponible (i.e sous Unix) *) + val mutable fontbase = Obj.magic ~-1 - (* Timer utilise pour l'animation *) - val mutable animation_timer = None + (* Timer utilise pour l'animation *) + val mutable animation_timer = None - (* cree un nouvel identifiant *) - method private get_new_id = let n = cpt_obj in cpt_obj<-cpt_obj+1; n + (* cree un nouvel identifiant *) + method private get_new_id = let n = cpt_obj in cpt_obj<-cpt_obj+1; n - (* Indique a OpenGL que la fenetre est la fenetre courante - dans laquelle doivent etre effectuees les commandes OpenGL - A faire absolument avant d'ajouter des objets pour que la - bonne fenetre recoive les commandes OpenGL qui suivent... *) - method private make_current = area#make_current () + (* Indique a OpenGL que la fenetre est la fenetre courante + dans laquelle doivent etre effectuees les commandes OpenGL + A faire absolument avant d'ajouter des objets pour que la + bonne fenetre recoive les commandes OpenGL qui suivent... *) + method private make_current = area#make_current () - (* Mise a jour de la barre d'infos *) - method private set_status = - let msg = ref "" in - let add txt = msg:=if !msg="" then txt else !msg^" "^txt in - let (x, y, z) = rot in - add (Printf.sprintf "X=%.0f Y=%.0f Z=%.0f" x y z) ; - let (_, _, z) = depl in - add (Printf.sprintf "Dist=%.1f" (-.z)) ; - add (if use_lights then "Lights on " else "Lights off") ; - add (if use_smooth then "Smooth on " else "Smooth off") ; - setstatus !msg + (* Mise a jour de la barre d'infos *) + method private set_status = + let msg = ref "" in + let add txt = msg:=if !msg="" then txt else !msg^" "^txt in + let (x, y, z) = rot in + add (Printf.sprintf "X=%.0f Y=%.0f Z=%.0f" x y z) ; + let (_, _, z) = depl in + add (Printf.sprintf "Dist=%.1f" (-.z)) ; + add (if use_lights then "Lights on " else "Lights off") ; + add (if use_smooth then "Smooth on " else "Smooth off") ; + setstatus !msg - (* force l'utilisation de la lumiere *) - method lights_on = use_lights <- true; self#update_lights - (* annule l'utilisation de la lumiere *) - method lights_off = use_lights <- false; self#update_lights - (* change l'etat d'utilisation de la lumiere *) - method lights_switch = use_lights <- not use_lights; self#update_lights - (* met a jour le widget pour utiliser ou pas les lumieres suivant - la valeur de [use_lights] *) - method private update_lights = - do_msg (if use_lights then "Lights on" else "Lights off") ; - List.iter (if use_lights then Gl.enable else Gl.disable) lights ; - self#setup; self#display_func + (* force l'utilisation de la lumiere *) + method lights_on = use_lights <- true; self#update_lights + (* annule l'utilisation de la lumiere *) + method lights_off = use_lights <- false; self#update_lights + (* change l'etat d'utilisation de la lumiere *) + method lights_switch = use_lights <- not use_lights; self#update_lights + (* met a jour le widget pour utiliser ou pas les lumieres suivant + la valeur de [use_lights] *) + method private update_lights = + do_msg (if use_lights then "Lights on" else "Lights off") ; + List.iter (if use_lights then Gl.enable else Gl.disable) lights ; + self#setup; self#display_func - (* force l'utilisation du lissage *) - method smooth_on = use_smooth <- true; self#update_smooth - (* annule l'utilisation du lissage *) - method smooth_off = use_smooth <- false; self#update_smooth - (* change l'etat d'utilisation du lissage *) - method smooth_switch = use_smooth <- not use_smooth; self#update_smooth - (* met a jour le widget 3D pour appliquer ou pas le lissage suivant la - valeur de [use_smooth] *) - method private update_smooth = - do_msg (if use_smooth then "Smooth on" else "Smooth off") ; - GlDraw.shade_model (if use_smooth then `smooth else `flat) ; - self#set_status ; self#display_func + (* force l'utilisation du lissage *) + method smooth_on = use_smooth <- true; self#update_smooth + (* annule l'utilisation du lissage *) + method smooth_off = use_smooth <- false; self#update_smooth + (* change l'etat d'utilisation du lissage *) + method smooth_switch = use_smooth <- not use_smooth; self#update_smooth + (* met a jour le widget 3D pour appliquer ou pas le lissage suivant la + valeur de [use_smooth] *) + method private update_smooth = + do_msg (if use_smooth then "Smooth on" else "Smooth off") ; + GlDraw.shade_model (if use_smooth then `smooth else `flat) ; + self#set_status ; self#display_func - (* affiche la rosace *) - method rosace_on = show_rosace <- true; self#display_func - (* masque la rosace *) - method rosace_off = show_rosace <- false; self#display_func - (* change l'etat d'affichage de la rosace suivant la valeur de [show_rosace] *) - method rosace_switch = show_rosace <- not show_rosace; self#display_func + (* affiche la rosace *) + method rosace_on = show_rosace <- true; self#display_func + (* masque la rosace *) + method rosace_off = show_rosace <- false; self#display_func + (* change l'etat d'affichage de la rosace suivant la valeur de [show_rosace] *) + method rosace_switch = show_rosace <- not show_rosace; self#display_func - (* Modification de la vue et redessin *) - method change_and_redraw = self#setup; self#display_func + (* Modification de la vue et redessin *) + method change_and_redraw = self#setup; self#display_func - (* Rotation/deplacement de la position utilisateur *) - method rotate_view r = rot<-r; self#change_and_redraw - method move_view d = depl<-d; self#change_and_redraw + (* Rotation/deplacement de la position utilisateur *) + method rotate_view r = rot<-r; self#change_and_redraw + method move_view d = depl<-d; self#change_and_redraw - (* Modification du curseur *) - method private set_cursor c = - Gtk_tools.set_cursor area#misc#window c - method private reset_cursor = - Gtk_tools.set_cursor area#misc#window cursor_standard + (* Modification du curseur *) + method private set_cursor c = + Gtk_tools.set_cursor area#misc#window c + method private reset_cursor = + Gtk_tools.set_cursor area#misc#window cursor_standard - (* [scale_point point] met a l'echelle un point *) - method private scale_point pt = geom_scal_mult (1./.rs) pt - (* [scale_points lst_points] met a l'echelle une liste de points *) - method private scale_points l = List.map self#scale_point l + (* [scale_point point] met a l'echelle un point *) + method private scale_point pt = geom_scal_mult (1./.rs) pt + (* [scale_points lst_points] met a l'echelle une liste de points *) + method private scale_points l = List.map self#scale_point l - (* [draw_triangulation t] dessine une face polygonale triangulee ou - pas en effectuant en plus la mise a l'echelle *) - method private draw_triangulation t = - match t with - NO_TRI l -> set_3d_points `polygon (self#scale_points l) + (* [draw_triangulation t] dessine une face polygonale triangulee ou + pas en effectuant en plus la mise a l'echelle *) + method private draw_triangulation t = + match t with + NO_TRI l -> set_3d_points `polygon (self#scale_points l) | TRI_STD l -> set_3d_points `triangles (self#scale_points l) | TRI_WITH_FANS l -> List.iter (fun l -> - set_3d_points (if List.length l>3 then `triangle_fan else `triangles) - (self#scale_points l)) l + set_3d_points (if List.length l>3 then `triangle_fan else `triangles) + (self#scale_points l)) l - (* [create_pyramid (x, y, z) size] cree une pyramide de hauteur - [size] centree en [(x, y, z)] *) - method private create_pyramid (x, y, z) size = - let d = size*.sqrt(3.)/.2. in - let a=d/.3. and b = (2.*.d)/.3. in - let p0 = (x, y, z+.b) and p1 = (x, y+.b, z-.a) - and p2 = (x-.size/.2., y-.a, z-.a) and p3 = (x+.size/.2., y-.a, z-.a) in - set_3d_points `triangle_fan [p0; p1; p2; p3; p1] ; - set_3d_points `triangles [p2; p1; p3] + (* [create_pyramid (x, y, z) size] cree une pyramide de hauteur + [size] centree en [(x, y, z)] *) + method private create_pyramid (x, y, z) size = + let d = size*.sqrt(3.)/.2. in + let a=d/.3. and b = (2.*.d)/.3. in + let p0 = (x, y, z+.b) and p1 = (x, y+.b, z-.a) + and p2 = (x-.size/.2., y-.a, z-.a) and p3 = (x+.size/.2., y-.a, z-.a) in + set_3d_points `triangle_fan [p0; p1; p2; p3; p1] ; + set_3d_points `triangles [p2; p1; p3] - (* [compile_one objet] met a l'echelle et compile l'objet *) - method private compile_one o = - GlList.delete o.o_compiled ; - let compiled = GlList.create `compile in - (match o.o_obj with - OUTLINE_3D o -> - let pts = self#scale_points o.out3d_contour in - if o.out3d_filled then begin - set_gl_fillpoly () ; set_color o.out3d_color_in ; - (* Ici il faudrait trianguler le polygone si necessaire... *) - set_3d_points `polygon pts - end ; - GlDraw.line_width 2. ; - unset_gl_fillpoly () ; set_color o.out3d_color_out ; - set_3d_points `polygon pts + (* [compile_one objet] met a l'echelle et compile l'objet *) + method private compile_one o = + GlList.delete o.o_compiled ; + let compiled = GlList.create `compile in + (match o.o_obj with + OUTLINE_3D o -> + let pts = self#scale_points o.out3d_contour in + if o.out3d_filled then begin + set_gl_fillpoly () ; set_color o.out3d_color_in ; + (* Ici il faudrait trianguler le polygone si necessaire... *) + set_3d_points `polygon pts + end ; + GlDraw.line_width 2. ; + unset_gl_fillpoly () ; set_color o.out3d_color_out ; + set_3d_points `polygon pts | LINE_3D l -> - Gl.disable `cull_face ; - let pts = self#scale_points l.line3d_points in - if l.line3d_filled or l.line3d_with_bars then begin - let lfill = List.flatten (List.map (fun (a, b, c) -> - [(a, b, 0.); (a, b, c)]) pts) in - if l.line3d_filled then begin - set_gl_fillpoly () ; set_faded_color l.line3d_color 70 ; - set_3d_points `quad_strip lfill - end ; - if l.line3d_with_bars then begin - GlDraw.line_width 2. ; - unset_gl_fillpoly () ; set_faded_color l.line3d_color 85 ; - set_3d_points `quad_strip lfill - end - end ; - GlDraw.line_width (float_of_int l.line3d_width) ; - set_color l.line3d_color ; - set_3d_points `line_strip pts ; - Gl.enable `cull_face + Gl.disable `cull_face ; + let pts = self#scale_points l.line3d_points in + if l.line3d_filled or l.line3d_with_bars then begin + let lfill = List.flatten (List.map (fun (a, b, c) -> + [(a, b, 0.); (a, b, c)]) pts) in + if l.line3d_filled then begin + set_gl_fillpoly () ; set_faded_color l.line3d_color 70 ; + set_3d_points `quad_strip lfill + end ; + if l.line3d_with_bars then begin + GlDraw.line_width 2. ; + unset_gl_fillpoly () ; set_faded_color l.line3d_color 85 ; + set_3d_points `quad_strip lfill + end + end ; + GlDraw.line_width (float_of_int l.line3d_width) ; + set_color l.line3d_color ; + set_3d_points `line_strip pts ; + Gl.enable `cull_face | VOLUME1_3D v -> - if v.vol3d_filled then set_gl_fillpoly () else begin - GlDraw.line_width 2. ; unset_gl_fillpoly () - end ; - (* Faces verticales *) - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_color v.vol3d_color ; - set_3d_points_quad_strip_with_normal (self#scale_points v.vol3d_contour) ; + if v.vol3d_filled then set_gl_fillpoly () else begin + GlDraw.line_width 2. ; unset_gl_fillpoly () + end ; + (* Faces verticales *) + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_color v.vol3d_color ; + set_3d_points_quad_strip_with_normal (self#scale_points v.vol3d_contour) ; - (* Dessin des faces inferieure et superieure avec une couleur plus sombre *) - if v.vol3d_filled then begin - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_faded_color v.vol3d_color 75 ; - normal_up () ; self#draw_triangulation v.vol3d_up ; - normal_down () ; self#draw_triangulation v.vol3d_down - end - | ENVELOPPE_3D e -> - (* Faces tjs visibles: Gl.disable `cull_face ; *) - if e.env3d_filled then set_gl_fillpoly () else begin - GlDraw.line_width 2. ; unset_gl_fillpoly () - end ; + (* Dessin des faces inferieure et superieure avec une couleur plus sombre *) + if v.vol3d_filled then begin + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_faded_color v.vol3d_color 75 ; + normal_up () ; self#draw_triangulation v.vol3d_up ; + normal_down () ; self#draw_triangulation v.vol3d_down + end + | ENVELOPPE_3D e -> + (* Faces tjs visibles: Gl.disable `cull_face ; *) + if e.env3d_filled then set_gl_fillpoly () else begin + GlDraw.line_width 2. ; unset_gl_fillpoly () + end ; - (* Faces verticales *) - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_color e.env3d_color ; - set_3d_points_quad_strip_with_normal (self#scale_points e.env3d_contour); - (*si faces env tjs visibles: Gl.enable `cull_face *) - | ENVELOPPE_3D_DOUBLE e -> - (* Faces tjs visibles: Gl.disable `cull_face ; *) - if e.env3d_double_filled then set_gl_fillpoly () else begin - GlDraw.line_width 2. ; unset_gl_fillpoly () - end ; + (* Faces verticales *) + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_color e.env3d_color ; + set_3d_points_quad_strip_with_normal (self#scale_points e.env3d_contour); + (*si faces env tjs visibles: Gl.enable `cull_face *) + | ENVELOPPE_3D_DOUBLE e -> + (* Faces tjs visibles: Gl.disable `cull_face ; *) + if e.env3d_double_filled then set_gl_fillpoly () else begin + GlDraw.line_width 2. ; unset_gl_fillpoly () + end ; - (* Faces verticales externes *) - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_color e.env3d_double_color_out ; - set_3d_points_quad_strip_with_normal - (self#scale_points e.env3d_double_contour_out); + (* Faces verticales externes *) + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_color e.env3d_double_color_out ; + set_3d_points_quad_strip_with_normal + (self#scale_points e.env3d_double_contour_out); - (* Faces verticales internes *) - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_color e.env3d_double_color_in ; - set_3d_points_quad_strip_with_normal - (self#scale_points e.env3d_double_contour_in) + (* Faces verticales internes *) + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_color e.env3d_double_color_in ; + set_3d_points_quad_strip_with_normal + (self#scale_points e.env3d_double_contour_in) - (*si faces env tjs visibles: Gl.enable `cull_face *) + (*si faces env tjs visibles: Gl.enable `cull_face *) | ARROW_3D a -> - if a.arr3d_filled then set_gl_fillpoly () else begin - GlDraw.line_width 2. ; unset_gl_fillpoly () - end ; - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_color a.arr3d_color ; + if a.arr3d_filled then set_gl_fillpoly () else begin + GlDraw.line_width 2. ; unset_gl_fillpoly () + end ; + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_color a.arr3d_color ; - GlMat.push () ; - (* Deplace la fleche sur la pointe de la fleche *) - GlMat.translate3 (self#scale_point a.arr3d_pt) ; - (* Tourne la fleche pour qu'elle soit orientee comme voulu *) - GlMat.rotate3 a.arr3d_vect ~angle:a.arr3d_angle_xy ; - (* Tourne selon Z pour remettre la fleche comme il faut *) - rotate Z_AXIS a.arr3d_angle_z ; + GlMat.push () ; + (* Deplace la fleche sur la pointe de la fleche *) + GlMat.translate3 (self#scale_point a.arr3d_pt) ; + (* Tourne la fleche pour qu'elle soit orientee comme voulu *) + GlMat.rotate3 a.arr3d_vect ~angle:a.arr3d_angle_xy ; + (* Tourne selon Z pour remettre la fleche comme il faut *) + rotate Z_AXIS a.arr3d_angle_z ; - (* Mise a l'echelle des points de la fleche *) - let l = List.map self#scale_points a.arr3d_contour in - (* Faces 'verticales' *) - set_3d_points_quad_strip_with_normal (List.flatten l) ; - if a.arr3d_filled then begin - GlLight.color_material ~face:`front `ambient_and_diffuse ; - set_faded_color a.arr3d_color 75 ; - let (up, down) = - (List.rev_map (fun l -> List.hd (List.tl l)) l, - List.map (fun l -> List.hd l) l) in - (* Faces 'horizontales' *) - normal_up () ; set_3d_points `polygon up ; - normal_down () ; set_3d_points `polygon down - end ; - GlMat.pop () + (* Mise a l'echelle des points de la fleche *) + let l = List.map self#scale_points a.arr3d_contour in + (* Faces 'verticales' *) + set_3d_points_quad_strip_with_normal (List.flatten l) ; + if a.arr3d_filled then begin + GlLight.color_material ~face:`front `ambient_and_diffuse ; + set_faded_color a.arr3d_color 75 ; + let (up, down) = + (List.rev_map (fun l -> List.hd (List.tl l)) l, + List.map (fun l -> List.hd l) l) in + (* Faces 'horizontales' *) + normal_up () ; set_3d_points `polygon up ; + normal_down () ; set_3d_points `polygon down + end ; + GlMat.pop () | POINT_3D p -> - let (x0, y0, z0) = self#scale_point p.p3d_pos - and (x, y, z) = self#scale_point p.p3d_pos2 in - set_gl_fillpoly () ; set_color p.p3d_color ; - let size = 0.02 in - self#create_pyramid (x0, y0, z0) size ; + let (x0, y0, z0) = self#scale_point p.p3d_pos + and (x, y, z) = self#scale_point p.p3d_pos2 in + set_gl_fillpoly () ; set_color p.p3d_color ; + let size = 0.02 in + self#create_pyramid (x0, y0, z0) size ; - if p.p3d_with_name then begin - GlDraw.line_width 2.0 ; - set_3d_points `line_strip [(x, y, z); (x0, y0, z0+.size)] ; - if fonts_available then begin - GlPix.raster_pos ~x ~y ~z:(z+.0.01) () ; - Gtkgl_Hack.gl_print_string fontbase p.p3d_name - end - end ; + if p.p3d_with_name then begin + GlDraw.line_width 2.0 ; + set_3d_points `line_strip [(x, y, z); (x0, y0, z0+.size)] ; + if fonts_available then begin + GlPix.raster_pos ~x ~y ~z:(z+.0.01) () ; + Gtkgl_Hack.gl_print_string fontbase p.p3d_name + end + end ; | SURFACE_3D_TEX s -> - normal_up () ; - let tt = Array.map (Array.map self#scale_point) s.s3d_tex_pts in - (* On recentre les coordonnees dans la texture pour la voir en entier *) - (* sur toute la surface *) - let (x1,y1,_) = tt.(0).(0) and ttt = tt.(Array.length tt-1) in - let (x2,y2,_) = ttt.(Array.length ttt-1) in - let delta = (x2-.x1, y2-.y1) and first = (x1, y1) in + normal_up () ; + let tt = Array.map (Array.map self#scale_point) s.s3d_tex_pts in + (* On recentre les coordonnees dans la texture pour la voir en entier *) + (* sur toute la surface *) + let (x1,y1,_) = tt.(0).(0) and ttt = tt.(Array.length tt-1) in + let (x2,y2,_) = ttt.(Array.length ttt-1) in + let delta = (x2-.x1, y2-.y1) and first = (x1, y1) in - let t_normals = get_surface_normals tt in - Gl.enable `texture_2d; GlDraw.shade_model `flat ; - (* On utilise la texture indiquee *) - GlTex.bind_texture `texture_2d s.s3d_tex_texture_id; - Array.iteri (fun i t0 -> - if i - l:=(tt.(i+1).(j), t_normals.(i+1).(j))::(p, t_normals.(i).(j))::!l) t0 ; - set_3d_points_with_texture `triangle_strip (List.rev !l) delta first - end) tt ; - Gl.disable `texture_2d ; - GlDraw.shade_model (if use_smooth then `smooth else `flat) + let t_normals = get_surface_normals tt in + Gl.enable `texture_2d; GlDraw.shade_model `flat ; + (* On utilise la texture indiquee *) + GlTex.bind_texture `texture_2d s.s3d_tex_texture_id; + Array.iteri (fun i t0 -> + if i + l:=(tt.(i+1).(j), t_normals.(i+1).(j))::(p, t_normals.(i).(j))::!l) t0 ; + set_3d_points_with_texture `triangle_strip (List.rev !l) delta first + end) tt ; + Gl.disable `texture_2d ; + GlDraw.shade_model (if use_smooth then `smooth else `flat) | SURFACE_3D s -> - if s.s3d_filled then set_gl_fillpoly () else begin - GlDraw.line_width 2. ; unset_gl_fillpoly () - end ; - GlLight.color_material ~face:`front `ambient_and_diffuse ; - normal_up () ; - let t = Array.map (Array.map (fun (p, c) -> (self#scale_point p, c))) s.s3d_pts in + if s.s3d_filled then set_gl_fillpoly () else begin + GlDraw.line_width 2. ; unset_gl_fillpoly () + end ; + GlLight.color_material ~face:`front `ambient_and_diffuse ; + normal_up () ; + let t = Array.map (Array.map (fun (p, c) -> (self#scale_point p, c))) s.s3d_pts in - let t_normals = get_surface_normals (Array.map (Array.map fst) t) in - Array.iteri (fun i t0 -> - if i - l:=(t.(i+1).(j), t_normals.(i+1).(j))::(p, t_normals.(i).(j))::!l) t0 ; - set_3d_points_with_color `triangle_strip (List.rev !l) - end) t + let t_normals = get_surface_normals (Array.map (Array.map fst) t) in + Array.iteri (fun i t0 -> + if i + l:=(t.(i+1).(j), t_normals.(i+1).(j))::(p, t_normals.(i).(j))::!l) t0 ; + set_3d_points_with_color `triangle_strip (List.rev !l) + end) t ) ; GlList.ends () ; o.o_compiled <- compiled - (* recompilation de tous les objets contenus dans le widget *) + (* recompilation de tous les objets contenus dans le widget *) method private recompile_all_objects = List.iter self#compile_one objects - (* [make_and_compile objet] compile uniquement l'objet indique *) + (* [make_and_compile objet] compile uniquement l'objet indique *) method private make_and_compile o = self#make_current ; self#compile_one o - (* [add_object objet] ajoute l'objet : compilation de cet objet et eventuelle - recompilation des autres s'il sort des extremes precedents *) + (* [add_object objet] ajoute l'objet : compilation de cet objet et eventuelle + recompilation des autres s'il sort des extremes precedents *) method private add_object o = self#make_current ; let new_o = {o_obj=o; o_id=self#get_new_id; - o_compiled=not_compiled_obj; o_show=true} in + o_compiled=not_compiled_obj; o_show=true} in objects <- new_o::objects ; (* Recherche des valeurs extremes de cet objet si necessaire *) let old_rs = rs in let (do_it, l) = - match o with - OUTLINE_3D _o -> (false, []) - | LINE_3D l -> (true, l.line3d_points) - | VOLUME1_3D v -> (true, v.vol3d_contour) - | ENVELOPPE_3D e -> (true, e.env3d_contour) - | ENVELOPPE_3D_DOUBLE e -> (true, e.env3d_double_contour_out) - | ARROW_3D _a -> (false, []) - | POINT_3D p -> (true, [p.p3d_pos; p.p3d_pos2]) - | SURFACE_3D s -> - let l = Array.to_list (Array.map (fun t -> Array.to_list t) s.s3d_pts) in - (true, List.map fst (List.flatten l)) - | SURFACE_3D_TEX s -> - let l = Array.to_list (Array.map (fun t -> Array.to_list t) s.s3d_tex_pts) in - (true, List.flatten l) + match o with + OUTLINE_3D _o -> (false, []) + | LINE_3D l -> (true, l.line3d_points) + | VOLUME1_3D v -> (true, v.vol3d_contour) + | ENVELOPPE_3D e -> (true, e.env3d_contour) + | ENVELOPPE_3D_DOUBLE e -> (true, e.env3d_double_contour_out) + | ARROW_3D _a -> (false, []) + | POINT_3D p -> (true, [p.p3d_pos; p.p3d_pos2]) + | SURFACE_3D s -> + let l = Array.to_list (Array.map (fun t -> Array.to_list t) s.s3d_pts) in + (true, List.map fst (List.flatten l)) + | SURFACE_3D_TEX s -> + let l = Array.to_list (Array.map (fun t -> Array.to_list t) s.s3d_tex_pts) in + (true, List.flatten l) in if do_it then self#get_extremes l ; if old_rs<>rs then - (* Il faut recompiler les autres objets car les extremes ont change... *) - self#recompile_all_objects + (* Il faut recompiler les autres objets car les extremes ont change... *) + self#recompile_all_objects else - (* Compilation uniquement de cet objet *) - self#compile_one new_o ; + (* Compilation uniquement de cet objet *) + self#compile_one new_o ; (* Renvoie l'identifiant du nouvel objet cree *) new_o.o_id - (* [get_extremes pts_list] recherche les points extremes d'un objet, met - a jour les valeurs pour la scene et reaffiche si necessaire *) + (* [get_extremes pts_list] recherche les points extremes d'un objet, met + a jour les valeurs pour la scene et reaffiche si necessaire *) method private get_extremes pts_list = if pts_list <> [] then begin - let (p1, p2) = - if extreme_min=pt_undefined && extreme_max=pt_undefined then - (List.hd pts_list, List.hd pts_list) - else (extreme_min, extreme_max) - in + let (p1, p2) = + if extreme_min=pt_undefined && extreme_max=pt_undefined then + (List.hd pts_list, List.hd pts_list) + else (extreme_min, extreme_max) + in - let minmax coord l = - let dep = (get_coord p1 coord, get_coord p2 coord) in - List.fold_left (fun (i, a) e0 -> - let e = get_coord e0 coord in (min e i, max e a)) dep l - in + let minmax coord l = + let dep = (get_coord p1 coord, get_coord p2 coord) in + List.fold_left (fun (i, a) e0 -> + let e = get_coord e0 coord in (min e i, max e a)) dep l + in - let (minx, maxx) = minmax X_AXIS pts_list - and (miny, maxy) = minmax Y_AXIS pts_list - and (minz, maxz) = minmax Z_AXIS pts_list in - let cc i a = (a +. i) /. 2. in - let r = max (maxx -. minx) (maxy -. miny) in - rs <- max r (maxz -. minz) ; - extreme_min <- (minx, miny, minz) ; - extreme_max <- (maxx, maxy, maxz) ; - let new_extents = self#scale_point (-.(cc minx maxx), -.(cc miny maxy), - -.(cc minz maxz)) in - if new_extents<>extents then begin - extents<-new_extents ; self#setup - end + let (minx, maxx) = minmax X_AXIS pts_list + and (miny, maxy) = minmax Y_AXIS pts_list + and (minz, maxz) = minmax Z_AXIS pts_list in + let cc i a = (a +. i) /. 2. in + let r = max (maxx -. minx) (maxy -. miny) in + rs <- max r (maxz -. minz) ; + extreme_min <- (minx, miny, minz) ; + extreme_max <- (maxx, maxy, maxz) ; + let new_extents = self#scale_point (-.(cc minx maxx), -.(cc miny maxy), + -.(cc minz maxz)) in + if new_extents<>extents then begin + extents<-new_extents ; self#setup + end end - (* Volume simple du type secteur ou seul le contour et les niveaux *) - (* inf et sup suffisent *) + (* Volume simple du type secteur ou seul le contour et les niveaux *) + (* inf et sup suffisent *) method add_object_volume_simple contour zmin zmax color filled = (* Le contour doit etre oriente dans le sens contre-horaire (cull_face) *) let contour = - if poly_test_ccw contour = CW then contour else List.rev contour in + if poly_test_ccw contour = CW then contour else List.rev contour in let l0 = geom_close_poly ((List.map (fun p -> [glpoint3d_of_pt_2d zmin p; - glpoint3d_of_pt_2d zmax p]) - ) contour) in + glpoint3d_of_pt_2d zmax p]) + ) contour) in (* Triangulation ou pas des faces superieures et inferieures *) let (down, up) = - if poly_test_convex contour = CONVEX then - (NO_TRI (List.map (fun l -> List.hd l) l0), - NO_TRI (List.rev_map (fun l -> List.hd (List.tl l)) l0)) - else begin - if use_fans_for_tesselation then begin - let fans = Geometry_2d.tesselation_fans contour in - let l1 = List.map (List.map (glpoint3d_of_pt_2d zmin)) fans - and l2 = List.map (fun lst -> - let l = List.map (glpoint3d_of_pt_2d zmax) lst in - (* Le premier point ne doit pas se trouver en dernier *) - (* car c'est le pivot du triangle_fan *) - (List.hd l)::(List.rev (List.tl l))) fans in - (TRI_WITH_FANS l1, TRI_WITH_FANS l2) - end else begin - let triangles = List.flatten (Geometry_2d.tesselation contour) in - let l1 = List.map (glpoint3d_of_pt_2d zmin) triangles - and l2 = List.rev_map (glpoint3d_of_pt_2d zmax) triangles in - (TRI_STD l1, TRI_STD l2) - end - end + if poly_test_convex contour = CONVEX then + (NO_TRI (List.map (fun l -> List.hd l) l0), + NO_TRI (List.rev_map (fun l -> List.hd (List.tl l)) l0)) + else begin + if use_fans_for_tesselation then begin + let fans = Geometry_2d.tesselation_fans contour in + let l1 = List.map (List.map (glpoint3d_of_pt_2d zmin)) fans + and l2 = List.map (fun lst -> + let l = List.map (glpoint3d_of_pt_2d zmax) lst in + (* Le premier point ne doit pas se trouver en dernier *) + (* car c'est le pivot du triangle_fan *) + (List.hd l)::(List.rev (List.tl l))) fans in + (TRI_WITH_FANS l1, TRI_WITH_FANS l2) + end else begin + let triangles = List.flatten (Geometry_2d.tesselation contour) in + let l1 = List.map (glpoint3d_of_pt_2d zmin) triangles + and l2 = List.rev_map (glpoint3d_of_pt_2d zmax) triangles in + (TRI_STD l1, TRI_STD l2) + end + end in self#add_object (VOLUME1_3D {vol3d_contour = List.flatten l0; - vol3d_up = up; - vol3d_down = down; - vol3d_color = color; - vol3d_filled = filled}) - (* Enveloppe 3D : faces laterales liant un contour_haut et un contour_bas *) - (* 2 contours = meme nombre de points, oriente dans le sens contre-horaire *) + vol3d_up = up; + vol3d_down = down; + vol3d_color = color; + vol3d_filled = filled}) + (* Enveloppe 3D : faces laterales liant un contour_haut et un contour_bas *) + (* 2 contours = meme nombre de points, oriente dans le sens contre-horaire *) method add_object_enveloppe contour_haut contour_bas color filled = let add_p p_bas p_haut res = - (glpoint3d_of_pt_3d p_bas)::(glpoint3d_of_pt_3d p_haut)::res + (glpoint3d_of_pt_3d p_bas)::(glpoint3d_of_pt_3d p_haut)::res in let cw_poly c = - let contour_2d = List.map (pt_3d_to_pt_2d T_Z3D) c in - if (poly_test_ccw contour_2d = CW) then c else List.rev c + let contour_2d = List.map (pt_3d_to_pt_2d T_Z3D) c in + if (poly_test_ccw contour_2d = CW) then c else List.rev c in let l_bas = geom_close_poly (cw_poly contour_bas) in let l_haut = geom_close_poly (cw_poly contour_haut) in let l0 = - try List.fold_right2 add_p l_bas l_haut [] - with x-> Printf.printf "\nadd_object_enveloppe.fold... : "; raise x + try List.fold_right2 add_p l_bas l_haut [] + with x-> Printf.printf "\nadd_object_enveloppe.fold... : "; raise x in try - self#add_object (ENVELOPPE_3D {env3d_contour = l0; - env3d_color = color; - env3d_filled = filled}) + self#add_object (ENVELOPPE_3D {env3d_contour = l0; + env3d_color = color; + env3d_filled = filled}) with x -> - Printf.printf "\nadd_object_enveloppe. self#add_object "; raise x + Printf.printf "\nadd_object_enveloppe. self#add_object "; raise x - (* Enveloppe 3D : faces laterales liant un contour_haut et un contour_bas *) - (* 2 contours = meme nombre de points, oriente dans le sens contre-horaire *) + (* Enveloppe 3D : faces laterales liant un contour_haut et un contour_bas *) + (* 2 contours = meme nombre de points, oriente dans le sens contre-horaire *) method add_object_enveloppe_double contour_haut contour_bas - color_out color_in filled = + color_out color_in filled = let add_p p_bas p_haut res = - (glpoint3d_of_pt_3d p_bas)::(glpoint3d_of_pt_3d p_haut)::res + (glpoint3d_of_pt_3d p_bas)::(glpoint3d_of_pt_3d p_haut)::res in let cw_poly c = - let contour_2d = List.map (pt_3d_to_pt_2d T_Z3D) c in - if (poly_test_ccw contour_2d = CW) then c else List.rev c + let contour_2d = List.map (pt_3d_to_pt_2d T_Z3D) c in + if (poly_test_ccw contour_2d = CW) then c else List.rev c in let l_bas = geom_close_poly (cw_poly contour_bas) in let l_haut = geom_close_poly (cw_poly contour_haut) in let l0 = - try List.fold_right2 add_p l_bas l_haut [] - with x-> Printf.printf "\nadd_object_enveloppe.fold... : "; raise x + try List.fold_right2 add_p l_bas l_haut [] + with x-> Printf.printf "\nadd_object_enveloppe.fold... : "; raise x in let l_inside = - try List.fold_right2 add_p (List.rev l_bas) (List.rev l_haut) [] - with x-> Printf.printf "\nadd_object_enveloppe.foldinside... : "; raise x + try List.fold_right2 add_p (List.rev l_bas) (List.rev l_haut) [] + with x-> Printf.printf "\nadd_object_enveloppe.foldinside... : "; raise x in try - self#add_object (ENVELOPPE_3D_DOUBLE {env3d_double_contour_out = l0; - env3d_double_contour_in = l_inside; - env3d_double_color_out = color_out; - env3d_double_color_in = color_in; - env3d_double_filled = filled}) + self#add_object (ENVELOPPE_3D_DOUBLE {env3d_double_contour_out = l0; + env3d_double_contour_in = l_inside; + env3d_double_color_out = color_out; + env3d_double_color_in = color_in; + env3d_double_filled = filled}) with x -> - Printf.printf "\nadd_object_enveloppe. self#add_object "; raise x + Printf.printf "\nadd_object_enveloppe. self#add_object "; raise x - (* Fleche (flux) dont la pointe est placee en pt0 si sens est vrai *) - (* Ici, inutile de tesseler les faces inf et sup *) + (* Fleche (flux) dont la pointe est placee en pt0 si sens est vrai *) + (* Ici, inutile de tesseler les faces inf et sup *) method add_object_arrow pt0 vdir sens ep lg color filled - arrow_type = + arrow_type = let pts = - if arrow_type=ARROW1 then - [(0., 0.); (2.*.ep, ep); (2.*.ep, ep/.2.); (lg, ep/.2.); - (lg, (-.ep)/.2.); (2.*.ep, (-.ep)/.2.); (2.*.ep, -.ep)] - else - [(0., 0.); (2.5*.ep, ep); (2.*.ep, ep/.2.); (lg, ep/.2.); - (lg, (-.ep)/.2.); (2.*.ep, (-.ep)/.2.); (2.5*.ep, -.ep)] + if arrow_type=ARROW1 then + [(0., 0.); (2.*.ep, ep); (2.*.ep, ep/.2.); (lg, ep/.2.); + (lg, (-.ep)/.2.); (2.*.ep, (-.ep)/.2.); (2.*.ep, -.ep)] + else + [(0., 0.); (2.5*.ep, ep); (2.*.ep, ep/.2.); (lg, ep/.2.); + (lg, (-.ep)/.2.); (2.*.ep, (-.ep)/.2.); (2.5*.ep, -.ep)] in - let pts = if sens then pts else List.map (fun (x, y) -> (x-.lg, y)) pts in + let pts = if sens then pts else List.map (fun (x, y) -> (x-.lg, y)) pts in let pts = List.map (fun (x, y) -> {x2D=x; y2D=y}) pts in let pts = if poly_test_ccw pts = CW then pts else List.rev pts in let l = List.map (fun p -> - [glpoint3d_of_pt_2d ((-.ep)/.2.) p; glpoint3d_of_pt_2d (ep/.2.) p]) pts in + [glpoint3d_of_pt_2d ((-.ep)/.2.) p; glpoint3d_of_pt_2d (ep/.2.) p]) pts in let dd = - if sens then Geometry_3d.vect_make pt0 vdir - else Geometry_3d.vect_make vdir pt0 + if sens then Geometry_3d.vect_make pt0 vdir + else Geometry_3d.vect_make vdir pt0 in let h = Geometry_3d.vect_norm dd and d = sqrt(dd.x3D*.dd.x3D+.dd.y3D*.dd.y3D) in let alpha = - if dd.y3D>0. then acos (dd.x3D/.d) else -. (acos (dd.x3D/.d)) + if dd.y3D>0. then acos (dd.x3D/.d) else -. (acos (dd.x3D/.d)) in let beta = - if dd.z3D>0. then acos (d/.h) else -.(acos (d/.h)) + if dd.z3D>0. then acos (d/.h) else -.(acos (d/.h)) in self#add_object (ARROW_3D {arr3d_contour = geom_close_poly l; - arr3d_pt = glpoint3d_of_pt_3d pt0 ; - arr3d_vect = (dd.y3D, -.dd.x3D, 0.) ; - arr3d_angle_xy = rad2deg beta ; - arr3d_angle_z = rad2deg alpha ; - arr3d_color = color; - arr3d_filled = filled}) + arr3d_pt = glpoint3d_of_pt_3d pt0 ; + arr3d_vect = (dd.y3D, -.dd.x3D, 0.) ; + arr3d_angle_xy = rad2deg beta ; + arr3d_angle_z = rad2deg alpha ; + arr3d_color = color; + arr3d_filled = filled}) method add_object_outline contour cin cout filled = let l = geom_close_poly (glpoint3d_of_pt_3d_lst contour) in self#add_object (OUTLINE_3D {out3d_contour = l ; - out3d_color_in = cin ; - out3d_color_out = cout ; - out3d_filled = filled}) + out3d_color_in = cin ; + out3d_color_out = cout ; + out3d_filled = filled}) method add_object_line l color line_width with_bars fill = self#add_object (LINE_3D {line3d_points = glpoint3d_of_pt_3d_lst l; - line3d_width = line_width; - line3d_color = color; - line3d_with_bars = with_bars; - line3d_filled = fill}) + line3d_width = line_width; + line3d_color = color; + line3d_with_bars = with_bars; + line3d_filled = fill}) method add_object_point pos pos2 name color with_name = self#add_object (POINT_3D {p3d_pos = glpoint3d_of_pt_3d pos; - p3d_pos2 = glpoint3d_of_pt_3d pos2; - p3d_name = name; - p3d_with_name = with_name; - p3d_color = color}) + p3d_pos2 = glpoint3d_of_pt_3d pos2; + p3d_name = name; + p3d_with_name = with_name; + p3d_color = color}) method add_object_surface_with_texture tab texture_id = let t = Array.map (Array.map glpoint3d_of_pt_3d) tab in self#add_object (SURFACE_3D_TEX {s3d_tex_pts = t; - s3d_tex_texture_id = texture_id}) + s3d_tex_texture_id = texture_id}) method add_object_surface tab fill = let t = Array.map (Array.map (fun (p, c) -> (glpoint3d_of_pt_3d p, c))) tab in self#add_object (SURFACE_3D {s3d_pts = t; s3d_filled = fill}) - (* cree l'objet rosace *) + (* cree l'objet rosace *) method private create_rosace = self#make_current ; let compiled = GlList.create `compile in @@ -1114,33 +1114,33 @@ class widget_3d pack with_status_bar n = List.iter GlDraw.vertex2 [(-0.01, 0.04); (0.0, 0.05); (0.01, 0.04)] ; GlDraw.ends () ; if fonts_available then begin - (* Affichage du Nord sur la rosace si la fonte est disponible *) - GlPix.raster_pos ~x:(-.0.01) ~y:0.07 ~z:0.0 () ; - Gtkgl_Hack.gl_print_string fontbase "N" + (* Affichage du Nord sur la rosace si la fonte est disponible *) + GlPix.raster_pos ~x:(-.0.01) ~y:0.07 ~z:0.0 () ; + Gtkgl_Hack.gl_print_string fontbase "N" end ; GlList.ends () ; rosace <- Some compiled ; compiled - (* initialisation lors de la creation du widget *) + (* initialisation lors de la creation du widget *) method private init_func () = if not done_init then begin - do_msg "Init 3D" ; - List.iter Gl.enable [`depth_test; `cull_face] ; - GlDraw.cull_face `back; - GlDraw.front_face `ccw; + do_msg "Init 3D" ; + List.iter Gl.enable [`depth_test; `cull_face] ; + GlDraw.cull_face `back; + GlDraw.front_face `ccw; - List.iter (if use_lights then Gl.enable else Gl.disable) lights ; - GlDraw.shade_model (if use_smooth then `smooth else `flat) ; + List.iter (if use_lights then Gl.enable else Gl.disable) lights ; + GlDraw.shade_model (if use_smooth then `smooth else `flat) ; - if fonts_available then fontbase <- load_bitmap_font "8x13" ; + if fonts_available then fontbase <- load_bitmap_font "8x13" ; - GlPix.store (`unpack_alignment 1); - List.iter (GlTex.parameter ~target:`texture_2d) - [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `linear; `min_filter `linear ]; - GlTex.env (`mode `decal); + GlPix.store (`unpack_alignment 1); + List.iter (GlTex.parameter ~target:`texture_2d) + [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `linear; `min_filter `linear ]; + GlTex.env (`mode `decal); - done_init <- true + done_init <- true end method private reshape_func ~width:w ~height:h = @@ -1150,14 +1150,14 @@ class widget_3d pack with_status_bar n = GlDraw.viewport ~x:0 ~y:0 ~w ~h; self#setup - (* met a jour de la vue et de la source de lumiere *) + (* met a jour de la vue et de la source de lumiere *) method private setup = do_msg "Setup" ; GlMat.mode `projection; GlMat.load_identity (); let aspect = float width /. float height and view_fovs = 1. in GluMat.perspective ~fovy:(45. *. view_fovs) ~aspect - ~z:(0.1, (rs*.sqrt(2.)+.1.)); + ~z:(0.1, (rs*.sqrt(2.)+.1.)); GlMat.mode `modelview; GlMat.load_identity (); @@ -1171,19 +1171,19 @@ class widget_3d pack with_status_bar n = (* Positionnement de la lumiere *) if use_lights then begin - GlMat.push (); - rotate_all lightrot ; - let (x, y, z)= lightpos in - List.iter (GlLight.light ~num:0) [`position (x, y, z, 1.); - `ambient (1., 1., 1., 1.); - `diffuse (1., 1., 1., 1.)] ; - GlMat.pop () + GlMat.push (); + rotate_all lightrot ; + let (x, y, z)= lightpos in + List.iter (GlLight.light ~num:0) [`position (x, y, z, 1.); + `ambient (1., 1., 1., 1.); + `diffuse (1., 1., 1., 1.)] ; + GlMat.pop () end ; self#set_status method set_name n = name <- n; self#display_func - method set_show_name set = show_name <- set; self#display_func + method set_show_name set = show_name <- set; self#display_func method display = fun o -> GlList.call (self#get_object o).o_compiled; Gl.flush (); area#swap_buffers () @@ -1200,198 +1200,198 @@ class widget_3d pack with_status_bar n = (* Affichage du nom si c'est demande *) if fonts_available && name<>"" && show_name then begin - GlMat.push (); - GlMat.load_identity (); - set_color (1., 1., 1.) ; - GlPix.raster_pos ~x:(-.4.*.aspect) ~y:(4.) ~z:(-.10.0) () ; - Gtkgl_Hack.gl_print_string fontbase name ; - GlMat.pop () + GlMat.push (); + GlMat.load_identity (); + set_color (1., 1., 1.) ; + GlPix.raster_pos ~x:(-.4.*.aspect) ~y:(4.) ~z:(-.10.0) () ; + Gtkgl_Hack.gl_print_string fontbase name ; + GlMat.pop () end ; (* Affichage de la rosace si necessaire *) if show_rosace then begin - (* Creation de la rosace si ca n'est pas deja fait... *) - let r = match rosace with None -> self#create_rosace|Some r -> r in - GlMat.push (); - GlMat.load_identity (); - GlMat.translate3 (-.0.5*.aspect, 0.5, -.1.5) ; - rotate_some rot [X_AXIS; Z_AXIS] ; - GlList.call r ; - GlMat.pop () + (* Creation de la rosace si ca n'est pas deja fait... *) + let r = match rosace with None -> self#create_rosace|Some r -> r in + GlMat.push (); + GlMat.load_identity (); + GlMat.translate3 (-.0.5*.aspect, 0.5, -.1.5) ; + rotate_some rot [X_AXIS; Z_AXIS] ; + GlList.call r ; + GlMat.pop () end ; (* Affichage de la sphere representant la lumiere *) if show_light then begin - GlMat.push (); - rotate_all lightrot ; - GlMat.translate3 lightpos; - set_color glcolor_white ; - let radius = 0.03 in - GluQuadric.sphere ~radius ~stacks:5 ~slices:5 (); - GlMat.pop () + GlMat.push (); + rotate_all lightrot ; + GlMat.translate3 lightpos; + set_color glcolor_white ; + let radius = 0.03 in + GluQuadric.sphere ~radius ~stacks:5 ~slices:5 (); + GlMat.pop () end ; (* Affichage *) Gl.flush (); area#swap_buffers () - (* [mouse_press ev] traite un evenement correspondant a l'appui sur un bouton *) + (* [mouse_press ev] traite un evenement correspondant a l'appui sur un bouton *) method private mouse_press ev = let mouse_pos = Gtk_tools.get_mouse_pos_click ev in match (Gtk_tools.test_mouse_but ev) with - Gtk_tools.B_GAUCHE -> - self#set_cursor cursor_rotate ; - current_action <- (ACTION_ROTATE mouse_pos); true + Gtk_tools.B_GAUCHE -> + self#set_cursor cursor_rotate ; + current_action <- (ACTION_ROTATE mouse_pos); true | Gtk_tools.B_MILIEU -> - current_action <- (ACTION_ZOOM mouse_pos); true + current_action <- (ACTION_ZOOM mouse_pos); true | Gtk_tools.B_DROIT -> false | _ -> false - (* [mouse_move ev] traite les mouvements souris *) + (* [mouse_move ev] traite les mouvements souris *) method private mouse_move ev = area#misc#grab_focus () ; let mouse_pos = Gtk_tools.get_mouse_pos_move ev in match current_action with - ACTION_NONE -> false + ACTION_NONE -> false | ACTION_ZOOM old_pos -> - let dy = (snd mouse_pos)-(snd old_pos) in - self#set_cursor (if dy<0 then cursor_zoom_up else cursor_zoom_down) ; - self#incr_dist (dist_incr*.(float_of_int dy)) ; - current_action <- (ACTION_ZOOM mouse_pos) ; true + let dy = (snd mouse_pos)-(snd old_pos) in + self#set_cursor (if dy<0 then cursor_zoom_up else cursor_zoom_down) ; + self#incr_dist (dist_incr*.(float_of_int dy)) ; + current_action <- (ACTION_ZOOM mouse_pos) ; true | ACTION_ROTATE old_pos -> - let dz = (fst mouse_pos)-(fst old_pos) - and dx = (snd mouse_pos)-(snd old_pos) in - let r = add_coord_360 rot X_AXIS (float_of_int dx) in - self#rotate_view (add_coord_360 r Z_AXIS (float_of_int dz)) ; - current_action <- (ACTION_ROTATE mouse_pos) ; true + let dz = (fst mouse_pos)-(fst old_pos) + and dx = (snd mouse_pos)-(snd old_pos) in + let r = add_coord_360 rot X_AXIS (float_of_int dx) in + self#rotate_view (add_coord_360 r Z_AXIS (float_of_int dz)) ; + current_action <- (ACTION_ROTATE mouse_pos) ; true - (* [mouse_release ev] traite un evenement de relachement de bouton *) + (* [mouse_release ev] traite un evenement de relachement de bouton *) method private mouse_release _ev = (match current_action with ACTION_NONE -> () | _ -> self#reset_cursor) ; current_action <- ACTION_NONE ; true - (* Mouvement de la molette de la souris sous Windows *) + (* Mouvement de la molette de la souris sous Windows *) method private mouse_wheel ev = match GdkEvent.Scroll.direction ev with - `UP -> self#incr_dist (-.dist_incr) ; true + `UP -> self#incr_dist (-.dist_incr) ; true | `DOWN -> self#incr_dist dist_incr ; true | `LEFT -> false | `RIGHT -> false method private start_stop_animation = match animation_timer with - None -> - let timeout _ = self#incr_rotz rot_anim; true in - animation_timer <- Some (Timeout.add ~ms:tps_anim ~callback:timeout) + None -> + let timeout _ = self#incr_rotz rot_anim; true in + animation_timer <- Some (Timeout.add ~ms:tps_anim ~callback:timeout) | Some t -> Timeout.remove t ; animation_timer <- None - (* [key_pressed key] teste la touche pressee dans la zone de dessin - et effectue l'action associee le cas echeant *) + (* [key_pressed key] teste la touche pressee dans la zone de dessin + et effectue l'action associee le cas echeant *) method private key_pressed key = let keys_list = - [([_Page_Up], fun () -> self#incr_dist (-.dist_incr)) ; - ([_Page_Down], fun () -> self#incr_dist dist_incr) ; - ([_KP_Down; _KP_2], fun () -> self#incr_rotx rot_incr) ; - ([_KP_Up; _KP_8], fun () -> self#incr_rotx (-.rot_incr)) ; - ([_KP_Left; _KP_4], fun () -> self#incr_rotz (-.rot_incr)) ; - ([_KP_Right; _KP_6], fun () -> self#incr_rotz rot_incr) ; - ([_Down], fun () -> self#move_y (dist_incr/.3.)) ; - ([_Up], fun () -> self#move_y ((-.dist_incr)/.3.)) ; - ([_Left], fun () -> self#move_x (dist_incr/.3.)) ; - ([_Right], fun () -> self#move_x ((-.dist_incr)/.3.)) ; - ([_l], fun () -> self#lights_switch) ; - ([_s], fun () -> self#smooth_switch) ; - ([_r], fun () -> self#rosace_switch) ; - ([_Home], fun () -> self#rotate_view pt_null) ; - ([_a], fun () -> self#incr_light_rot rot_incr) ; - ([_z], fun () -> self#incr_light_rot (-.rot_incr)) ; - ([_L], fun () -> show_light <- not show_light; self#change_and_redraw) ; - ([_space], fun () -> self#start_stop_animation); - ([_Escape], fun () -> self#redo_all); - ([_i], fun () -> Printf.printf "%s" (get_gl_infos ()); flush stdout); - ([_n], fun () -> self#set_show_name (not show_name))] in + [([_Page_Up], fun () -> self#incr_dist (-.dist_incr)) ; + ([_Page_Down], fun () -> self#incr_dist dist_incr) ; + ([_KP_Down; _KP_2], fun () -> self#incr_rotx rot_incr) ; + ([_KP_Up; _KP_8], fun () -> self#incr_rotx (-.rot_incr)) ; + ([_KP_Left; _KP_4], fun () -> self#incr_rotz (-.rot_incr)) ; + ([_KP_Right; _KP_6], fun () -> self#incr_rotz rot_incr) ; + ([_Down], fun () -> self#move_y (dist_incr/.3.)) ; + ([_Up], fun () -> self#move_y ((-.dist_incr)/.3.)) ; + ([_Left], fun () -> self#move_x (dist_incr/.3.)) ; + ([_Right], fun () -> self#move_x ((-.dist_incr)/.3.)) ; + ([_l], fun () -> self#lights_switch) ; + ([_s], fun () -> self#smooth_switch) ; + ([_r], fun () -> self#rosace_switch) ; + ([_Home], fun () -> self#rotate_view pt_null) ; + ([_a], fun () -> self#incr_light_rot rot_incr) ; + ([_z], fun () -> self#incr_light_rot (-.rot_incr)) ; + ([_L], fun () -> show_light <- not show_light; self#change_and_redraw) ; + ([_space], fun () -> self#start_stop_animation); + ([_Escape], fun () -> self#redo_all); + ([_i], fun () -> Printf.printf "%s" (get_gl_infos ()); flush stdout); + ([_n], fun () -> self#set_show_name (not show_name))] in (* Recherche la fonction associee a la touche presse s'il y en a une *) let rec check_keys lst = - match lst with - (keys, func)::reste -> - if List.mem key keys then begin func ();true end else check_keys reste - | [] -> false + match lst with + (keys, func)::reste -> + if List.mem key keys then begin func ();true end else check_keys reste + | [] -> false in check_keys keys_list - (* Modification de la position de l'utilisateur et des angles de vue *) + (* Modification de la position de l'utilisateur et des angles de vue *) method incr_dist d = self#move_view (add_coord depl Z_AXIS d) method incr_rotx d = self#rotate_view (add_coord_360 rot X_AXIS d) method incr_rotz d = self#rotate_view (add_coord_360 rot Z_AXIS d) - method move_x d = self#move_view (add_coord depl X_AXIS d) - method move_y d = self#move_view (add_coord depl Y_AXIS d) + method move_x d = self#move_view (add_coord depl X_AXIS d) + method move_y d = self#move_view (add_coord depl Y_AXIS d) (* tourne la lumiere *) - method incr_light_rot d = lightrot<-add_coord_360 lightrot Z_AXIS d; - self#change_and_redraw + method incr_light_rot d = lightrot<-add_coord_360 lightrot Z_AXIS d; + self#change_and_redraw (* Manipulations generales des objets *) - method private get_object id = - try List.find (fun o -> o.o_id=id) objects - with Not_found -> raise (NO_SUCH_3D_OBJECT id) - method delete_object id = - let found = ref None in - let new_l = List.fold_left (fun l obj -> - if obj.o_id=id then begin found:=Some obj; l end else obj::l) [] objects in - match !found with - None -> raise (NO_SUCH_3D_OBJECT id) - | Some obj -> objects <- List.rev new_l; GlList.delete obj.o_compiled - method object_set_color id new_color = - let o = self#get_object id in - set_object_color o.o_obj new_color; self#make_and_compile o - method object_get_color id = - get_object_color (self#get_object id).o_obj - method object_set_visibility id visible = - let o = self#get_object id in o.o_show <- visible; self#make_and_compile o - method object_get_visibility id = (self#get_object id).o_show - method object_set_fill id filled = - let o = self#get_object id in - set_object_fill o.o_obj filled; self#make_and_compile o - method object_get_fill id = - get_object_fill (self#get_object id).o_obj + method private get_object id = + try List.find (fun o -> o.o_id=id) objects + with Not_found -> raise (NO_SUCH_3D_OBJECT id) + method delete_object id = + let found = ref None in + let new_l = List.fold_left (fun l obj -> + if obj.o_id=id then begin found:=Some obj; l end else obj::l) [] objects in + match !found with + None -> raise (NO_SUCH_3D_OBJECT id) + | Some obj -> objects <- List.rev new_l; GlList.delete obj.o_compiled + method object_set_color id new_color = + let o = self#get_object id in + set_object_color o.o_obj new_color; self#make_and_compile o + method object_get_color id = + get_object_color (self#get_object id).o_obj + method object_set_visibility id visible = + let o = self#get_object id in o.o_show <- visible; self#make_and_compile o + method object_get_visibility id = (self#get_object id).o_show + method object_set_fill id filled = + let o = self#get_object id in + set_object_fill o.o_obj filled; self#make_and_compile o + method object_get_fill id = + get_object_fill (self#get_object id).o_obj (* Fonctions specifiques a certains objets *) - method line_get_width id = - get_line_width (self#get_object id).o_obj id - method line_set_width id width = - let o = self#get_object id in - set_line_width o.o_obj width id; self#make_and_compile o - method line_get_with_bars id = - get_line_bars (self#get_object id).o_obj id - method line_set_with_bars id withbars = - let o = self#get_object id in - set_line_bars o.o_obj withbars id; self#make_and_compile o - method outline_set_in_color id new_color = - let o = self#get_object id in - set_outline_in_color o.o_obj new_color id; self#make_and_compile o - method outline_get_in_color id = - get_outline_in_color (self#get_object id).o_obj id - method point_get_with_name id = - get_point_name (self#get_object id).o_obj id - method point_set_with_name id withname = - let o = self#get_object id in - set_point_name o.o_obj withname id; self#make_and_compile o + method line_get_width id = + get_line_width (self#get_object id).o_obj id + method line_set_width id width = + let o = self#get_object id in + set_line_width o.o_obj width id; self#make_and_compile o + method line_get_with_bars id = + get_line_bars (self#get_object id).o_obj id + method line_set_with_bars id withbars = + let o = self#get_object id in + set_line_bars o.o_obj withbars id; self#make_and_compile o + method outline_set_in_color id new_color = + let o = self#get_object id in + set_outline_in_color o.o_obj new_color id; self#make_and_compile o + method outline_get_in_color id = + get_outline_in_color (self#get_object id).o_obj id + method point_get_with_name id = + get_point_name (self#get_object id).o_obj id + method point_set_with_name id withname = + let o = self#get_object id in + set_point_name o.o_obj withname id; self#make_and_compile o - method destroy_all_objects = - List.iter (fun o -> GlList.delete o.o_compiled) objects ; - objects <- [] ; - (match rosace with None -> () | Some r -> GlList.delete r) ; - unload_bitmap_font fontbase + method destroy_all_objects = + List.iter (fun o -> GlList.delete o.o_compiled) objects ; + objects <- [] ; + (match rosace with None -> () | Some r -> GlList.delete r) ; + unload_bitmap_font fontbase - method private redo_all = - self#setup; self#recompile_all_objects; - (match rosace with None -> () | Some r -> GlList.delete r) ; - if show_rosace then ignore(self#create_rosace) ; - self#display_func + method private redo_all = + self#setup; self#recompile_all_objects; + (match rosace with None -> () | Some r -> GlList.delete r) ; + if show_rosace then ignore(self#create_rosace) ; + self#display_func - method set_back_color c = back_color <- c ; self#display_func + method set_back_color c = back_color <- c ; self#display_func initializer ignore(area#connect#realize ~callback:self#init_func) ; @@ -1408,12 +1408,12 @@ class widget_3d pack with_status_bar n = (* Callbacks des evenements souris *) Gtk_tools_GL.glarea_mouse_connect area - self#mouse_press self#mouse_move self#mouse_release ; + self#mouse_press self#mouse_move self#mouse_release ; let scroll_cb = fun ev -> - match GdkEvent.get_type ev with - | `SCROLL -> self#mouse_wheel (GdkEvent.Scroll.cast ev) - | _ -> false in + match GdkEvent.get_type ev with + | `SCROLL -> self#mouse_wheel (GdkEvent.Scroll.cast ev) + | _ -> false in (* Reactions aux mouvements de la molette souris *) ignore(area#event#connect#any ~callback:scroll_cb) ; diff --git a/sw/lib/ocaml/gtk_draw.ml b/sw/lib/ocaml/gtk_draw.ml index 017a633300..e5e0398562 100644 --- a/sw/lib/ocaml/gtk_draw.ml +++ b/sw/lib/ocaml/gtk_draw.ml @@ -52,7 +52,7 @@ let gd_color_of_rgb (r, g, b) = `RGB (r, g, b) (* = Creation d'une GDraw.color a partir de ces composantes (r, g, b) = *) (* ============================================================================= *) let gd_color_of_float_rgb (r, g, b) = `RGB (int_of_float r, int_of_float g, - int_of_float b) + int_of_float b) (* ============================================================================= *) (* = Mise a jour de la couleur de dessin = *) (* ============================================================================= *) @@ -82,7 +82,7 @@ let gd_set_style_double_dash p = (* = Modification du mode de trace = *) (* ============================================================================= *) (*let gd_set_mode_xor p = (gd_do_cast p)#set_gc_xor -let gd_set_mode_std p = (gd_do_cast p)#set_gc_copy*) + let gd_set_mode_std p = (gd_do_cast p)#set_gc_copy*) (* ============================================================================= *) (* = Modification de l'epaisseur du trace = *) @@ -152,31 +152,31 @@ let gd_draw_filled_circle p (x, y) r = (* ============================================================================= *) let gd_draw_rect p (x1, y1, x2, y2) = (gd_do_cast p)#rectangle ~filled:false ~x:x1 ~y:y1 - ~width:(x2-x1) ~height:(y2-y1) () + ~width:(x2-x1) ~height:(y2-y1) () (* ============================================================================= *) (* = Dessin d'un rectangle plein = *) (* ============================================================================= *) let gd_draw_filled_rect p (x1, y1, x2, y2) = - (gd_do_cast p)#rectangle ~filled:true ~x:x1 ~y:y1 ~width:(x2-x1) ~height:(y2-y1) () + (gd_do_cast p)#rectangle ~filled:true ~x:x1 ~y:y1 ~width:(x2-x1) ~height:(y2-y1) () (* ============================================================================= *) (* = Dessin d'un triangle = *) (* ============================================================================= *) let gd_draw_triangle p (x, y) size = let size0 = int_of_float ((float_of_int size) *. 1.5) and - size1 = int_of_float ((float_of_int size) *. 0.5) in + size1 = int_of_float ((float_of_int size) *. 0.5) in (gd_do_cast p)#polygon ~filled:false - [(x, y-size); (x-size0, y+size1); (x+size0, y+size1)] + [(x, y-size); (x-size0, y+size1); (x+size0, y+size1)] (* ============================================================================= *) (* = Dessin d'un triangle plein = *) (* ============================================================================= *) let gd_draw_filled_triangle p (x, y) size = let size0 = int_of_float ((float_of_int size) *. 1.5) and - size1 = int_of_float ((float_of_int size) *. 0.5) in + size1 = int_of_float ((float_of_int size) *. 0.5) in (gd_do_cast p)#polygon ~filled:true - [(x, y-size); (x-size0, y+size1); (x+size0, y+size1)] + [(x, y-size); (x-size0, y+size1); (x+size0, y+size1)] (* ============================================================================= *) (* = Efface une pixmap = *) @@ -196,8 +196,8 @@ let gd_set_background_pixmap p dest = (gd_do_cast dest)#put_pixmap ~x:0 ~y:0 p let gd_put_transp_pixmap p dest x y = (* Indispensable d'utiliser le masque pour la transparence *) (match p#mask with - None -> () | - Some m -> (gd_do_cast dest)#set_clip_origin ~x:x ~y:y; dest#set_clip_mask m) ; + None -> () | + Some m -> (gd_do_cast dest)#set_clip_origin ~x:x ~y:y; dest#set_clip_mask m) ; (* Mise en place du pixmap transparent *) dest#put_pixmap ~x:x ~y:y p#pixmap ; diff --git a/sw/lib/ocaml/gtk_image.ml b/sw/lib/ocaml/gtk_image.ml index 7556bc7d46..955a7ffcfa 100644 --- a/sw/lib/ocaml/gtk_image.ml +++ b/sw/lib/ocaml/gtk_image.ml @@ -52,50 +52,50 @@ type progress_save = INIT | SAVING | FINISHED au format : [PNG] -> "PNG"; [POSTSCRIPT] -> "Postscript" *) let extended_string_of_format_capture format = match format with - PNG -> "PNG" - | GIF -> "GIF" - | JPEG -> "JPEG" - | TIFF -> "TIFF" - | BMP -> "BMP" - | PPM -> "PPM" - | POSTSCRIPT -> "Postscript" + PNG -> "PNG" + | GIF -> "GIF" + | JPEG -> "JPEG" + | TIFF -> "TIFF" + | BMP -> "BMP" + | PPM -> "PPM" + | POSTSCRIPT -> "Postscript" (* [string_of_format_capture format] fournit une chaine correspondant au format : [PNG] -> "PNG"; [POSTSCRIPT] -> "PS" *) let string_of_format_capture format = match format with - PNG -> "PNG" - | GIF -> "GIF" - | JPEG -> "JPG" - | TIFF -> "TIFF" - | BMP -> "BMP" - | PPM -> "PPM" - | POSTSCRIPT -> "PS" + PNG -> "PNG" + | GIF -> "GIF" + | JPEG -> "JPG" + | TIFF -> "TIFF" + | BMP -> "BMP" + | PPM -> "PPM" + | POSTSCRIPT -> "PS" (* [format_capture_of_string chaine] renvoie le type {!Capture.format_capture} correspondant a la chaine *) let format_capture_of_string s = match s with - "PNG" -> PNG - | "GIF" -> GIF - | "JPG" -> JPEG - | "TIFF" -> TIFF - | "BMP" -> BMP - | "PPM" -> PPM - | "PS" -> POSTSCRIPT - | _ -> PNG + "PNG" -> PNG + | "GIF" -> GIF + | "JPG" -> JPEG + | "TIFF" -> TIFF + | "BMP" -> BMP + | "PPM" -> PPM + | "PS" -> POSTSCRIPT + | _ -> PNG (* [string_of_extension format] renvoie l'extension correspondant au format. i.e [PNG] -> ".png" *) let string_of_extension format = match format with - PNG -> ".png" - | GIF -> ".gif" - | JPEG -> ".jpg" - | TIFF -> ".tiff" - | BMP -> ".bmp" - | PPM -> ".ppm" - | POSTSCRIPT -> ".ps" + PNG -> ".png" + | GIF -> ".gif" + | JPEG -> ".jpg" + | TIFF -> ".tiff" + | BMP -> ".bmp" + | PPM -> ".ppm" + | POSTSCRIPT -> ".ps" (* ============================================================================= *) (* = Transforme un entier en valeur (R,G,B) = *) @@ -105,7 +105,7 @@ let rgb_of_int v = let r = v/65536 in let reste = v-(r*65536) in let g = reste/256 and - b = reste mod 256 in + b = reste mod 256 in {r=r; g=g; b=b} (* ============================================================================= *) @@ -118,15 +118,15 @@ let image_of_gdkimage gdkimg width height progress_func = let img = Rgb24.create width height in for y = 0 to height-1 do - for x = 0 to width-1 do - Rgb24.set img x y (rgb_of_int (Gdk.Image.get_pixel gdkimg x y)) ; - done ; - cpt := !cpt +. 1.0 ; + for x = 0 to width-1 do + Rgb24.set img x y (rgb_of_int (Gdk.Image.get_pixel gdkimg x y)) ; + done ; + cpt := !cpt +. 1.0 ; - (* Appel a la fonction de progression si necessaire *) - match progress_func with - None -> () - | Some f -> f INIT (!cpt*.total) + (* Appel a la fonction de progression si necessaire *) + match progress_func with + None -> () + | Some f -> f INIT (!cpt*.total) done ; Rgb24(img) @@ -137,32 +137,32 @@ let image_of_gdkimage gdkimg width height progress_func = format indique *) let get_save_func format = match format with - PNG -> Png.save - | GIF -> Gif.save_image - | JPEG -> Jpeg.save - | TIFF -> Tiff.save - | BMP -> Bmp.save - | PPM -> Ppm.save - | POSTSCRIPT -> Ps.save + PNG -> Png.save + | GIF -> Gif.save_image + | JPEG -> Jpeg.save + | TIFF -> Tiff.save + | BMP -> Bmp.save + | PPM -> Ppm.save + | POSTSCRIPT -> Ps.save (* ============================================================================= *) (* = Recuperation de la fonction de chargement correspondant au format voulu = *) (* ============================================================================= *) let get_load_func format = match format with - PNG -> Png.load - | JPEG -> Jpeg.load - | TIFF -> Tiff.load - | BMP -> Bmp.load - | PPM -> Ppm.load - | POSTSCRIPT -> Ps.load - | GIF -> (* Cas particulier pour les images GIF *) - let save_gif filename opts = - let sequence = Gif.load filename opts in - let frame = List.hd sequence.frames in - Index8 frame.frame_bitmap - in - save_gif + PNG -> Png.load + | JPEG -> Jpeg.load + | TIFF -> Tiff.load + | BMP -> Bmp.load + | PPM -> Ppm.load + | POSTSCRIPT -> Ps.load + | GIF -> (* Cas particulier pour les images GIF *) + let save_gif filename opts = + let sequence = Gif.load filename opts in + let frame = List.hd sequence.frames in + Index8 frame.frame_bitmap + in + save_gif (* ============================================================================= *) (* = Recuperation du nom avec extension pour le format voulu = *) @@ -172,10 +172,10 @@ let set_filename_extension filename format = let lg = String.length extension in (* Test si l'extension est deja presente. Si elle ne l'est pas, on l'ajoute... *) if (String.length filename) > lg && - (String.sub filename ((String.length filename)-lg) lg) = extension then - filename + (String.sub filename ((String.length filename)-lg) lg) = extension then + filename else - filename^extension + filename^extension (* ============================================================================= *) (* = Fonction de remplacement d'une extension = *) @@ -188,12 +188,12 @@ let update_extension_capture filename old_format new_format = let old_ext = string_of_extension old_format in let lg = String.length old_ext in if (String.sub filename ((String.length filename)-lg) lg) = old_ext then begin - (* Il faut supprimer l'ancienne extension *) - let f = String.sub filename 0 ((String.length filename)-lg) in - set_filename_extension f new_format ; + (* Il faut supprimer l'ancienne extension *) + let f = String.sub filename 0 ((String.length filename)-lg) in + set_filename_extension f new_format ; end else - (* Ajout de la nouvelle extension *) - set_filename_extension filename new_format + (* Ajout de la nouvelle extension *) + set_filename_extension filename new_format (* ============================================================================= *) (* = Effectue la capture proprement dite = *) @@ -225,12 +225,12 @@ let capture_part draw x y width height filename format progress_func = (* Appel a la fonction de progression si necessaire *) begin - match progress_func with - None -> save_func filename_save [] image - | Some f -> - save_func filename_save [Save_Progress(f SAVING)] image ; - (* Fin de la sauvegarde *) - f FINISHED 0.0 + match progress_func with + None -> save_func filename_save [] image + | Some f -> + save_func filename_save [Save_Progress(f SAVING)] image ; + (* Fin de la sauvegarde *) + f FINISHED 0.0 end (* ============================================================================= *) @@ -248,36 +248,36 @@ let capture_part draw x y width height filename format progress_func = (* = caption = None ou Some(texte legende, couleur) = *) (* ============================================================================= *) let capture_part_with_caption window drawable x y width height filename - format progress_func caption = + format progress_func caption = let draw = - match caption with - None -> drawable (* Pas de legende *) - | Some (caption_text, caption_color, contour_color, back_color, font) -> - (* Copie de la pixmap initiale pour pouvoir y rajouter la legende *) - let depth = window#misc#visual_depth and w = window#misc#window in - let pix = Gdk.Pixmap.create ~window:w ~width:(width+x) ~height:(height+y) - ~depth:depth () in - let pixmap = new GDraw.pixmap pix in - pixmap#put_pixmap ~x:x ~y:x drawable ; + match caption with + None -> drawable (* Pas de legende *) + | Some (caption_text, caption_color, contour_color, back_color, font) -> + (* Copie de la pixmap initiale pour pouvoir y rajouter la legende *) + let depth = window#misc#visual_depth and w = window#misc#window in + let pix = Gdk.Pixmap.create ~window:w ~width:(width+x) ~height:(height+y) + ~depth:depth () in + let pixmap = new GDraw.pixmap pix in + pixmap#put_pixmap ~x:x ~y:x drawable ; - (* Ajout de la legende *) - let taille_texte = Gdk.Font.string_width font caption_text and - taille_texte2 = Gdk.Font.string_height font caption_text in - let x0 = x+(width/2)-taille_texte/2-10 and - y0 = y+5 and - taille_x = taille_texte+20 and - taille_y = taille_texte2+10 in + (* Ajout de la legende *) + let taille_texte = Gdk.Font.string_width font caption_text and + taille_texte2 = Gdk.Font.string_height font caption_text in + let x0 = x+(width/2)-taille_texte/2-10 and + y0 = y+5 and + taille_x = taille_texte+20 and + taille_y = taille_texte2+10 in - pixmap#set_foreground back_color ; - pixmap#rectangle ~filled:true ~x:x0 ~y:y0 ~width:taille_x ~height:taille_y () ; - pixmap#set_foreground contour_color ; - pixmap#rectangle ~filled:false ~x:x0 ~y:y0 ~width:taille_x ~height:taille_y () ; - pixmap#set_foreground caption_color ; - pixmap#string caption_text ~font:font - ~x:(x0+taille_x/2-taille_texte/2) ~y:(y0+taille_y/2+taille_texte2/2) ; + pixmap#set_foreground back_color ; + pixmap#rectangle ~filled:true ~x:x0 ~y:y0 ~width:taille_x ~height:taille_y () ; + pixmap#set_foreground contour_color ; + pixmap#rectangle ~filled:false ~x:x0 ~y:y0 ~width:taille_x ~height:taille_y () ; + pixmap#set_foreground caption_color ; + pixmap#string caption_text ~font:font + ~x:(x0+taille_x/2-taille_texte/2) ~y:(y0+taille_y/2+taille_texte2/2) ; - (* Renvoie le nouveau drawable qui contient la legende *) - pix + (* Renvoie le nouveau drawable qui contient la legende *) + pix in capture_part draw x y width height filename format progress_func @@ -296,18 +296,18 @@ let capture_part_with_caption window drawable x y width height filename (* ============================================================================= *) let capture_complete window drawable width height filename format progress_func caption = capture_part_with_caption window drawable 0 0 width height filename - format progress_func caption + format progress_func caption (* ============================================================================= *) (* = Creation d'une image Rgb24 quel que soit le format d'origine = *) (* ============================================================================= *) let gtk_image_rgb24_of_image image = match image with - Images.Index8 i -> Index8.to_rgb24 i - | Images.Rgb24 i -> i - | Images.Index16 i -> Index16.to_rgb24 i - | Images.Rgba32 i -> Rgb24.of_rgba32 i - | Images.Cmyk32 _i -> Printf.printf "Pb : Image Cmyk32 !!!\n"; flush stdout ; exit 1 + Images.Index8 i -> Index8.to_rgb24 i + | Images.Rgb24 i -> i + | Images.Index16 i -> Index16.to_rgb24 i + | Images.Rgba32 i -> Rgb24.of_rgba32 i + | Images.Cmyk32 _i -> Printf.printf "Pb : Image Cmyk32 !!!\n"; flush stdout ; exit 1 (* ============================================================================= *) (* = Lecture d'une image et creation d'une pixmap = *) @@ -322,10 +322,10 @@ let gtk_image_load filename win format = (* Creation d'une pixmap de meme taille *) let create_pixmap window width height = - let depth = (window:GWindow.window)#misc#visual_depth and w = window#misc#window in - let pix = Gdk.Pixmap.create ~window:w ~width:width ~height:height ~depth:depth () in - let pixmap = new GDraw.pixmap pix in - (pix, pixmap) + let depth = (window:GWindow.window)#misc#visual_depth and w = window#misc#window in + let pix = Gdk.Pixmap.create ~window:w ~width:width ~height:height ~depth:depth () in + let pixmap = new GDraw.pixmap pix in + (pix, pixmap) in let (_pix, pixmap) = create_pixmap win w h in @@ -335,11 +335,11 @@ let gtk_image_load filename win format = (* Transfert de l'image Rgb24 dans la pixmap *) for y = 0 to h-1 do - for x = 0 to w-1 do - let {Images.r=r; Images.g=g; Images.b=b} = Rgb24.get rgb x y in - pixmap#set_foreground (`RGB (r*256, g*256, b*256)) ; - pixmap#point ~x:x ~y:y - done ; + for x = 0 to w-1 do + let {Images.r=r; Images.g=g; Images.b=b} = Rgb24.get rgb x y in + pixmap#set_foreground (`RGB (r*256, g*256, b*256)) ; + pixmap#point ~x:x ~y:y + done ; done ; (* On renvoie la pixmap qui contient a present l'image lue *) diff --git a/sw/lib/ocaml/gtk_tools.ml b/sw/lib/ocaml/gtk_tools.ml index f42f89bf91..4ad5b7a408 100644 --- a/sw/lib/ocaml/gtk_tools.ml +++ b/sw/lib/ocaml/gtk_tools.ml @@ -23,41 +23,41 @@ *) (** GTK utilities - *) +*) class pixmap_in_drawin_area = fun ?drawing_area ?width ?height ?packing () -> let da = match drawing_area with - None -> - GMisc.drawing_area ?width ?height ~show:true ?packing () - | Some d -> d in - object - val mutable pixmap = None + None -> + GMisc.drawing_area ?width ?height ~show:true ?packing () + | Some d -> d in +object + val mutable pixmap = None - method drawing_area = da + method drawing_area = da - method redraw = fun () -> + method redraw = fun () -> + match pixmap with + None -> () + | Some pm -> + (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 pm#pixmap + + method get_pixmap = fun () -> + let {Gtk.width=width; height=height} = da#misc#allocation in + let create = fun () -> GDraw.pixmap ~width ~height ~window:da () in + let pm = match pixmap with - None -> () - | Some pm -> - (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 pm#pixmap - - method get_pixmap = fun () -> - let {Gtk.width=width; height=height} = da#misc#allocation in - let create = fun () -> GDraw.pixmap ~width ~height ~window:da () in - let pm = - match pixmap with - None -> create () - | Some pm -> - if pm#size = (width, height) - then pm - else begin - Gdk.Pixmap.destroy pm#pixmap; - create () - end in - pixmap <- Some pm; - pm - end + None -> create () + | Some pm -> + if pm#size = (width, height) + then pm + else begin + Gdk.Pixmap.destroy pm#pixmap; + create () + end in + pixmap <- Some pm; + pm +end type combo = GEdit.combo_box * (GTree.list_store * string GTree.column) let combo_widget = fst @@ -65,8 +65,8 @@ let combo_model = snd let combo_value = fun ((combo: #GEdit.combo_box), (_,column)) -> match combo#active_iter with - | None -> raise Not_found - | Some row -> combo#model#get ~row ~column + | None -> raise Not_found + | Some row -> combo#model#get ~row ~column let combo_values_list = fun (combo : combo) -> let (store, column) = combo_model combo in @@ -98,19 +98,19 @@ let select_in_combo = fun (combo : combo) string -> store#foreach (fun _path row -> if store#get ~row ~column = string then begin - (combo_widget combo)#set_active_iter (Some row); - true + (combo_widget combo)#set_active_iter (Some row); + true end else - false) + false) let combo_connect = fun ((combo: #GEdit.combo_box), (_,column)) cb -> ignore (combo#connect#changed - (fun () -> - match combo#active_iter with - | None -> () - | Some row -> - let data = combo#model#get ~row ~column in - cb data)) + (fun () -> + match combo#active_iter with + | None -> () + | Some row -> + let data = combo#model#get ~row ~column in + cb data)) type tree = GTree.view * (GTree.list_store * string GTree.column) diff --git a/sw/lib/ocaml/gtk_tools.mli b/sw/lib/ocaml/gtk_tools.mli index 737f112040..7e1f437735 100644 --- a/sw/lib/ocaml/gtk_tools.mli +++ b/sw/lib/ocaml/gtk_tools.mli @@ -22,25 +22,25 @@ * *) (** GTK utilities - *) +*) (** Allocate a drawing area and filling pixmap on request. if ~drawing_area is provided, width, heigh and packing are ignored *) class pixmap_in_drawin_area : - ?drawing_area:GMisc.drawing_area -> + ?drawing_area:GMisc.drawing_area -> ?width:int -> - ?height:int -> - ?packing:(GObj.widget -> unit) -> - unit -> - object - method drawing_area : GMisc.drawing_area + ?height:int -> + ?packing:(GObj.widget -> unit) -> + unit -> +object + method drawing_area : GMisc.drawing_area - method get_pixmap : unit -> GDraw.pixmap - (** Lazyly allocate a pixmap filling the drawing area *) + method get_pixmap : unit -> GDraw.pixmap + (** Lazyly allocate a pixmap filling the drawing area *) - method redraw : unit -> unit - (** Redraw the pixmap *) - end + method redraw : unit -> unit + (** Redraw the pixmap *) +end (*** Utilities for a combo box widget ***) diff --git a/sw/lib/ocaml/gtk_tools_GL.ml b/sw/lib/ocaml/gtk_tools_GL.ml index a23ef00b31..a014743cce 100644 --- a/sw/lib/ocaml/gtk_tools_GL.ml +++ b/sw/lib/ocaml/gtk_tools_GL.ml @@ -45,7 +45,7 @@ open Gtk_tools 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 () + ~width:width ~height:height ~packing:pack_method () (* ============================================================================= *) (* = Connection des fonctions de base a une drawing area OpenGL = *) @@ -56,11 +56,11 @@ let create_draw_glarea_base width height pack_method = (* = reshape_func = appelee lors d'un changement de taille = *) (* ============================================================================= *) let connect_draw_glarea_simple area - init_func display_func reshape_func = + 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 () + display_func (); Gl.flush (); area#swap_buffers () end) in (* Connection des fonctions *) @@ -82,12 +82,12 @@ let connect_draw_glarea_simple area (* = reshape_func = appelee lors d'un changement de taille = *) (* ============================================================================= *) let create_draw_glarea_simple width height pack_method - init_func display_func reshape_func = + 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 + init_func display_func reshape_func in (* Renvoie la zone de dessin et la nouvelle fonction de dessin *) (area, draw) @@ -118,9 +118,9 @@ 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))) ; + ~callback:(fun ev -> key_press (GdkEvent.Key.keyval ev))) ; ignore(area#event#connect#key_release - ~callback:(fun ev -> key_release (GdkEvent.Key.keyval ev))) ; + ~callback:(fun ev -> key_release (GdkEvent.Key.keyval ev))) ; area#misc#set_can_focus true ; area#misc#grab_focus () @@ -142,6 +142,6 @@ let gtk_to_gl_color color = (* ============================================================================= *) 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)) + int_of_float (b*.65535.0)) (* =============================== FIN ========================================= *) diff --git a/sw/lib/ocaml/gtk_tools_icons.ml b/sw/lib/ocaml/gtk_tools_icons.ml index a54045a6a6..36dbaeec10 100644 --- a/sw/lib/ocaml/gtk_tools_icons.ml +++ b/sw/lib/ocaml/gtk_tools_icons.ml @@ -24,213 +24,213 @@ 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 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 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."|] + " 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."|] + "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."|] diff --git a/sw/lib/ocaml/gtkgl_Hack.ml b/sw/lib/ocaml/gtkgl_Hack.ml index c4d0c44deb..06ed981638 100644 --- a/sw/lib/ocaml/gtkgl_Hack.ml +++ b/sw/lib/ocaml/gtkgl_Hack.ml @@ -1,28 +1,28 @@ -(* - * 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. - * - *) + (* + * 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. + * + *) -external load_bitmap_font : string -> GlList.base = - "_gtkgl_hack_load_bitmap_font" -external unload_bitmap_font : GlList.base -> unit = - "_gtkgl_hack_unload_bitmap_font" + external load_bitmap_font : string -> GlList.base = + "_gtkgl_hack_load_bitmap_font" + external unload_bitmap_font : GlList.base -> unit = + "_gtkgl_hack_unload_bitmap_font" -let gl_print_string font_base s = GlList.call_lists ~base:font_base(`byte s) + let gl_print_string font_base s = GlList.call_lists ~base:font_base(`byte s) diff --git a/sw/lib/ocaml/http.ml b/sw/lib/ocaml/http.ml index bcec3bb6b5..ae20b5f699 100644 --- a/sw/lib/ocaml/http.ml +++ b/sw/lib/ocaml/http.ml @@ -10,8 +10,8 @@ let file_of_url = fun ?dest url -> else let tmp_file = match dest with - Some s -> s - | None -> Filename.temp_file "fp" ".wget" in + Some s -> s + | None -> Filename.temp_file "fp" ".wget" in let call = new Http_client.get url in call#set_response_body_storage (`File (fun () -> tmp_file)); let pipeline = new Http_client.pipeline in diff --git a/sw/lib/ocaml/iGN.ml b/sw/lib/ocaml/iGN.ml index 0429e924c9..0a38502d2a 100644 --- a/sw/lib/ocaml/iGN.ml +++ b/sw/lib/ocaml/iGN.ml @@ -27,10 +27,10 @@ let (//) = Filename.concat module LL = Latlong type tile_t = { - key : int * int; (* LambertIIe meters / size_m *) - sw_corner : Latlong.geographic; - ne_corner : Latlong.geographic - };; + key : int * int; (* LambertIIe meters / size_m *) + sw_corner : Latlong.geographic; + ne_corner : Latlong.geographic +};; let size_px = 250 let size_m = (size_px * 25) / 10 diff --git a/sw/lib/ocaml/latlong.ml b/sw/lib/ocaml/latlong.ml index 65432e05e9..1e7e3d689a 100644 --- a/sw/lib/ocaml/latlong.ml +++ b/sw/lib/ocaml/latlong.ml @@ -60,7 +60,7 @@ let valid_geo = fun {posn_long = lambda; posn_lat = phi} -> type angle_unit = Semi | Rad | Deg | Grd let piradian = function - Semi -> 2. ** 31. | Rad -> pi | Deg -> 180. | Grd -> 200. +Semi -> 2. ** 31. | Rad -> pi | Deg -> 180. | Grd -> 200. let (>>) u1 u2 x = (x *. piradian u2) /. piradian u1;; let make_geo_deg = fun lat long -> @@ -113,7 +113,7 @@ let grs80 = { dx = 0.; dy = 0.; dz = 0. ; a = 6378137.0; df = 0.0033528106811823 type geodesic = NTF | ED50 | WGS84 | NAD27 type ntf = geographic let ellipsoid_of = function - NTF -> ntf | ED50 -> ed50 | WGS84 -> wgs84 | NAD27 -> nad27 +NTF -> ntf | ED50 -> ed50 | WGS84 -> wgs84 | NAD27 -> nad27 let latitude_isometrique phi e = @@ -132,15 +132,15 @@ let inverse_latitude_isometrique lat e epsilon = (* http://professionnels.ign.fr/DISPLAY/000/526/700/5267002/transformation.pdf *) type lambert_zone = { - ellipsoid : ellipsoid; - phi0 : radian; - c : float; - lambda0 : radian; - y0 : int; - x0 : int; - ys : int; - n : float - } + ellipsoid : ellipsoid; + phi0 : radian; + c : float; + lambda0 : radian; + y0 : int; + x0 : int; + ys : int; + n : float +} type meter = int type fmeter = float @@ -194,15 +194,15 @@ let lambertIII = let lambertIV = let phi0 = (Deg>>Rad) (decimal 42 09 54.) in { - ellipsoid = ntf; - lambda0 = (Deg>>Rad) (decimal 2 20 14.025); - phi0 = phi0; - x0 = 234; - y0 = 4185861; - ys = 7239162; - c = 12136281.99; - n = sin phi0; (* tangent projection *) - };; + ellipsoid = ntf; + lambda0 = (Deg>>Rad) (decimal 2 20 14.025); + phi0 = phi0; + x0 = 234; + y0 = 4185861; + ys = 7239162; + c = 12136281.99; + n = sin phi0; (* tangent projection *) + };; let lambert93 = { ellipsoid = grs80; @@ -252,7 +252,7 @@ let serie5 cc e = let cci = cc.(i) in let x = ref 0. in for j = 0 to Array.length cci - 1 do - x := !x +. cci.(j) *. ee.(j) + x := !x +. cci.(j) *. ee.(j) done; !x);; @@ -297,14 +297,14 @@ let utm_of' = fun geo -> z' := C.scal n !z'; { utm_zone = zone; utm_x = xs +. C.im !z'; utm_y = C.re !z' };; (* Benchmarks with limited bound on the for loop: - utm_of WGS84 {posn_lat = 0.8; posn_long = 0.1 };; - 4: {utm_x = 711976.494998118491; utm_y = 5079519.01467700768; utm_zone = 31} - 3: {utm_x = 711976.494993993081; utm_y = 5079519.01467550546; utm_zone = 31} - 2: {utm_x = 711976.49488538783; utm_y = 5079519.02243153844; utm_zone = 31} - 1: {utm_x = 711977.141232272843; utm_y = 5079519.25322676543; utm_zone = 31} - 0: {utm_x = 711985.538644456305; utm_y = 5074176.83014749549; utm_zone = 31} + utm_of WGS84 {posn_lat = 0.8; posn_long = 0.1 };; + 4: {utm_x = 711976.494998118491; utm_y = 5079519.01467700768; utm_zone = 31} + 3: {utm_x = 711976.494993993081; utm_y = 5079519.01467550546; utm_zone = 31} + 2: {utm_x = 711976.49488538783; utm_y = 5079519.02243153844; utm_zone = 31} + 1: {utm_x = 711977.141232272843; utm_y = 5079519.25322676543; utm_zone = 31} + 0: {utm_x = 711985.538644456305; utm_y = 5074176.83014749549; utm_zone = 31} -==> centimetric precision with 2 (i.e. using c(0), c(1) and c(2) + ==> centimetric precision with 2 (i.e. using c(0), c(1) and c(2) *) @@ -315,10 +315,10 @@ let utm_of = and u_ED50 = utm_of' ED50 and u_NAD27 = utm_of' NAD27 in fun geo -> match geo with - WGS84 -> u_WGS84 - | NTF -> u_NTF - | ED50 -> u_ED50 - | NAD27 -> u_NAD27 + WGS84 -> u_WGS84 + | NTF -> u_NTF + | ED50 -> u_ED50 + | NAD27 -> u_NAD27 let of_utm' geo = let ellipsoid = ellipsoid_of geo in @@ -354,10 +354,10 @@ let of_utm = and u_ED50 = of_utm' ED50 and u_NAD27 = of_utm' NAD27 in fun geo -> match geo with - WGS84 -> u_WGS84 - | NTF -> u_NTF - | ED50 -> u_ED50 - | NAD27 -> u_NAD27 + WGS84 -> u_WGS84 + | NTF -> u_NTF + | ED50 -> u_ED50 + | NAD27 -> u_NAD27 let (<<) geo1 geo2 ({posn_long = lambda; posn_lat = phi} as pos) = @@ -416,46 +416,46 @@ let ios = fun x -> try int_of_string x with _ -> failwith (Printf.sprintf "int_o let rodg = fun s -> (Deg>>Rad)(fos s) let of_string = fun s -> match Str.split space s with - ["WGS84"; lat; long] -> - make_geo (rodg lat) (rodg long) - | ["WGS84_dms"; lat_d; lat_m; lat_s; hemi; lon_d; lon_m; lon_s; east_west] -> + ["WGS84"; lat; long] -> + make_geo (rodg lat) (rodg long) + | ["WGS84_dms"; lat_d; lat_m; lat_s; hemi; lon_d; lon_m; lon_s; east_west] -> let sign_hemi = - match hemi with - "N" -> 1. | "S" -> -1. - | _ -> failwith (Printf.sprintf "N or S expected for hemispere in dms, found '%s'" hemi) in + match hemi with + "N" -> 1. | "S" -> -1. + | _ -> failwith (Printf.sprintf "N or S expected for hemispere in dms, found '%s'" hemi) in let sign_east = - match east_west with - "E" -> 1. | "W" -> -1. - | _ -> failwith (Printf.sprintf "E or W expected for hemispere in dms, found '%s'" east_west) in + match east_west with + "E" -> 1. | "W" -> -1. + | _ -> failwith (Printf.sprintf "E or W expected for hemispere in dms, found '%s'" east_west) in let lat = sign_hemi *. decimal (ios lat_d) (ios lat_m) (fos lat_s) and lon = sign_east *. decimal (ios lon_d) (ios lon_m) (fos lon_s) in make_geo ((Deg>>Rad) lat) ((Deg>>Rad) lon) - | ["WGS84_bearing"; lat; long; dir; dist] -> + | ["WGS84_bearing"; lat; long; dir; dist] -> let utm_ref = utm_of WGS84 (make_geo (rodg lat) (rodg long)) in let dir = rodg dir and dist = fos dist in let dx = dist *. sin dir and dy = dist *. cos dir in of_utm WGS84 (utm_add utm_ref (dx, dy)) - | ["UTM";x;y;zone] -> + | ["UTM";x;y;zone] -> of_utm WGS84 { utm_x = fos x; utm_y = fos y; utm_zone = ios zone} - | ["LBT2e";x;y] -> + | ["LBT2e";x;y] -> of_lambertIIe {lbt_x=ios x; lbt_y=ios y } - | _ -> invalid_arg (Printf.sprintf "Latlong.of_string: %s" s) + | _ -> invalid_arg (Printf.sprintf "Latlong.of_string: %s" s) let string_of = fun geo -> Printf.sprintf "WGS84 %s" (string_degrees_of_geographic geo) let deg_of_string = fun s -> match Str.split space s with - [lat_d; lat_m; lat_s] -> - decimal (ios lat_d) (ios lat_m) (fos lat_s) - | [lat_d; lat_m; lat_s; hemi] -> + [lat_d; lat_m; lat_s] -> + decimal (ios lat_d) (ios lat_m) (fos lat_s) + | [lat_d; lat_m; lat_s; hemi] -> let sign = - match hemi with - "N" | "E" -> 1. | "S" | "W" -> -1. - | _ -> failwith (Printf.sprintf "N or S expected for hemispere in dms, found '%s'" hemi) in + match hemi with + "N" | "E" -> 1. | "S" | "W" -> -1. + | _ -> failwith (Printf.sprintf "N or S expected for hemispere in dms, found '%s'" hemi) in sign *. decimal (ios lat_d) (ios lat_m) (fos lat_s) - | [deg] -> float_of_string deg - | _ -> invalid_arg (Printf.sprintf "Latlong.of_string: %s" s) + | [deg] -> float_of_string deg + | _ -> invalid_arg (Printf.sprintf "Latlong.of_string: %s" s) let mercator_lat = fun l -> log (tan (pi/.4. +. 0.5*. l)) @@ -476,8 +476,8 @@ let gps_epoch = 315964800. (* In seconds, in the unix reference *) let gps_tow_of_utc = fun ?wday hour min sec -> let wday = match wday with - Some w -> w - | None -> (Unix.gmtime (Unix.gettimeofday ())).Unix.tm_wday in + Some w -> w + | None -> (Unix.gmtime (Unix.gettimeofday ())).Unix.tm_wday in ((wday*24 + hour)*60+min)*60+sec + leap_seconds let get_gps_tow = fun () -> @@ -487,14 +487,14 @@ let get_gps_tow = fun () -> let unix_time_of_tow = fun ?week tow -> match week with - None -> - let host_tow = get_gps_tow () - and unix_now = Unix.gettimeofday () in - unix_now +. float (tow - host_tow) - | Some w -> + None -> + let host_tow = get_gps_tow () + and unix_now = Unix.gettimeofday () in + unix_now +. float (tow - host_tow) + | Some w -> gps_epoch - +. float w *. 60. *. 60. *. 24. *. 7. - +. float (tow - leap_seconds) + +. float w *. 60. *. 60. *. 24. *. 7. + +. float (tow - leap_seconds) @@ -505,30 +505,30 @@ type coordinates_kind = | Bearing of < pos : geographic> -let string_of_coordinates = fun kind geo -> - match kind with - WGS84_dec -> - string_degrees_of_geographic geo - | WGS84_dms -> - string_dms_of_geographic geo - | LBT2e -> - let l = lambertIIe_of geo in - Printf.sprintf "%d %d" l.lbt_x l.lbt_y - | Bearing georef -> - let (dx, dy) = utm_sub (utm_of WGS84 geo) (utm_of WGS84 georef#pos) in - let d = sqrt (dx*.dx+.dy*.dy) in - let bearing = (int_of_float ((Rad>>Deg)(atan2 dx dy)) + 360) mod 360 in - Printf.sprintf "%4d %4.0f" bearing d + let string_of_coordinates = fun kind geo -> + match kind with + WGS84_dec -> + string_degrees_of_geographic geo + | WGS84_dms -> + string_dms_of_geographic geo + | LBT2e -> + let l = lambertIIe_of geo in + Printf.sprintf "%d %d" l.lbt_x l.lbt_y + | Bearing georef -> + let (dx, dy) = utm_sub (utm_of WGS84 geo) (utm_of WGS84 georef#pos) in + let d = sqrt (dx*.dx+.dy*.dy) in + let bearing = (int_of_float ((Rad>>Deg)(atan2 dx dy)) + 360) mod 360 in + Printf.sprintf "%4d %4.0f" bearing d let geographic_of_coordinates = fun kind s -> match kind with - WGS84_dec -> - of_string ("WGS84 " ^ s) - | WGS84_dms -> + WGS84_dec -> + of_string ("WGS84 " ^ s) + | WGS84_dms -> of_string ("WGS84_dms " ^ s) - | LBT2e -> + | LBT2e -> of_string ("LBT2e " ^ s) - | Bearing georef -> + | Bearing georef -> of_string (Printf.sprintf "WGS84_bearing %s %s" (string_degrees_of_geographic georef#pos) s) @@ -630,12 +630,12 @@ let ecef_of_ned = fun r -> (** From gpsd geoid.c *) let bilinear = fun x1 y1 x2 y2 x y z11 z12 z21 z22 -> match x1 = x2, y1 = y2 with (* Check for exact grid points *) - true, true -> z11 - | true, false -> (z22*.(x-.x1)+.z11*.(x2-.x))/.(x2-.x1) - | false, true -> (z22*.(y-.y1)+.z11*.(y2-.y))/.(y2-.y1) - | false, false -> - let delta = (y2-.y1)*.(x2-.x1) in - (z22*.(y-.y1)*.(x-.x1)+.z12*.(y2-.y)*.(x-.x1)+.z21*.(y-.y1)*.(x2-.x)+.z11*.(y2-.y)*.(x2-.x))/.delta + true, true -> z11 + | true, false -> (z22*.(x-.x1)+.z11*.(x2-.x))/.(x2-.x1) + | false, true -> (z22*.(y-.y1)+.z11*.(y2-.y))/.(y2-.y1) + | false, false -> + let delta = (y2-.y1)*.(x2-.x1) in + (z22*.(y-.y1)*.(x-.x1)+.z12*.(y2-.y)*.(x-.x1)+.z21*.(y-.y1)*.(x2-.x)+.z11*.(y2-.y)*.(x2-.x))/.delta @@ -643,37 +643,37 @@ let bilinear = fun x1 y1 x2 y2 x y z11 z12 z21 z22 -> (** From gpsd geoid.c return geoid separtion (MSL-WGS84) in meters,given geographic coordinates*) let geoid_data = - [| (* 90S *) [|-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30; -30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30|]; - (* 80S *) [|-53;-54;-55;-52;-48;-42;-38;-38;-29;-26;-26;-24;-23;-21;-19;-16;-12; -8; -4; -1; 1; 4; 4; 6; 5; 4; 2; -6;-15;-24;-33;-40;-48;-50;-53;-52;-53|]; - (* 70S *) [|-61;-60;-61;-55;-49;-44;-38;-31;-25;-16; -6; 1; 4; 5; 4; 2; 6; 12; 16; 16; 17; 21; 20; 26; 26; 22; 16; 10; -1;-16;-29;-36;-46;-55;-54;-59;-61|]; - (* 60S *) [|-45;-43;-37;-32;-30;-26;-23;-22;-16;-10; -2; 10; 20; 20; 21; 24; 22; 17; 16; 19; 25; 30; 35; 35; 33; 30; 27; 10; -2;-14;-23;-30;-33;-29;-35;-43;-45|]; - (* 50S *) [|-15;-18;-18;-16;-17;-15;-10;-10; -8; -2; 6; 14; 13; 3; 3; 10; 20; 27; 25; 26; 34; 39; 45; 45; 38; 39; 28; 13; -1;-15;-22;-22;-18;-15;-14;-10;-15|]; - (* 40S *) [| 21; 6; 1; -7;-12;-12;-12;-10; -7; -1; 8; 23; 15; -2; -6; 6; 21; 24; 18; 26; 31; 33; 39; 41; 30; 24; 13; -2;-20;-32;-33;-27;-14; -2; 5; 20; 21|]; - (* 30S *) [| 46; 22; 5; -2; -8;-13;-10; -7; -4; 1; 9; 32; 16; 4; -8; 4; 12; 15; 22; 27; 34; 29; 14; 15; 15; 7; -9;-25;-37;-39;-23;-14; 15; 33; 34; 45; 46|]; - (* 20S *) [| 51; 27; 10; 0; -9;-11; -5; -2; -3; -1; 9; 35; 20; -5; -6; -5; 0; 13; 17; 23; 21; 8; -9;-10;-11;-20; -40;-47;-45;-25; 5; 23; 45; 58; 57; 63; 51|]; - (* 10S *) [| 36; 22; 11; 6; -1; -8;-10; -8;-11; -9; 1; 32; 4;-18;-13; -9; 4; 14; 12; 13; -2;-14;-25;-32;-38;-60; -75;-63;-26; 0; 35; 52; 68; 76; 64; 52; 36|]; - (* 00N *) [| 22; 16; 17; 13; 1;-12;-23;-20;-14; -3; 14; 10;-15;-27;-18; 3; 12; 20; 18; 12;-13; -9;-28;-49;-62;-89;-102;-63; -9; 33; 58; 73; 74; 63; 50; 32; 22|]; - (* 10N *) [| 13; 12; 11; 2;-11;-28;-38;-29;-10; 3; 1;-11;-41;-42;-16; 3; 17; 33; 22; 23; 2; -3; -7;-36;-59;-90; -95;-63;-24; 12; 53; 60; 58; 46; 36; 26; 13|]; - (* 20N *) [| 5; 10; 7; -7;-23;-39;-47;-34; -9;-10;-20;-45;-48;-32; -9; 17; 25; 31; 31; 26; 15; 6; 1;-29;-44;-61; -67;-59;-36;-11; 21; 39; 49; 39; 22; 10; 5|]; - (* 30N *) [| -7; -5; -8;-15;-28;-40;-42;-29;-22;-26;-32;-51;-40;-17; 17; 31; 34; 44; 36; 28; 29; 17; 12;-20;-15;-40; -33;-34;-34;-28; 7; 29; 43; 20; 4; -6; -7|]; - (* 40N *) [|-12;-10;-13;-20;-31;-34;-21;-16;-26;-34;-33;-35;-26; 2; 33; 59; 52; 51; 52; 48; 35; 40; 33; -9;-28;-39; -48;-59;-50;-28; 3; 23; 37; 18; -1;-11;-12|]; - (* 50N *) [| -8; 8; 8; 1;-11;-19;-16;-18;-22;-35;-40;-26;-12; 24; 45; 63; 62; 59; 47; 48; 42; 28; 12;-10;-19;-33; -43;-42;-43;-29; -2; 17; 23; 22; 6; 2; -8|]; - (* 60N *) [| 2; 9; 17; 10; 13; 1;-14;-30;-39;-46;-42;-21; 6; 29; 49; 65; 60; 57; 47; 41; 21; 18; 14; 7; -3;-22; -29;-32;-32;-26;-15; -2; 13; 17; 19; 6; 2|]; - (* 70N *) [| 2; 2; 1; -1; -3; -7;-14;-24;-27;-25;-19; 3; 24; 37; 47; 60; 61; 58; 51; 43; 29; 20; 12; 5; -2;-10; -14;-12;-10;-14;-12; -6; -2; 3; 6; 4; 2|]; - (* 80N *) [| 3; 1; -2; -3; -3; -3; -1; 3; 1; 5; 9; 11; 19; 27; 31; 34; 33; 34; 33; 34; 28; 23; 17; 13; 9; 4; 4; 1; -2; -2; 0; 2; 3; 2; 1; 1; 3|]; - (* 90N *) [| 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13|]|] + [| (* 90S *) [|-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30; -30;-30;-30;-30;-30;-30;-30;-30;-30;-30;-30|]; + (* 80S *) [|-53;-54;-55;-52;-48;-42;-38;-38;-29;-26;-26;-24;-23;-21;-19;-16;-12; -8; -4; -1; 1; 4; 4; 6; 5; 4; 2; -6;-15;-24;-33;-40;-48;-50;-53;-52;-53|]; + (* 70S *) [|-61;-60;-61;-55;-49;-44;-38;-31;-25;-16; -6; 1; 4; 5; 4; 2; 6; 12; 16; 16; 17; 21; 20; 26; 26; 22; 16; 10; -1;-16;-29;-36;-46;-55;-54;-59;-61|]; + (* 60S *) [|-45;-43;-37;-32;-30;-26;-23;-22;-16;-10; -2; 10; 20; 20; 21; 24; 22; 17; 16; 19; 25; 30; 35; 35; 33; 30; 27; 10; -2;-14;-23;-30;-33;-29;-35;-43;-45|]; + (* 50S *) [|-15;-18;-18;-16;-17;-15;-10;-10; -8; -2; 6; 14; 13; 3; 3; 10; 20; 27; 25; 26; 34; 39; 45; 45; 38; 39; 28; 13; -1;-15;-22;-22;-18;-15;-14;-10;-15|]; + (* 40S *) [| 21; 6; 1; -7;-12;-12;-12;-10; -7; -1; 8; 23; 15; -2; -6; 6; 21; 24; 18; 26; 31; 33; 39; 41; 30; 24; 13; -2;-20;-32;-33;-27;-14; -2; 5; 20; 21|]; + (* 30S *) [| 46; 22; 5; -2; -8;-13;-10; -7; -4; 1; 9; 32; 16; 4; -8; 4; 12; 15; 22; 27; 34; 29; 14; 15; 15; 7; -9;-25;-37;-39;-23;-14; 15; 33; 34; 45; 46|]; + (* 20S *) [| 51; 27; 10; 0; -9;-11; -5; -2; -3; -1; 9; 35; 20; -5; -6; -5; 0; 13; 17; 23; 21; 8; -9;-10;-11;-20; -40;-47;-45;-25; 5; 23; 45; 58; 57; 63; 51|]; + (* 10S *) [| 36; 22; 11; 6; -1; -8;-10; -8;-11; -9; 1; 32; 4;-18;-13; -9; 4; 14; 12; 13; -2;-14;-25;-32;-38;-60; -75;-63;-26; 0; 35; 52; 68; 76; 64; 52; 36|]; + (* 00N *) [| 22; 16; 17; 13; 1;-12;-23;-20;-14; -3; 14; 10;-15;-27;-18; 3; 12; 20; 18; 12;-13; -9;-28;-49;-62;-89;-102;-63; -9; 33; 58; 73; 74; 63; 50; 32; 22|]; + (* 10N *) [| 13; 12; 11; 2;-11;-28;-38;-29;-10; 3; 1;-11;-41;-42;-16; 3; 17; 33; 22; 23; 2; -3; -7;-36;-59;-90; -95;-63;-24; 12; 53; 60; 58; 46; 36; 26; 13|]; + (* 20N *) [| 5; 10; 7; -7;-23;-39;-47;-34; -9;-10;-20;-45;-48;-32; -9; 17; 25; 31; 31; 26; 15; 6; 1;-29;-44;-61; -67;-59;-36;-11; 21; 39; 49; 39; 22; 10; 5|]; + (* 30N *) [| -7; -5; -8;-15;-28;-40;-42;-29;-22;-26;-32;-51;-40;-17; 17; 31; 34; 44; 36; 28; 29; 17; 12;-20;-15;-40; -33;-34;-34;-28; 7; 29; 43; 20; 4; -6; -7|]; + (* 40N *) [|-12;-10;-13;-20;-31;-34;-21;-16;-26;-34;-33;-35;-26; 2; 33; 59; 52; 51; 52; 48; 35; 40; 33; -9;-28;-39; -48;-59;-50;-28; 3; 23; 37; 18; -1;-11;-12|]; + (* 50N *) [| -8; 8; 8; 1;-11;-19;-16;-18;-22;-35;-40;-26;-12; 24; 45; 63; 62; 59; 47; 48; 42; 28; 12;-10;-19;-33; -43;-42;-43;-29; -2; 17; 23; 22; 6; 2; -8|]; + (* 60N *) [| 2; 9; 17; 10; 13; 1;-14;-30;-39;-46;-42;-21; 6; 29; 49; 65; 60; 57; 47; 41; 21; 18; 14; 7; -3;-22; -29;-32;-32;-26;-15; -2; 13; 17; 19; 6; 2|]; + (* 70N *) [| 2; 2; 1; -1; -3; -7;-14;-24;-27;-25;-19; 3; 24; 37; 47; 60; 61; 58; 51; 43; 29; 20; 12; 5; -2;-10; -14;-12;-10;-14;-12; -6; -2; 3; 6; 4; 2|]; + (* 80N *) [| 3; 1; -2; -3; -3; -3; -1; 3; 1; 5; 9; 11; 19; 27; 31; 34; 33; 34; 33; 34; 28; 23; 17; 13; 9; 4; 4; 1; -2; -2; 0; 2; 3; 2; 1; 1; 3|]; + (* 90N *) [| 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13; 13|]|] (* Online geoid calculator : http://earth-info.nga.mil/GandG/wgs84/gravitymod/egm96/intpt.html -lat lon EGM96 this function -41. 1. 49.83 51.15 -35 -140 -32.53 -29.5 -56 6 41.82 45.08 -77 13 37.71 34.18 --35 144 8.15 6.5 - *) + lat lon EGM96 this function + 41. 1. 49.83 51.15 + 35 -140 -32.53 -29.5 + 56 6 41.82 45.08 + 77 13 37.71 34.18 + -35 144 8.15 6.5 +*) let wgs84_hmsl = fun geo -> let n_rows = Array.length geoid_data and n_cols = Array.length geoid_data.(0) in diff --git a/sw/lib/ocaml/logpprz.ml b/sw/lib/ocaml/logpprz.ml index 9ad2de0fbd..338f4a2dbe 100644 --- a/sw/lib/ocaml/logpprz.ml +++ b/sw/lib/ocaml/logpprz.ml @@ -25,10 +25,10 @@ open Printf type message = { - source : int; - timestamp : int32; - pprz_data : Serial.payload - } + source : int; + timestamp : int32; + pprz_data : Serial.payload +} module Transport = struct diff --git a/sw/lib/ocaml/mapCanvas.ml b/sw/lib/ocaml/mapCanvas.ml index 06ba68f4e2..ac764271a1 100644 --- a/sw/lib/ocaml/mapCanvas.ml +++ b/sw/lib/ocaml/mapCanvas.ml @@ -57,7 +57,7 @@ type projection = | LambertIIe (* 1m = 1 world unit, y axis reversed *) let string_of_projection = function - UTM -> "UTM" +UTM -> "UTM" | Mercator -> "Mercator" | LambertIIe -> "LBT2e" @@ -103,29 +103,29 @@ let pvect (x1,y1) (x2,y2) = x1*.y2-.y1*.x2 let rec convexify = fun l -> match l with - [] | [_] | [_;_] -> l - | (x1,y1)::(x2,y2)::(x3,y3)::l -> + [] | [_] | [_;_] -> l + | (x1,y1)::(x2,y2)::(x3,y3)::l -> if pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2) < 0. then convexify ((x1,y1)::(x3,y3)::l) else (x1,y1)::convexify ((x2,y2)::(x3,y3)::l) let convex = fun l -> match convexify l with - [] -> [] - | (x3,y3)::ps -> + [] -> [] + | (x3,y3)::ps -> (** Remove last bad points *) let rec loop = fun l -> - match l with - [] | [_] -> l - | (x2,y2)::(x1,y1)::pts -> - if pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2) < 0. - then loop ((x1,y1)::pts) - else l in + match l with + [] | [_] -> l + | (x2,y2)::(x1,y1)::pts -> + if pvect (x3-.x2, y3-.y2) (x1-.x2,y1-.y2) < 0. + then loop ((x1,y1)::pts) + else l in (x3,y3)::List.rev (loop (List.rev ps)) class type geographic = object - method pos : Latlong.geographic + method pos : Latlong.geographic end @@ -177,456 +177,456 @@ class basic_widget = fun ?(height=800) ?width ?(projection = Mercator) ?georef ( (* Time *) let utc_time = GnoCanvas.text ~x:0. ~y:0. ~props:[`TEXT "00:00:00"; `FILL_COLOR "green"; `ANCHOR `NW] still in - object (self) +object (self) -(** GUI attributes *) + (** GUI attributes *) - val background = background - val toolbar = toolbar - method toolbar = toolbar - method background = background - method still = still - method maps = maps - method top_still = 3.5*.s - method utc_time = utc_time - method set_utc_time = fun h m s -> - let string = sprintf "%02d:%02d:%02d" h m s in - utc_time#set [`TEXT string] + val background = background + val toolbar = toolbar + method toolbar = toolbar + method background = background + method still = still + method maps = maps + method top_still = 3.5*.s + method utc_time = utc_time + method set_utc_time = fun h m s -> + let string = sprintf "%02d:%02d:%02d" h m s in + utc_time#set [`TEXT string] - method wind_sock = wind_sock - method set_wind_sock = fun angle_deg string -> - let angle_rad = (Deg>>Rad) (90. +. angle_deg) in - wind_sock#item#affine_absolute (affine_pos_and_angle 60. 60. angle_rad); - wind_sock#label#set [`TEXT string] + method wind_sock = wind_sock + method set_wind_sock = fun angle_deg string -> + let angle_rad = (Deg>>Rad) (90. +. angle_deg) in + wind_sock#item#affine_absolute (affine_pos_and_angle 60. 60. angle_rad); + wind_sock#label#set [`TEXT string] - val adj = GData.adjustment - ~value:1. ~lower:0.005 ~upper:10. - ~step_incr:0.25 ~page_incr:1.0 ~page_size:0. () + val adj = GData.adjustment + ~value:1. ~lower:0.005 ~upper:10. + ~step_incr:0.25 ~page_incr:1.0 ~page_size:0. () - method info = info + method info = info -(** other attributes *) + (** other attributes *) - val mutable projection = projection - val mutable georef = georef - val mutable dragging = None - val mutable drawing = NotDrawing - val mutable region = None (* Rectangle selected region *) - val mutable last_mouse_x = 0 - val mutable last_mouse_y = 0 + val mutable projection = projection + val mutable georef = georef + val mutable dragging = None + val mutable drawing = NotDrawing + val mutable region = None (* Rectangle selected region *) + val mutable last_mouse_x = 0 + val mutable last_mouse_y = 0 - val mutable fitted_objects = ([] : geographic list) + val mutable fitted_objects = ([] : geographic list) - method region = region - method register_to_fit = fun o -> fitted_objects <- o :: fitted_objects + method region = region + method register_to_fit = fun o -> fitted_objects <- o :: fitted_objects - method fit_to_window () = - let min_lat, max_lat, min_long, max_long = - List.fold_right - (fun p (min_lat, max_lat, min_long, max_long) -> - let pos = p#pos in - let lat = pos.LL.posn_lat - and long = pos.LL.posn_long in - (* Processing over positive longitudes *) - let long = if long < 0. then long +. 2. *. pi else long in - (min min_lat lat, max max_lat lat, - min min_long long, max max_long long)) - fitted_objects - (max_float, -.max_float, max_float, -. max_float) in + method fit_to_window () = + let min_lat, max_lat, min_long, max_long = + List.fold_right + (fun p (min_lat, max_lat, min_long, max_long) -> + let pos = p#pos in + let lat = pos.LL.posn_lat + and long = pos.LL.posn_long in + (* Processing over positive longitudes *) + let long = if long < 0. then long +. 2. *. pi else long in + (min min_lat lat, max max_lat lat, + min min_long long, max max_long long)) + fitted_objects + (max_float, -.max_float, max_float, -. max_float) in - (* Over 0° ? *) - let min_long, max_long = - if max_long -. min_long > pi - then (max_long -. 2. *. pi, min_long) - else (min_long, max_long) in + (* Over 0° ? *) + let min_long, max_long = + if max_long -. min_long > pi + then (max_long -. 2. *. pi, min_long) + else (min_long, max_long) in - (* Longitude is renormalized here *) - let c = LL.make_geo ((min_lat+.max_lat)/.2.) ((min_long+.max_long)/.2.) - and nw_xw, nw_yw = self#world_of (LL.make_geo max_lat min_long) - and se_xw, se_yw = self#world_of (LL.make_geo min_lat max_long) in - let width, height = Gdk.Drawable.get_size canvas#misc#window in - let margin = 10 in - let width = width - 2*margin and height = height - 2*margin in - let zoom = min (float width/.(se_xw-.nw_xw)) (float height/.(se_yw-.nw_yw)) in - self#zoom zoom; - self#center c + (* Longitude is renormalized here *) + let c = LL.make_geo ((min_lat+.max_lat)/.2.) ((min_long+.max_long)/.2.) + and nw_xw, nw_yw = self#world_of (LL.make_geo max_lat min_long) + and se_xw, se_yw = self#world_of (LL.make_geo min_lat max_long) in + let width, height = Gdk.Drawable.get_size canvas#misc#window in + let margin = 10 in + let width = width - 2*margin and height = height - 2*margin in + let zoom = min (float width/.(se_xw-.nw_xw)) (float height/.(se_yw-.nw_yw)) in + self#zoom zoom; + self#center c -(** initialization of instance attributes *) + (** initialization of instance attributes *) - initializer ( + initializer ( - spin_button#set_adjustment adj; + spin_button#set_adjustment adj; - utc_time#hide (); + utc_time#hide (); - ignore (GMisc.separator ~packing:(toolbar#pack ~from:`END) `VERTICAL ()); + ignore (GMisc.separator ~packing:(toolbar#pack ~from:`END) `VERTICAL ()); -(** callback bindings *) + (** callback bindings *) - canvas#coerce#misc#modify_bg [`NORMAL, `BLACK]; - ignore (background#connect#event self#background_event); + canvas#coerce#misc#modify_bg [`NORMAL, `BLACK]; + ignore (background#connect#event self#background_event); - ignore (canvas#event#connect#motion_notify self#mouse_motion); - ignore (canvas#event#connect#after#key_press self#key_press) ; - ignore (canvas#event#connect#enter_notify (fun _ -> self#canvas#misc#grab_focus () ; false)); - ignore (canvas#event#connect#any self#any_event); - ignore (adj#connect#value_changed (fun () -> canvas#set_pixels_per_unit adj#value)); + ignore (canvas#event#connect#motion_notify self#mouse_motion); + ignore (canvas#event#connect#after#key_press self#key_press) ; + ignore (canvas#event#connect#enter_notify (fun _ -> self#canvas#misc#grab_focus () ; false)); + ignore (canvas#event#connect#any self#any_event); + ignore (adj#connect#value_changed (fun () -> canvas#set_pixels_per_unit adj#value)); - canvas#set_center_scroll_region false ; - canvas#set_scroll_region (-25000000.) (-25000000.) 25000000. 25000000.; -(* ignore (GnoCanvas.rect ~props:[`X1 (-25000000.); `Y1 (-25000000.); `X2 25000000.; `Y2 25000000.; `FILL_COLOR "black"] background); *) + canvas#set_center_scroll_region false ; + canvas#set_scroll_region (-25000000.) (-25000000.) 25000000. 25000000.; + (* ignore (GnoCanvas.rect ~props:[`X1 (-25000000.); `Y1 (-25000000.); `X2 25000000.; `Y2 25000000.; `FILL_COLOR "black"] background); *) - ) + ) -(** methods *) + (** methods *) -(** accessors to instance variables *) - method current_zoom = adj#value - method canvas = canvas - method frame = frame - method factory = factory - method menubar = menubar - method file_menu = file_menu - method window_to_world = canvas#window_to_world - method root = canvas#root - method zoom_adj = adj + (** accessors to instance variables *) + method current_zoom = adj#value + method canvas = canvas + method frame = frame + method factory = factory + method menubar = menubar + method file_menu = file_menu + method window_to_world = canvas#window_to_world + method root = canvas#root + method zoom_adj = adj -(** following display functions can be redefined by subclasses. - they do nothing in the basic_widget *) - method display_geo = fun _s -> () - method display_alt = fun _wgs84 -> () - method display_group = fun _s -> () + (** following display functions can be redefined by subclasses. + they do nothing in the basic_widget *) + method display_geo = fun _s -> () + method display_alt = fun _wgs84 -> () + method display_group = fun _s -> () - method georef = georef - method set_georef = fun wgs84 -> georef <- Some wgs84 + method georef = georef + method set_georef = fun wgs84 -> georef <- Some wgs84 - method projection = string_of_projection projection + method projection = string_of_projection projection - method world_of = fun wgs84 -> - assert (LL.valid_geo wgs84); - match georef with - Some georef -> begin - match projection with - UTM -> - let utmref = LL.utm_of LL.WGS84 georef - and utm = LL.utm_of LL.WGS84 wgs84 in - let (wx, y) = LL.utm_sub utm utmref in - (wx, -.y) - | Mercator -> - let mlref = LL.mercator_lat georef.LL.posn_lat - and ml = LL.mercator_lat wgs84.LL.posn_lat in - let dl = LL.norm_angle (wgs84.LL.posn_long -. georef.LL.posn_long) in - let xw = dl *. mercator_coeff - and yw = -. (ml -. mlref) *. mercator_coeff in - (xw, yw) - | LambertIIe -> - let lbtref = LL.lambertIIe_of georef - and lbt = LL.lambertIIe_of wgs84 in - let (wx, y) = LL.lbt_sub lbt lbtref in - (wx, -.y) - end + method world_of = fun wgs84 -> + assert (LL.valid_geo wgs84); + match georef with + Some georef -> begin + match projection with + UTM -> + let utmref = LL.utm_of LL.WGS84 georef + and utm = LL.utm_of LL.WGS84 wgs84 in + let (wx, y) = LL.utm_sub utm utmref in + (wx, -.y) + | Mercator -> + let mlref = LL.mercator_lat georef.LL.posn_lat + and ml = LL.mercator_lat wgs84.LL.posn_lat in + let dl = LL.norm_angle (wgs84.LL.posn_long -. georef.LL.posn_long) in + let xw = dl *. mercator_coeff + and yw = -. (ml -. mlref) *. mercator_coeff in + (xw, yw) + | LambertIIe -> + let lbtref = LL.lambertIIe_of georef + and lbt = LL.lambertIIe_of wgs84 in + let (wx, y) = LL.lbt_sub lbt lbtref in + (wx, -.y) + end | None -> failwith "#world_of : no georef" - method pt2D_of = fun wgs84 -> - let (x, y) = self#world_of wgs84 in - {G2D.x2D = x; y2D = y} + method pt2D_of = fun wgs84 -> + let (x, y) = self#world_of wgs84 in + {G2D.x2D = x; y2D = y} - method of_world = fun (wx, wy) -> - match georef with - Some georef -> begin - match projection with - UTM -> - let utmref = LL.utm_of LL.WGS84 georef in - LL.of_utm LL.WGS84 (LL.utm_add utmref (wx, -.wy)) - | LambertIIe -> - let utmref = LL.lambertIIe_of georef in - LL.of_lambertIIe (LL.lbt_add utmref (wx, -.wy)) - | Mercator -> - let mlref = LL.mercator_lat georef.LL.posn_lat in - let ml = mlref -. wy /. mercator_coeff in - let lat = LL.inv_mercator_lat ml - and long = wx /. mercator_coeff +. georef.LL.posn_long in - LL.make_geo lat long - end + method of_world = fun (wx, wy) -> + match georef with + Some georef -> begin + match projection with + UTM -> + let utmref = LL.utm_of LL.WGS84 georef in + LL.of_utm LL.WGS84 (LL.utm_add utmref (wx, -.wy)) + | LambertIIe -> + let utmref = LL.lambertIIe_of georef in + LL.of_lambertIIe (LL.lbt_add utmref (wx, -.wy)) + | Mercator -> + let mlref = LL.mercator_lat georef.LL.posn_lat in + let ml = mlref -. wy /. mercator_coeff in + let lat = LL.inv_mercator_lat ml + and long = wx /. mercator_coeff +. georef.LL.posn_long in + LL.make_geo lat long + end | None -> failwith "#of_world : no georef" - method move_item = fun (item:GnomeCanvas.re_p GnoCanvas.item) wgs84 -> - let (xw,yw) = self#world_of wgs84 in - item#affine_absolute (affine_pos_and_angle xw yw 0.); + method move_item = fun (item:GnomeCanvas.re_p GnoCanvas.item) wgs84 -> + let (xw,yw) = self#world_of wgs84 in + item#affine_absolute (affine_pos_and_angle xw yw 0.); - method moveto = fun wgs84 -> - let (xw, yw) = self#world_of wgs84 in - let (xc, yc) = canvas#world_to_window xw yw in - canvas#scroll_to (truncate xc) (truncate yc) + method moveto = fun wgs84 -> + let (xw, yw) = self#world_of wgs84 in + let (xc, yc) = canvas#world_to_window xw yw in + canvas#scroll_to (truncate xc) (truncate yc) - method center = fun wgs84 -> - self#moveto wgs84; - let sx_w, sy_w = Gdk.Drawable.get_size canvas#misc#window - and (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to (x-sx_w/2) (y-sy_w/2) + method center = fun wgs84 -> + self#moveto wgs84; + let sx_w, sy_w = Gdk.Drawable.get_size canvas#misc#window + and (x, y) = canvas#get_scroll_offsets in + canvas#scroll_to (x-sx_w/2) (y-sy_w/2) - method get_center = fun () -> - let (x, y) = canvas#get_scroll_offsets - and (sx_w, sy_w) = Gdk.Drawable.get_size canvas#misc#window in - let xc = x + sx_w/2 and yc = y + sy_w/2 in - let (xw, yw) = canvas#window_to_world (float xc) (float yc) in - self#of_world (xw, yw) + method get_center = fun () -> + let (x, y) = canvas#get_scroll_offsets + and (sx_w, sy_w) = Gdk.Drawable.get_size canvas#misc#window in + let xc = x + sx_w/2 and yc = y + sy_w/2 in + let (xw, yw) = canvas#window_to_world (float xc) (float yc) in + self#of_world (xw, yw) - method display_pixbuf = fun ?opacity ?level ((x1,y1), geo1) ((x2,y2), geo2) image -> - let x1 = float x1 and x2 = float x2 - and y1 = float y1 and y2 = float y2 in - let image = - match opacity with - None -> image - | Some o -> set_opacity image o in - let map_layer = match level with - | None -> 0 - | Some l -> - if l > Gm.zoom_max then - Array.length maps - 1 - else if l < Gm.zoom_min then - 0 - else l - Gm.zoom_min - in - let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1) ~pixbuf:image ~props:[`ANCHOR `NW] maps.(map_layer) in - let xw1, yw1 = self#world_of geo1 - and xw2, yw2 = self#world_of geo2 in + method display_pixbuf = fun ?opacity ?level ((x1,y1), geo1) ((x2,y2), geo2) image -> + let x1 = float x1 and x2 = float x2 + and y1 = float y1 and y2 = float y2 in + let image = + match opacity with + None -> image + | Some o -> set_opacity image o in + let map_layer = match level with + | None -> 0 + | Some l -> + if l > Gm.zoom_max then + Array.length maps - 1 + else if l < Gm.zoom_min then + 0 + else l - Gm.zoom_min + in + let pix = GnoCanvas.pixbuf ~x:(-.x1) ~y:(-.y1) ~pixbuf:image ~props:[`ANCHOR `NW] maps.(map_layer) in + let xw1, yw1 = self#world_of geo1 + and xw2, yw2 = self#world_of geo2 in - let scale = distance (xw1, yw1) (xw2, yw2) /. distance (x1,y1) (x2,y2) in - let a = atan2 (yw2-.yw1) (xw2-.xw1) -. atan2 (y2-.y1) (x2-.x1) in - let cos_a = cos a *. scale and sin_a = sin a *. scale in - pix#move xw1 yw1; - pix#affine_relative [| cos_a; sin_a; -. sin_a; cos_a; 0.;0.|]; - pix + let scale = distance (xw1, yw1) (xw2, yw2) /. distance (x1,y1) (x2,y2) in + let a = atan2 (yw2-.yw1) (xw2-.xw1) -. atan2 (y2-.y1) (x2-.x1) in + let cos_a = cos a *. scale and sin_a = sin a *. scale in + pix#move xw1 yw1; + pix#affine_relative [| cos_a; sin_a; -. sin_a; cos_a; 0.;0.|]; + pix - method fix_bg_coords (xw, yw) = (** FIXME: how to do it properly ? *) - let z = self#current_zoom in - ((xw +. 25000000.) *. z, (yw +. 25000000.) *. z) + method fix_bg_coords (xw, yw) = (** FIXME: how to do it properly ? *) + let z = self#current_zoom in + ((xw +. 25000000.) *. z, (yw +. 25000000.) *. z) - method zoom = fun value -> - adj#set_value value + method zoom = fun value -> + adj#set_value value - (** events *******************************************) - method background_event = fun ev -> - match ev with + (** events *******************************************) + method background_event = fun ev -> + match ev with | `BUTTON_PRESS ev when GdkEvent.Button.button ev = 1 -> - begin - let xc = GdkEvent.Button.x ev - and yc = GdkEvent.Button.y ev - and state = GdkEvent.Button.state ev in - let (xw,yw) = self#window_to_world xc yc in - let (xw, yw) = self#fix_bg_coords (xw, yw) in - if Gdk.Convert.test_modifier `SHIFT state then begin - drawing <- Rectangle (xw,yw); - region_rectangle#set [`X1 xw; `Y1 yw; `X2 xw; `Y2 yw]; - region_rectangle#raise_to_top () - end else begin (* panning *) - drawing <- Panning (xc, yc); - let curs = Gdk.Cursor.create `FLEUR in - background#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs - (GdkEvent.Button.time ev) - end; - true - end + begin + let xc = GdkEvent.Button.x ev + and yc = GdkEvent.Button.y ev + and state = GdkEvent.Button.state ev in + let (xw,yw) = self#window_to_world xc yc in + let (xw, yw) = self#fix_bg_coords (xw, yw) in + if Gdk.Convert.test_modifier `SHIFT state then begin + drawing <- Rectangle (xw,yw); + region_rectangle#set [`X1 xw; `Y1 yw; `X2 xw; `Y2 yw]; + region_rectangle#raise_to_top () + end else begin (* panning *) + drawing <- Panning (xc, yc); + let curs = Gdk.Cursor.create `FLEUR in + background#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs + (GdkEvent.Button.time ev) + end; + true + end | `MOTION_NOTIFY ev -> - begin - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let (xw, yw) = self#window_to_world xc yc in - let (xw, yw) = self#fix_bg_coords (xw, yw) in - match drawing with - Rectangle (x1,y1) -> - let starting_point = self#of_world (x1,y1) in - let starting_point = LL.utm_of LL.WGS84 starting_point in - let current_point = LL.utm_of LL.WGS84 (self#of_world (xw, yw)) in - let (east, north) = LL.utm_sub current_point starting_point in - region_rectangle#set [`X2 xw; `Y2 yw]; - self#display_group (sprintf "[%.0fm %.0fm]" east north) - | Panning (x0, y0) -> - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let dx = self#current_zoom *. (xc -. x0) - and dy = self#current_zoom *. (yc -. y0) in - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to (x-truncate dx) (y-truncate dy) - | _ -> () - end; - false + begin + let xc = GdkEvent.Motion.x ev + and yc = GdkEvent.Motion.y ev in + let (xw, yw) = self#window_to_world xc yc in + let (xw, yw) = self#fix_bg_coords (xw, yw) in + match drawing with + Rectangle (x1,y1) -> + let starting_point = self#of_world (x1,y1) in + let starting_point = LL.utm_of LL.WGS84 starting_point in + let current_point = LL.utm_of LL.WGS84 (self#of_world (xw, yw)) in + let (east, north) = LL.utm_sub current_point starting_point in + region_rectangle#set [`X2 xw; `Y2 yw]; + self#display_group (sprintf "[%.0fm %.0fm]" east north) + | Panning (x0, y0) -> + let xc = GdkEvent.Motion.x ev + and yc = GdkEvent.Motion.y ev in + let dx = self#current_zoom *. (xc -. x0) + and dy = self#current_zoom *. (yc -. y0) in + let (x, y) = canvas#get_scroll_offsets in + canvas#scroll_to (x-truncate dx) (y-truncate dy) + | _ -> () + end; + false | `BUTTON_RELEASE ev when GdkEvent.Button.button ev = 1 -> - begin - let xc = GdkEvent.Button.x ev in - let yc = GdkEvent.Button.y ev in - let current_point = self#window_to_world xc yc in - let current_point = self#fix_bg_coords current_point in - match drawing with - Rectangle (x1,y1) -> - region <- Some ((x1,y1), current_point); - self#display_group ""; - drawing <- NotDrawing; - true - | Panning _ -> - drawing <- NotDrawing; - background#ungrab (GdkEvent.Button.time ev); - true - | _ -> false - end + begin + let xc = GdkEvent.Button.x ev in + let yc = GdkEvent.Button.y ev in + let current_point = self#window_to_world xc yc in + let current_point = self#fix_bg_coords current_point in + match drawing with + Rectangle (x1,y1) -> + region <- Some ((x1,y1), current_point); + self#display_group ""; + drawing <- NotDrawing; + true + | Panning _ -> + drawing <- NotDrawing; + background#ungrab (GdkEvent.Button.time ev); + true + | _ -> false + end | _ -> false - method mouse_motion = fun ev -> - if georef <> None then begin - let xc = GdkEvent.Motion.x ev - and yc = GdkEvent.Motion.y ev in - let (xw, yw) = self#window_to_world xc yc in - self#display_geo (self#of_world (xw,yw)); - self#display_alt (self#of_world (xw,yw)); - let (x, y) = canvas#get_scroll_offsets in - last_mouse_x <- truncate xc - x; - last_mouse_y <- truncate yc - y - end; - false - - method switch_background = fun x -> if x then background#show () else background#hide () - - - method key_press = fun ev -> + method mouse_motion = fun ev -> + if georef <> None then begin + let xc = GdkEvent.Motion.x ev + and yc = GdkEvent.Motion.y ev in + let (xw, yw) = self#window_to_world xc yc in + self#display_geo (self#of_world (xw,yw)); + self#display_alt (self#of_world (xw,yw)); let (x, y) = canvas#get_scroll_offsets in - match GdkEvent.Key.keyval ev with + last_mouse_x <- truncate xc - x; + last_mouse_y <- truncate yc - y + end; + false + + method switch_background = fun x -> if x then background#show () else background#hide () + + + method key_press = fun ev -> + let (x, y) = canvas#get_scroll_offsets in + match GdkEvent.Key.keyval ev with | k when k = GdkKeysyms._Up -> canvas#scroll_to x (y-pan_step) ; true | k when k = GdkKeysyms._Down -> canvas#scroll_to x (y+pan_step) ; true | k when k = GdkKeysyms._Left -> canvas#scroll_to (x-pan_step) y ; true | k when k = GdkKeysyms._Right -> canvas#scroll_to (x+pan_step) y ; true | k when k = GdkKeysyms._f -> self#fit_to_window () ; true | k when k = GdkKeysyms._Page_Up -> - self#zoom_up (); - true + self#zoom_up (); + true | k when k = GdkKeysyms._Page_Down -> - self#zoom_down (); - true + self#zoom_down (); + true | _ -> false - method connect_view = fun cb -> - Hashtbl.add view_cbs cb () + method connect_view = fun cb -> + Hashtbl.add view_cbs cb () - method zoom_in_place = fun z -> + method zoom_in_place = fun z -> + let (x, y) = canvas#get_scroll_offsets in + canvas#scroll_to (x+last_mouse_x) (y+last_mouse_y); + + adj#set_value z; + + let (x, y) = canvas#get_scroll_offsets in + canvas#scroll_to (x-last_mouse_x) (y-last_mouse_y) + + method zoom_up () = + self#zoom_in_place (adj#value*.zoom_factor); + method zoom_down () = + self#zoom_in_place (adj#value/.zoom_factor); + + method any_event = + let rec last_view = ref (0,0,0,0) in + fun ev -> + let width_c, height_c = Gdk.Drawable.get_size canvas#misc#window + and (xc0, yc0) = canvas#get_scroll_offsets in + let view = (xc0, yc0, width_c, height_c) in + (** View has changed ? *) + if view <> !last_view then begin + last_view := view; + Hashtbl.iter (fun cb _ -> cb ()) view_cbs + end; + try + match GdkEvent.get_type ev with + | `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin + let scroll_event = GdkEvent.Scroll.cast ev in + match GdkEvent.Scroll.direction scroll_event with + `UP -> self#zoom_up (); true + | `DOWN -> self#zoom_down (); true + | _ -> false + end + | _ -> false + with + Invalid_argument "ml_lookup_from_c" -> (* Raised GdkEvent.get_type *) + false + + + + method segment = fun ?(group = canvas#root) ?(width=1) ?fill_color geo1 geo2 -> + let (x1, y1) = self#world_of geo1 + and (x2, y2) = self#world_of geo2 in + let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points:[|x1;y1;x2;y2|] group in + l#show (); + l + + method arc = fun ?(nb_points=5) ?(width=1) ?fill_color (xw,yw) r a1 a2 -> + let c = {G2D.x2D = xw; y2D = yw } in + let pts = G2D.arc ~nb_points c r a1 a2 in + let points = Array.init (2*nb_points) + (fun j -> + let i = j / 2 in + if j = i * 2 then pts.(i).G2D.x2D else pts.(i).G2D.y2D) in + let _p = points in + let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points canvas#root in + l#show (); + l + + + method circle = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") geo radius -> + let (x, y) = self#world_of geo in + + (** Compute the actual radius in a UTM projection *) + let utm = LL.utm_of LL.WGS84 geo in + let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in + let (xe, _) = self#world_of geo_east in + let rad = xe -. x in + let l = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in + l#show (); + l + + method photoprojection = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") ?(number="1") geo radius -> + let (x, y) = self#world_of geo in + + (** Compute the actual radius in a UTM projection *) + let utm = LL.utm_of LL.WGS84 geo in + let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in + let (xe, _) = self#world_of geo_east in + let rad = xe -. x in + let l1 = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in + let l2 = GnoCanvas.text ~x:(x) ~y:(y) ~text:number ~props:[`FILL_COLOR color; `X_OFFSET 0.0; `Y_OFFSET 0.0] group in + l1#show (); + l2#show (); + l2 + + method text = fun ?(group = canvas#root) ?(fill_color = "blue") ?(x_offset = 0.0) ?(y_offset = 0.0) geo text -> + let (x1, y1) = self#world_of geo in + let t = GnoCanvas.text ~x:x1 ~y:y1 ~text:text ~props:[`FILL_COLOR fill_color; `X_OFFSET x_offset; `Y_OFFSET y_offset] group in + t#show (); + t + + initializer + let replace_still = fun _ -> + let (x, y) = canvas#get_scroll_offsets in + let (xc, yc) = canvas#window_to_world (float x) (float y) in + let z = 1./.self#current_zoom in + still#affine_absolute [|z;0.;0.;z;xc;yc|] + in + self#connect_view replace_still; + let move_timer = ref (Glib.Timeout.add 0 (fun _ -> false)) in + let move dx dy = function + `BUTTON_PRESS _ -> + let scroll = fun _ -> let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to (x+last_mouse_x) (y+last_mouse_y); - - adj#set_value z; - - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to (x-last_mouse_x) (y-last_mouse_y) - - method zoom_up () = - self#zoom_in_place (adj#value*.zoom_factor); - method zoom_down () = - self#zoom_in_place (adj#value/.zoom_factor); - - method any_event = - let rec last_view = ref (0,0,0,0) in - fun ev -> - let width_c, height_c = Gdk.Drawable.get_size canvas#misc#window - and (xc0, yc0) = canvas#get_scroll_offsets in - let view = (xc0, yc0, width_c, height_c) in - (** View has changed ? *) - if view <> !last_view then begin - last_view := view; - Hashtbl.iter (fun cb _ -> cb ()) view_cbs - end; - try - match GdkEvent.get_type ev with - | `SCROLL when not (Gdk.Convert.test_modifier `SHIFT (GdkEvent.Scroll.state (GdkEvent.Scroll.cast ev))) -> begin - let scroll_event = GdkEvent.Scroll.cast ev in - match GdkEvent.Scroll.direction scroll_event with - `UP -> self#zoom_up (); true - | `DOWN -> self#zoom_down (); true - | _ -> false - end - | _ -> false - with - Invalid_argument "ml_lookup_from_c" -> (* Raised GdkEvent.get_type *) - false - - - - method segment = fun ?(group = canvas#root) ?(width=1) ?fill_color geo1 geo2 -> - let (x1, y1) = self#world_of geo1 - and (x2, y2) = self#world_of geo2 in - let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points:[|x1;y1;x2;y2|] group in - l#show (); - l - - method arc = fun ?(nb_points=5) ?(width=1) ?fill_color (xw,yw) r a1 a2 -> - let c = {G2D.x2D = xw; y2D = yw } in - let pts = G2D.arc ~nb_points c r a1 a2 in - let points = Array.init (2*nb_points) - (fun j -> - let i = j / 2 in - if j = i * 2 then pts.(i).G2D.x2D else pts.(i).G2D.y2D) in - let _p = points in - let l = GnoCanvas.line ?fill_color ~props:[`WIDTH_PIXELS width] ~points canvas#root in - l#show (); - l - - - method circle = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") geo radius -> - let (x, y) = self#world_of geo in - - (** Compute the actual radius in a UTM projection *) - let utm = LL.utm_of LL.WGS84 geo in - let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in - let (xe, _) = self#world_of geo_east in - let rad = xe -. x in - let l = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in - l#show (); - l - - method photoprojection = fun ?(group = canvas#root) ?(width=1) ?fill_color ?(color="black") ?(number="1") geo radius -> - let (x, y) = self#world_of geo in - - (** Compute the actual radius in a UTM projection *) - let utm = LL.utm_of LL.WGS84 geo in - let geo_east = LL.of_utm LL.WGS84 (LL.utm_add utm (radius, 0.)) in - let (xe, _) = self#world_of geo_east in - let rad = xe -. x in - let l1 = GnoCanvas.ellipse ?fill_color ~props:[`WIDTH_PIXELS width; `OUTLINE_COLOR color] ~x1:(x-.rad) ~y1:(y -.rad) ~x2:(x +.rad) ~y2:(y+.rad) group in - let l2 = GnoCanvas.text ~x:(x) ~y:(y) ~text:number ~props:[`FILL_COLOR color; `X_OFFSET 0.0; `Y_OFFSET 0.0] group in - l1#show (); - l2#show (); - l2 - - method text = fun ?(group = canvas#root) ?(fill_color = "blue") ?(x_offset = 0.0) ?(y_offset = 0.0) geo text -> - let (x1, y1) = self#world_of geo in - let t = GnoCanvas.text ~x:x1 ~y:y1 ~text:text ~props:[`FILL_COLOR fill_color; `X_OFFSET x_offset; `Y_OFFSET y_offset] group in - t#show (); - t - - initializer - let replace_still = fun _ -> - let (x, y) = canvas#get_scroll_offsets in - let (xc, yc) = canvas#window_to_world (float x) (float y) in - let z = 1./.self#current_zoom in - still#affine_absolute [|z;0.;0.;z;xc;yc|] - in - self#connect_view replace_still; - let move_timer = ref (Glib.Timeout.add 0 (fun _ -> false)) in - let move dx dy = function - `BUTTON_PRESS _ -> - let scroll = fun _ -> - let (x, y) = canvas#get_scroll_offsets in - canvas#scroll_to (x+dx) (y+dy) ; true in - move_timer := Glib.Timeout.add 50 scroll; - true - | `BUTTON_RELEASE _ -> - Glib.Timeout.remove !move_timer; - true - | _ -> false in - let up = move 0 (-pan_step) - and down = move 0 pan_step + canvas#scroll_to (x+dx) (y+dy) ; true in + move_timer := Glib.Timeout.add 50 scroll; + true + | `BUTTON_RELEASE _ -> + Glib.Timeout.remove !move_timer; + true + | _ -> false in + let up = move 0 (-pan_step) + and down = move 0 pan_step and left = move (-pan_step) 0 and right = move pan_step 0 in ignore (north_arrow#connect#event up); @@ -702,36 +702,36 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () -> method switch_utm_grid = fun flag -> match georef with - None -> () - | Some georef -> - match utm_grid_group with - None -> - if flag then (** Create and show *) - let g = GnoCanvas.group self#canvas#root in - let u0 = LL.utm_of LL.WGS84 (self#get_center ()) in - let u0 = { LL.utm_x = align u0.LL.utm_x 1000; - LL.utm_zone = u0.LL.utm_zone; - LL.utm_y = align u0.LL.utm_y 1000 } in - for i = -size_utm_grid to size_utm_grid do - let h = Array.create (2*(2*size_utm_grid+1)) 0. - and v = Array.create (2*(2*size_utm_grid+1)) 0. in - for j = -size_utm_grid to size_utm_grid do - let k = 2*(j+size_utm_grid) in - let p = fun i j -> - let u = LL.utm_add u0 (float (i*1000), float (j*1000)) in - let wgs84 = LL.of_utm LL.WGS84 u in - self#world_of wgs84 in - let (xw,yw) = p i j in - h.(k) <- xw; h.(k+1) <- yw; - let (xw,yw) = p j i in - v.(k) <- xw; v.(k+1) <- yw - done; - let h = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:h g - and v = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:v g in - h#show (); v#show () - done; - utm_grid_group <- Some g - | Some g -> if flag then g#show () else g#hide () + None -> () + | Some georef -> + match utm_grid_group with + None -> + if flag then (** Create and show *) + let g = GnoCanvas.group self#canvas#root in + let u0 = LL.utm_of LL.WGS84 (self#get_center ()) in + let u0 = { LL.utm_x = align u0.LL.utm_x 1000; + LL.utm_zone = u0.LL.utm_zone; + LL.utm_y = align u0.LL.utm_y 1000 } in + for i = -size_utm_grid to size_utm_grid do + let h = Array.create (2*(2*size_utm_grid+1)) 0. + and v = Array.create (2*(2*size_utm_grid+1)) 0. in + for j = -size_utm_grid to size_utm_grid do + let k = 2*(j+size_utm_grid) in + let p = fun i j -> + let u = LL.utm_add u0 (float (i*1000), float (j*1000)) in + let wgs84 = LL.of_utm LL.WGS84 u in + self#world_of wgs84 in + let (xw,yw) = p i j in + h.(k) <- xw; h.(k+1) <- yw; + let (xw,yw) = p j i in + v.(k) <- xw; v.(k+1) <- yw + done; + let h = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:h g + and v = GnoCanvas.line ~fill_color:grid_color ~props:[`WIDTH_PIXELS 1] ~points:v g in + h#show (); v#show () + done; + utm_grid_group <- Some g + | Some g -> if flag then g#show () else g#hide () (** ground altitude extraction from srtm data *) method altitude = fun wgs84 -> @@ -775,17 +775,17 @@ class widget = fun ?(height=800) ?(srtm=false) ?width ?projection ?georef () -> method display_alt = fun wgs84 -> if srtm#active then - lbl_alt#set_text (sprintf " SRTM:%dm"(self#altitude wgs84)) + lbl_alt#set_text (sprintf " SRTM:%dm"(self#altitude wgs84)) method display_group = fun s -> lbl_group#set_text s method goto = fun () -> match GToolbox.input_string ~title:"Geo ref" ~text:"WGS84 " "Geo ref" with - Some s -> - let wgs84 = Latlong.of_string s in - if georef = None then - self#set_georef wgs84; - self#moveto wgs84 + Some s -> + let wgs84 = Latlong.of_string s in + if georef = None then + self#set_georef wgs84; + self#moveto wgs84 | None -> () end diff --git a/sw/lib/ocaml/mapFP.ml b/sw/lib/ocaml/mapFP.ml index b25367990f..56f19cd929 100644 --- a/sw/lib/ocaml/mapFP.ml +++ b/sw/lib/ocaml/mapFP.ml @@ -31,9 +31,9 @@ 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 +[] -> raise Not_found | (a, v)::avs -> - if String.uppercase at = String.uppercase a then v else assoc_nocase at avs + if String.uppercase at = String.uppercase 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 *) @@ -43,29 +43,29 @@ let geo_of_xml = fun utm_ref get_attrib -> 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") + 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.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 + try + let float_attrib = fun a -> float_of_string (assoc_nocase a attribs) in - let wgs84 = geo_of_xml utm_ref float_attrib in + let wgs84 = geo_of_xml utm_ref float_attrib in - wp#set wgs84; - wp#set_name (assoc_nocase "name" attribs) - with - _ -> () + 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 @@ -79,22 +79,22 @@ let try_replace_attrib = fun node tag prev_v v -> if XmlEdit.attrib node tag = prev_v then XmlEdit.set_attrib node (tag, v) with - Not_found -> () + Not_found -> () (** Update all the references to waypoint names (attribute "wp") *) let update_wp_refs previous_name xml_tree = function - XmlEdit.Deleted -> () (** FIXME *) +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 -> () + 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 @@ -106,7 +106,7 @@ let is_relative_waypoint = fun node -> ignore (XmlEdit.attrib node "y"); true with - Not_found -> false + Not_found -> false let absolute_coords = fun wp -> @@ -125,16 +125,16 @@ let update_xml = fun xml_tree utm0 wp id -> 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 + 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 + absolute_coords wp in let alt_attrib = if abs_float (wp#alt -. default_alt) < 1. then [] else ["alt", sof1 wp#alt] in @@ -184,11 +184,11 @@ 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) + [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 ! *) @@ -197,21 +197,21 @@ let display_kml = fun ?group color geomap xml -> let document = ExtXml.child xml "Document" in let rec loop = fun child -> match String.lowercase (Xml.tag child) with - "placemark" -> - let linestring = ExtXml.child child "LineString" in - let coordinates = ExtXml.child linestring "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 - display_lines ?group color geomap (Array.of_list points) - | _ -> failwith "coordinates expected" - end + "placemark" -> + let linestring = ExtXml.child child "LineString" in + let coordinates = ExtXml.child linestring "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 + display_lines ?group color geomap (Array.of_list points) + | _ -> failwith "coordinates expected" + end - | "folder" -> - List.iter loop (Xml.children child) - | _ -> () in + | "folder" -> + List.iter loop (Xml.children child) + | _ -> () in List.iter loop (Xml.children document) with Xml.Not_element xml -> failwith (Xml.to_string xml) @@ -257,44 +257,44 @@ class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dt let waypoints = ExtXml.child xml "waypoints" in try List.iter (fun x -> - match String.lowercase (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)) - | "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 - display_lines ~group:wpts_group#group color_sector geomap points - | _ -> failwith "Unknown sectors child") - (Xml.children (ExtXml.child xml "sectors")) + match String.lowercase (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)) + | "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 + display_lines ~group:wpts_group#group color_sector geomap points + | _ -> 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 + (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 _ = @@ -302,70 +302,70 @@ class flight_plan = fun ?format_attribs ?editable ~show_moved geomap color fp_dt 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 +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 "green" - 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 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 "green" + 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 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 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 connect_activated = fun cb -> XmlEdit.connect_activated xml_tree_view cb - 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 + 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 diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 5c74903f6f..4d9b7953c0 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -38,10 +38,10 @@ let gm_tiles = Node (Array.create 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 +'q' -> 0 | 'r' -> 1 | 's' -> 2 | 't' -> 3 | _ -> invalid_arg "index_of" let char_of = function - 0 -> 'q' | 1 -> 'r' | 2 -> 's' | 3 -> 't' +0 -> 'q' | 1 -> 'r' | 2 -> 's' | 3 -> 't' | _ -> invalid_arg "char_of" (** Checking that a tile is already displayed *) @@ -50,9 +50,9 @@ let mem_tile = fun tile_key -> 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 + 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 *) @@ -60,13 +60,13 @@ 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.create 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]) + Empty -> + let sons = Array.create 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 @@ -88,11 +88,11 @@ let display_the_tile = fun (geomap:MapCanvas.widget) tile jpg_file level -> 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 - | _ -> () + GdkPixbuf.GdkPixbufError(_, msg) -> + match GToolbox.question_box ~title:"Corrupted file" ~buttons:["Erase"; "Cancel"] (sprintf "%s. Erase ?" msg) with + 1 -> + Sys.remove jpg_file + | _ -> () @@ -131,8 +131,8 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> let tsize2 = tsize /. 2. in try match trees.(i) with - Tile -> () - | Empty -> + Tile -> () + | Empty -> if zoom = 1 then let tile, image = Gm.get_image key in let level = String.length tile.Gm.key in @@ -142,7 +142,7 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> trees.(i) <- Node (Array.create 4 Empty); loop twest tsouth tsize trees i zoom key end - | Node sons -> + | Node sons -> let continue = fun j tw ts -> loop tw ts tsize2 sons j (zoom-1) (key^String.make 1 (char_of j)) in @@ -156,9 +156,9 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> trees.(i) <- Tile end with - New_displayed z when z = zoom -> - trees.(i) <- Tile - | Gm.Not_available -> () in + New_displayed z when z = zoom -> + trees.(i) <- Tile + | Gm.Not_available -> () in loop (-1.) (-1.) 2. [|gm_tiles|] 0 zoomlevel "t" @@ -186,30 +186,30 @@ let pixbuf = fun sw ne zoomlevel-> 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 + 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 + 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 + 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 diff --git a/sw/lib/ocaml/mapTrack.ml b/sw/lib/ocaml/mapTrack.ml index 417e0e8acc..41891434d4 100644 --- a/sw/lib/ocaml/mapTrack.ml +++ b/sw/lib/ocaml/mapTrack.ml @@ -70,19 +70,19 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva let cam = GnoCanvas.group group in -(** rectangle representing the field covered by the cam *) + (** 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 *) + (** 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 - (** data at map scale *) + (** data at map scale *) let max_cam_half_height_scaled = 10000.0 in let max_oblic_distance_scaled = 10000.0 in let min_distance_scaled = 10. in @@ -93,235 +93,235 @@ class track = fun ?(name="Noname") ?(size = 500) ?(color="red") (geomap:MapCanva let _ = aircraft#raise_to_top () in - object (self) - val mutable top = 0 - val mutable color = color - val mutable segments = Array.create size empty - val mutable v_segments = Array.create size empty - val mutable v_top = 0 - val mutable v_path = Array.create 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.rect ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam - method color = color - method set_color c = color <- c - method track = track - method v_path = v_path - method aircraft = aircraft - method set_label = fun s -> ac_label#set [`TEXT 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 +object (self) + val mutable top = 0 + val mutable color = color + val mutable segments = Array.create size empty + val mutable v_segments = Array.create size empty + val mutable v_top = 0 + val mutable v_path = Array.create 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.rect ~fill_color:"grey" ~props:[`WIDTH_PIXELS 1 ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001")] cam + method color = color + method set_color c = color <- c + method track = track + method v_path = v_path + method aircraft = aircraft + method set_label = fun s -> ac_label#set [`TEXT 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 [`TEXT name; `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 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 [`TEXT name; `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 + 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 + 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 + 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 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; + 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 [`TEXT (sprintf "%s\n%+.0f m\n%.1f m/s" name last_height last_speed); `Y 70. ] - end; + if params_on then begin + let last_height = self#height () in + ac_label#set [`TEXT (sprintf "%s\n%+.0f m\n%.1f m/s" name last_height last_speed); `Y 70. ] + end; - ac_label#affine_absolute (affine_pos_and_angle geomap#zoom_adj#value xw yw 0.); - self#add_point wgs84 altitude; + 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.); + 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:"green" en radius) in - match desired_track with - DesiredCircle (c, r, circle) -> - if c <> en || r <> radius then begin - circle#destroy (); - create () - end + (** 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:"green" 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 () + s#destroy (); + create () | NoDesired -> - create () + 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:"green" en1 en2) in - match desired_track with - DesiredCircle (c, r, circle) -> - circle#destroy (); - 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:"green" 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 + if p1 <> en1 || p2 <> en2 then begin + s#destroy (); + create () + end | NoDesired -> - create () + 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 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] + 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 cam_wgs84 mission_target_wgs84 -> - match last, cam_on with - Some last_ac, true -> - let (cam_xw, cam_yw) = geomap#world_of cam_wgs84 - and (last_xw, last_yw) = geomap#world_of last_ac - and last_height_scaled = self#height () in + (** moves the rectangle representing the field covered by the camera *) + method move_cam = fun cam_wgs84 mission_target_wgs84 -> + match last, cam_on with + Some last_ac, true -> + let (cam_xw, cam_yw) = geomap#world_of cam_wgs84 + and (last_xw, last_yw) = geomap#world_of last_ac + and last_height_scaled = self#height () in - let pt1 = { G2d.x2D = last_xw; y2D = last_yw} in - let pt2 = { G2d.x2D = cam_xw ; y2D = cam_yw } in + let pt1 = { G2d.x2D = last_xw; y2D = last_yw} in + let pt2 = { G2d.x2D = cam_xw ; y2D = cam_yw } in -(** y axis is downwards so North vector is as follows: *) - let vect_north = { G2d.x2D = 0.0 ; y2D = -1.0 } in - let d = G2d.distance pt1 pt2 in - let cam_heading = - if d > min_distance_scaled then - let cam_vect_normalized = (G2d.vect_normalize (G2d.vect_make pt1 pt2)) in - if (G2d.dot_product vect_north cam_vect_normalized) > 0.0 then - norm_angle_360 ( G2d.rad2deg (asin (G2d.cross_product vect_north cam_vect_normalized))) - else norm_angle_360 ( G2d.rad2deg (G2d.m_pi -. asin (G2d.cross_product vect_north cam_vect_normalized))) - else last_heading in - let (angle_of_view, oblic_distance) = - if last_height_scaled < min_height_scaled then - (half_pi, max_oblic_distance_scaled) - else - let oav = atan ( d /. last_height_scaled) in - (oav, last_height_scaled /. (cos oav)) - in - let alpha_1 = angle_of_view +. cam_half_aperture in - let cam_field_half_height_1 = - if alpha_1 < half_pi then - (tan alpha_1) *. last_height_scaled -. d - else max_cam_half_height_scaled in - let cam_field_half_height_2 = d -. (tan ( angle_of_view -. cam_half_aperture)) *. last_height_scaled in - let cam_field_half_width = ( tan (cam_half_aperture) ) *. oblic_distance in - ac_cam_cover#set [`X1 (-. cam_field_half_width); - `Y1 (-. cam_field_half_height_1); - `X2 (cam_field_half_width); - `Y2(cam_field_half_height_2); - `OUTLINE_COLOR color]; - cam#affine_absolute (affine_pos_and_angle 1.0 cam_xw cam_yw cam_heading); - 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) + (** y axis is downwards so North vector is as follows: *) + let vect_north = { G2d.x2D = 0.0 ; y2D = -1.0 } in + let d = G2d.distance pt1 pt2 in + let cam_heading = + if d > min_distance_scaled then + let cam_vect_normalized = (G2d.vect_normalize (G2d.vect_make pt1 pt2)) in + if (G2d.dot_product vect_north cam_vect_normalized) > 0.0 then + norm_angle_360 ( G2d.rad2deg (asin (G2d.cross_product vect_north cam_vect_normalized))) + else norm_angle_360 ( G2d.rad2deg (G2d.m_pi -. asin (G2d.cross_product vect_north cam_vect_normalized))) + else last_heading in + let (angle_of_view, oblic_distance) = + if last_height_scaled < min_height_scaled then + (half_pi, max_oblic_distance_scaled) + else + let oav = atan ( d /. last_height_scaled) in + (oav, last_height_scaled /. (cos oav)) + in + let alpha_1 = angle_of_view +. cam_half_aperture in + let cam_field_half_height_1 = + if alpha_1 < half_pi then + (tan alpha_1) *. last_height_scaled -. d + else max_cam_half_height_scaled in + let cam_field_half_height_2 = d -. (tan ( angle_of_view -. cam_half_aperture)) *. last_height_scaled in + let cam_field_half_width = ( tan (cam_half_aperture) ) *. oblic_distance in + ac_cam_cover#set [`X1 (-. cam_field_half_width); + `Y1 (-. cam_field_half_height_1); + `X2 (cam_field_half_width); + `Y2(cam_field_half_height_2); + `OUTLINE_COLOR color]; + cam#affine_absolute (affine_pos_and_angle 1.0 cam_xw cam_yw cam_heading); + 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 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.create 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 resize = fun new_size -> + let a = Array.create 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 size = Array.length segments - initializer - ignore(geomap#zoom_adj#connect#value_changed - (fun () -> self#zoom geomap#zoom_adj#value)) + initializer + ignore(geomap#zoom_adj#connect#value_changed + (fun () -> self#zoom geomap#zoom_adj#value)) end diff --git a/sw/lib/ocaml/mapWaypoints.ml b/sw/lib/ocaml/mapWaypoints.ml index 4275171e4f..2a84278e59 100644 --- a/sw/lib/ocaml/mapWaypoints.ml +++ b/sw/lib/ocaml/mapWaypoints.ml @@ -30,13 +30,13 @@ let s = 6. 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 +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 @@ -57,237 +57,237 @@ class waypoint = fun ?(show = true) (wpts_group:group) (name :string) ?(alt=0.) 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)) + 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. +object (self) + val mutable x0 = 0. + val mutable y0 = 0. - val label = GnoCanvas.text wpt_group ~props:[`TEXT name; `X s; `Y 0.; `ANCHOR `SW; `FILL_COLOR "green"] - val mutable name = name (* FIXME: already in label ! *) - val mutable alt = alt - 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 [`TEXT name] - end - 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 + val label = GnoCanvas.text wpt_group ~props:[`TEXT name; `X s; `Y 0.; `ANCHOR `SW; `FILL_COLOR "green"] + val mutable name = name (* FIXME: already in label ! *) + val mutable alt = alt + 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 [`TEXT name] + end + 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 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 + 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 + 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 (); + display_coordinates (); - let initial_wgs84 = self#pos in + 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 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; + 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; - let agl = alt -. float (try Srtm.of_wgs84 wgs84 with _ -> 0) 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.))); + let agl = alt -. float (try Srtm.of_wgs84 wgs84 with _ -> 0) 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.))); - let callback = fun _ -> - self#set_name ename#text; - alt <- ea#value; - label#set [`TEXT 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 callback = fun _ -> + self#set_name ename#text; + alt <- ea#value; + label#set [`TEXT 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); + 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 (); - updated () - in - ignore(delete#connect#clicked ~callback:delete_callback) - end; + if editable then begin + let delete = GButton.button ~stock:`DELETE ~packing: dhbx#add () in + let delete_callback = fun () -> + dialog#destroy (); + self#delete (); + 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 (); + 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 ())); + 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 -. float (try Srtm.of_wgs84 wgs84 with _ -> 0) 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 () + let callback = fun _ -> + try + set_coordinates (); + let wgs84 = self#pos in + let agl = ea#value -. float (try Srtm.of_wgs84 wgs84 with _ -> 0) 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 -> () + 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 + 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 + 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 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 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, true -> - self#move dx dy; - alt <- alt+.dz; - if update then updated () + let new_pos = ecef_distance current_ecef new_ecef > 2. in + match moved, new_pos with + None, true -> + self#move dx dy; + alt <- alt+.dz; + if update then updated () | (None, false) | (Some _, true) -> () | Some _, false -> self#reset_moved () - method delete () = - deleted <- true; (* BOF *) - 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 + method delete () = + deleted <- true; (* BOF *) + 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 diff --git a/sw/lib/ocaml/ocaml_tools.ml b/sw/lib/ocaml/ocaml_tools.ml index 81c77241f9..6d801905c2 100644 --- a/sw/lib/ocaml/ocaml_tools.ml +++ b/sw/lib/ocaml/ocaml_tools.ml @@ -26,7 +26,7 @@ let pi = 3.14159265358979323846;; let open_compress file = if Filename.check_suffix file "gz" or Filename.check_suffix file "Z" or - Filename.check_suffix file "zip" or Filename.check_suffix file "ZIP" then + Filename.check_suffix file "zip" or Filename.check_suffix file "ZIP" then Unix.open_process_in ("gunzip -c "^file) else if Filename.check_suffix file "bz2" then Unix.open_process_in ("bunzip2 -c "^file) @@ -36,14 +36,14 @@ let open_compress file = let extensions = ["";".gz";".Z";".bz2";".zip";".ZIP"] let find_file = fun path file -> let rec loop_path = function - [] -> raise Not_found + [] -> raise Not_found | p::ps -> - let rec loop_ext = function - [] -> loop_path ps - | ext::es -> - let f = Filename.concat p file ^ ext in - if Sys.file_exists f then f else loop_ext es in - loop_ext extensions in + let rec loop_ext = function + [] -> loop_path ps + | ext::es -> + let f = Filename.concat p file ^ ext in + if Sys.file_exists f then f else loop_ext es in + loop_ext extensions in loop_path path let regexp_plus_less = Str.regexp "[+-]" @@ -51,28 +51,28 @@ let affine_transform = fun format -> (* Split after removing blank spaces *) let split = Str.full_split regexp_plus_less (Str.global_replace (Str.regexp "[ \t]+") "" format) in let first_sign = match List.hd split with - Str.Text _ | Str.Delim "+" -> 1. - | Str.Delim "-" -> -. 1. - | _ -> 0. + Str.Text _ | Str.Delim "+" -> 1. + | Str.Delim "-" -> -. 1. + | _ -> 0. in let second_sign = match split with - [_; Str.Delim "+"; _] | [_; _; Str.Delim "+"; _] -> 1. - | [_; Str.Delim "-"; _] - | [_; Str.Delim "+"; Str.Delim "-"; _] - | [_; _; Str.Delim "-"; _] - | [_; _; Str.Delim "+"; Str.Delim "-"; _] -> -1. - | _ -> 0. + [_; Str.Delim "+"; _] | [_; _; Str.Delim "+"; _] -> 1. + | [_; Str.Delim "-"; _] + | [_; Str.Delim "+"; Str.Delim "-"; _] + | [_; _; Str.Delim "-"; _] + | [_; _; Str.Delim "+"; Str.Delim "-"; _] -> -1. + | _ -> 0. in match split with - [Str.Text a; _; Str.Text b] - | [_; Str.Text a; _; Str.Text b] - | [Str.Text a; _; _; Str.Text b] - | [_; Str.Text a; _; _; Str.Text b] -> first_sign *. float_of_string a, second_sign *. float_of_string b - | [Str.Text a] | [_; Str.Text a] -> first_sign *. float_of_string a, 0. - | _ -> 1., 0. + [Str.Text a; _; Str.Text b] + | [_; Str.Text a; _; Str.Text b] + | [Str.Text a; _; _; Str.Text b] + | [_; Str.Text a; _; _; Str.Text b] -> first_sign *. float_of_string a, second_sign *. float_of_string b + | [Str.Text a] | [_; Str.Text a] -> first_sign *. float_of_string a, 0. + | _ -> 1., 0. (* Box-Muller transform to generate a normal distribution from a uniform one - http://en.wikipedia.org/wiki/Normal_distribution *) + http://en.wikipedia.org/wiki/Normal_distribution *) let normal = fun mu sigma -> let u1 = Random.float 1. and u2 = Random.float 1. in diff --git a/sw/lib/ocaml/os_calls.ml b/sw/lib/ocaml/os_calls.ml index be4e8b6fee..22ccb1745f 100644 --- a/sw/lib/ocaml/os_calls.ml +++ b/sw/lib/ocaml/os_calls.ml @@ -42,7 +42,7 @@ let contains s substring = with Not_found -> false let os_name = String.copy ( - if contains !current_os "not_set" then ( - current_os := read_process_output "uname" ); - !current_os - ) + if contains !current_os "not_set" then ( + current_os := read_process_output "uname" ); + !current_os +) diff --git a/sw/lib/ocaml/papget.ml b/sw/lib/ocaml/papget.ml index cd86522063..b785a48306 100644 --- a/sw/lib/ocaml/papget.ml +++ b/sw/lib/ocaml/papget.ml @@ -34,12 +34,12 @@ class type item = object end class type value = - object - method last_value : string - method connect : (string -> unit) -> unit - method config : unit -> Xml.xml list - method type_ : string - end +object + method last_value : string + method connect : (string -> unit) -> unit + method config : unit -> Xml.xml list + method type_ : string +end @@ -49,52 +49,52 @@ let base_and_index = 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)) + 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." +object + val mutable callbacks = [] + val mutable last_value = "0." - method last_value = last_value + 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 - [ PC.property "field" field ] - method type_ = "message_field" + method connect = fun cb -> callbacks <- cb :: callbacks + method config = fun () -> + let field = sprintf "%s:%s" msg_name field_descr in + [ PC.property "field" field ] + method type_ = "message_field" - initializer - let module P = Pprz.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 Pprz.assoc field_name values with - Pprz.Array array -> array.(index) - | scalar -> scalar in + initializer + let module P = Pprz.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 Pprz.assoc field_name values with + Pprz.Array array -> array.(index) + | scalar -> scalar in - last_value <- Pprz.string_of_value value; + last_value <- Pprz.string_of_value value; - List.iter (fun cb -> cb last_value) callbacks in - ignore (P.message_bind ?sender msg_name process_message) - end + List.iter (fun cb -> cb last_value) callbacks in + ignore (P.message_bind ?sender msg_name process_message) +end let hash_vars = fun expr -> let htable = Hashtbl.create 3 in let rec loop = function - E.Ident i -> prerr_endline i + 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 i f in - Hashtbl.add htable (i, f) msg_obj in + if not (Hashtbl.mem htable (i,f)) then + let msg_obj = new message_field i f in + Hashtbl.add htable (i, f) msg_obj in loop expr; htable @@ -102,7 +102,7 @@ let hash_vars = fun expr -> 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 ( /. ) @@ -110,297 +110,297 @@ let eval_bin_op = function 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.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) + 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) + (List.assoc ident extra_functions) (List.map loop args) | E.Call (ident, _l) | E.CallOperator (ident, _l) -> - failwith (sprintf "Papget.eval_expr '%s(...)'" ident) + 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) + 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=[]) expr -> let h = hash_vars expr in - object - val mutable callbacks = [] - val mutable last_value = "0." +object + val mutable callbacks = [] + val mutable last_value = "0." - method last_value = last_value + method last_value = last_value - method connect = fun cb -> callbacks <- cb :: callbacks + method connect = fun cb -> callbacks <- cb :: callbacks - method config = fun () -> - [ PC.property "expr" (Expr_syntax.sprint expr)] + method config = fun () -> + [ PC.property "expr" (Expr_syntax.sprint expr)] - method type_ = "expression" + 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 + 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 +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 +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 renderer = renderer - method xy = - let (x0, y0) = renderer#item#i2w 0. 0. in - renderer#item#parent#w2i x0 y0 + method xy = + let (x0, y0) = renderer#item#i2w 0. 0. in + renderer#item#parent#w2i x0 y0 - method deleted = deleted + method deleted = deleted - method update = fun value -> - try - (renderer#update:string->unit) value - with - exc -> prerr_endline (Printexc.to_string exc) + 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 + 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 + 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); - if not motion then begin - self#edit () - end; - motion <- false - end; - true + if GdkEvent.Button.button ev = 1 then begin + item#ungrab (GdkEvent.Button.time ev); + if not motion then begin + self#edit () + 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 + 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 tagged_renderers = Lazy.force PR.lazy_tagged_renderers in - let strings = List.map fst tagged_renderers in + let tagged_renderers = Lazy.force PR.lazy_tagged_renderers in + let strings = List.map fst tagged_renderers in - let (combo, (tree, column)) = GEdit.combo_box_text ~packing:dialog#box_item_chooser#add ~strings () in - 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 (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 + 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_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 ())); + 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 ())); + 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 + 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 + 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 + initializer + self#connect () +end class canvas_float_item = fun ~config canvas_renderer -> - object - inherit canvas_item ~config canvas_renderer as super +object + inherit canvas_item ~config canvas_renderer as super - val mutable affine = "1" + 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 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 -> () + 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 + (* 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 +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 + 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 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 item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, scale_prop::val_props@renderer_props) - 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 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 () +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 item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, properties@props) - end + method config = fun () -> + let props = renderer#config () in + let (x, y) = item#xy in + let attrs = + [ "type", type_; + "display", String.lowercase 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 +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 +object + inherit canvas_clickable_item "variable_setting" properties callback canvas_renderer +end (****************************************************************************) class canvas_video_plugin_item = fun properties (canvas_renderer:PR.t) -> - object - inherit canvas_item ~config:properties canvas_renderer as item - method config = fun () -> - let props = renderer#config () in - let (x, y) = item#xy in - let attrs = - [ "type", "video_plugin"; - "display", String.lowercase item#renderer#tag; - "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in - Xml.Element ("papget", attrs, properties@props) - end +object + inherit canvas_item ~config:properties canvas_renderer as item + method config = fun () -> + let props = renderer#config () in + let (x, y) = item#xy in + let attrs = + [ "type", "video_plugin"; + "display", String.lowercase item#renderer#tag; + "x", sprintf "%.0f" x; "y", sprintf "%.0f" y ] in + Xml.Element ("papget", attrs, properties@props) +end diff --git a/sw/lib/ocaml/papget_common.ml b/sw/lib/ocaml/papget_common.ml index 303f3b675a..720afd32a7 100644 --- a/sw/lib/ocaml/papget_common.ml +++ b/sw/lib/ocaml/papget_common.ml @@ -36,7 +36,7 @@ let property = fun name value -> let xml = fun type_ display_ properties -> Xml.Element ("papget", ["type", type_; "display", display_], - List.map (fun (x, y) -> property x y) properties) + List.map (fun (x, y) -> property x y) properties) let float_property = fun name value -> property name (string_of_float value) diff --git a/sw/lib/ocaml/papget_renderer.ml b/sw/lib/ocaml/papget_renderer.ml index ba5f376121..997e705d63 100644 --- a/sw/lib/ocaml/papget_renderer.ml +++ b/sw/lib/ocaml/papget_renderer.ml @@ -27,63 +27,63 @@ module PC = Papget_common let (//) = Filename.concat class type movable_item = - object - inherit GnoCanvas.base_item - method set : GnomeCanvas.group_p list -> unit - end +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 +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 "green" +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 "green" - 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 (Obj.magic format) (float_of_string x) with _ -> x in - text#set [`SIZE_POINTS size; `TEXT (renderer value); `FILL_COLOR color; `ANCHOR `NW] + 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 (Obj.magic format) (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; + 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; + 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 + 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 ***********************************) @@ -140,20 +140,20 @@ class canvas_ruler = fun ?(config=[]) canvas_group x y -> 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 +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 -> @@ -193,54 +193,54 @@ class canvas_gauge = fun ?(config=[]) canvas_group x y -> let text_mid = GnoCanvas.text ~x:0. ~y:(-.r2-.3.) ~props:[`ANCHOR `SOUTH; `FILL_COLOR "green"] root in let text_text = GnoCanvas.text ~x:0. ~y:(r2+.3.) ~props:[`ANCHOR `NORTH; `FILL_COLOR "green"] 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 "" +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; + 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; + 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); + 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 + 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] + 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 + 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 -> @@ -255,52 +255,52 @@ class canvas_led = fun ?(config=[]) canvas_group x y -> let led_text = GnoCanvas.text ~x:(-.r-.3.) ~y:0. ~props:[`ANCHOR `EAST; `FILL_COLOR "green"] 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") +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; + 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; + 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); + 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 + 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 "green"]; - let r = (Pervasives.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.)] + if inv (value = test_value) then led#set [`FILL_COLOR "red"] + else led#set [`FILL_COLOR "green"]; + let r = (Pervasives.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 + 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 -> @@ -308,16 +308,16 @@ class canvas_button = fun ?(config=[]) canvas_group x y -> 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 +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 (****************************************************************************) @@ -329,21 +329,21 @@ class canvas_mplayer = fun ?(config=[]) canvas_group x y -> 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) -> () - 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 +object + method tag = "Mplayer" + method item = (group :> movable_item) + method edit = fun (pack:GObj.widget -> unit) -> () + method update = fun (value:string) -> () + 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 (****************************************************************************) @@ -355,21 +355,21 @@ class canvas_plugin = fun ?(config=[]) canvas_group x y -> 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) -> () - 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 +object + method tag = "Plugin" + method item = (group :> movable_item) + method edit = fun (pack:GObj.widget -> unit) -> () + method update = fun (value:string) -> () + 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 @@ -380,11 +380,11 @@ let renderers = (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) + (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) diff --git a/sw/lib/ocaml/pprz.ml b/sw/lib/ocaml/pprz.ml index 81da4a89dd..0578816334 100644 --- a/sw/lib/ocaml/pprz.ml +++ b/sw/lib/ocaml/pprz.ml @@ -36,26 +36,26 @@ type value = Int of int | Float of float | String of string | Int32 of int32 | Array of value array type field = { - _type : _type; - fformat : format; - alt_unit_coef : string; - enum : string list - } + _type : _type; + fformat : format; + alt_unit_coef : string; + enum : string list +} type link_mode = Forwarded | Broadcasted type message = { - name : string; (** Lowercase *) - fields : (string * field) list; - link : link_mode option - } + name : string; (** Lowercase *) + fields : (string * field) list; + link : link_mode option +} type type_descr = { - format : string ; - glib_type : string; - inttype : string; - size : int; - value : value - } + format : string ; + glib_type : string; + inttype : string; + size : int; + value : value +} type values = (string * value) list @@ -106,21 +106,21 @@ let type_of_array_type = fun s -> let int_of_string = fun x -> try int_of_string x with - _ -> failwith (sprintf "Pprz.int_of_string: %s" x) + _ -> failwith (sprintf "Pprz.int_of_string: %s" x) let rec value = fun t v -> match t with - Scalar ("uint8" | "uint16" | "int8" | "int16") -> Int (int_of_string v) - | Scalar ("uint32" | "int32") -> Int32 (Int32.of_string v) - | Scalar ("float" | "double") -> Float (float_of_string v) - | Scalar "string" -> String v - | ArrayType t' -> + Scalar ("uint8" | "uint16" | "int8" | "int16") -> Int (int_of_string v) + | Scalar ("uint32" | "int32") -> Int32 (Int32.of_string v) + | Scalar ("float" | "double") -> Float (float_of_string v) + | Scalar "string" -> String v + | ArrayType t' -> Array (Array.map (value (Scalar t')) (Array.of_list (split_array v))) - | Scalar t -> failwith (sprintf "Pprz.value: Unexpected type: %s" t) + | Scalar t -> failwith (sprintf "Pprz.value: Unexpected type: %s" t) let rec string_of_value = function - Int x -> string_of_int x +Int x -> string_of_int x | Float x -> string_of_float x | Int32 x -> Int32.to_string x | String s -> s @@ -132,23 +132,23 @@ let magic = fun x -> (Obj.magic x:('a,'b,'c) Pervasives.format) let formatted_string_of_value = fun format v -> match v with - Float x -> sprintf (magic format) x - | v -> string_of_value v + Float x -> sprintf (magic format) x + | v -> string_of_value v let sizeof = fun f -> match f with - Scalar t -> (List.assoc t types).size - | ArrayType t -> failwith "sizeof: Array" + Scalar t -> (List.assoc t types).size + | ArrayType t -> failwith "sizeof: Array" let size_of_field = fun f -> sizeof f._type let default_format = function - Scalar x | ArrayType x -> - try (List.assoc x types).format with - Not_found -> failwith (sprintf "Unknown format '%s'" x) +Scalar x | ArrayType x -> + try (List.assoc x types).format with + Not_found -> failwith (sprintf "Unknown format '%s'" x) let default_value = fun x -> match x with - Scalar t -> (List.assoc t types).value - | ArrayType t -> failwith "default_value: Array" + Scalar t -> (List.assoc t types).value + | ArrayType t -> failwith "default_value: Array" let payload_size_of_message = fun message -> List.fold_right @@ -169,23 +169,23 @@ let scale_of_units = fun ?auto from_unit to_unit -> (* find the first occurence of matching units or raise Not_found *) let _unit = List.find (fun u -> (* will raise Xml.No_attribute if not a valid attribute *) - let f = Xml.attrib u "from" - and t = Xml.attrib u "to" - and a = try Some (Xml.attrib u "auto") with _ -> None in - let a = match auto, a with - | Some _, None | None, None -> "" (* No auto conversion *) - | Some t, Some _ | None, Some t -> String.lowercase t (* param auto is used before attribute *) - in - if (f = from_unit || a = "display") && (t = to_unit || a = "code") then true else false - ) (Xml.children units_xml) in + let f = Xml.attrib u "from" + and t = Xml.attrib u "to" + and a = try Some (Xml.attrib u "auto") with _ -> None in + let a = match auto, a with + | Some _, None | None, None -> "" (* No auto conversion *) + | Some t, Some _ | None, Some t -> String.lowercase t (* param auto is used before attribute *) + in + if (f = from_unit || a = "display") && (t = to_unit || a = "code") then true else false + ) (Xml.children units_xml) in (* return coef, raise Failure if coef is not a numerical value *) float_of_string (Xml.attrib _unit "coef") with Xml.File_not_found _ -> raise (Unit_conversion_error ("Parse error of conf/units.xml")) | Xml.No_attribute _ | Xml.Not_element _ -> raise (Unit_conversion_error ("File conf/units.xml has errors")) | Failure "float_of_string" -> raise (Unit_conversion_error ("Unit coef is not numerical value")) | Not_found -> - if from_unit = "" || to_unit = "" then raise (No_automatic_conversion (from_unit, to_unit)) - else raise (Unknown_conversion (from_unit, to_unit)) + if from_unit = "" || to_unit = "" then raise (No_automatic_conversion (from_unit, to_unit)) + else raise (Unknown_conversion (from_unit, to_unit)) | _ -> raise (Unknown_conversion (from_unit, to_unit)) @@ -197,10 +197,10 @@ let alt_unit_coef_of_xml = fun ?auto xml -> let coef = try string_of_float (match auto with | None -> scale_of_units u au | Some a -> scale_of_units u au ~auto:a) - with - | Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; "1." (* Use coef 1. *) - | Unknown_conversion _ -> "1." (* Use coef 1. *) - | _ -> "1." + with + | Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; "1." (* Use coef 1. *) + | Unknown_conversion _ -> "1." (* Use coef 1. *) + | _ -> "1." in coef @@ -225,31 +225,31 @@ let assoc = fun a vs -> let float_assoc = fun (a:string) vs -> match assoc a vs with - Float x -> x - | _ -> invalid_arg "Pprz.float_assoc" + Float x -> x + | _ -> invalid_arg "Pprz.float_assoc" let int_of_value = fun value -> match value with - Int x -> x - | Int32 x -> + Int x -> x + | Int32 x -> let i = Int32.to_int x in if Int32.compare x (Int32.of_int i) <> 0 then - failwith "Pprz.int_assoc: Int32 too large to be converted into an int"; + failwith "Pprz.int_assoc: Int32 too large to be converted into an int"; i - | _ -> invalid_arg "Pprz.int_assoc" + | _ -> invalid_arg "Pprz.int_assoc" let int_assoc = fun (a:string) vs -> int_of_value (assoc a vs) let int32_assoc = fun (a:string) vs -> match assoc a vs with - Int32 x -> x - | _ -> invalid_arg "Pprz.int_assoc" + Int32 x -> x + | _ -> invalid_arg "Pprz.int_assoc" let string_assoc = fun (a:string) (vs:values) -> string_of_value (assoc a vs) let link_mode_of_string = function - "forwarded" -> Forwarded +"forwarded" -> Forwarded | "broadcasted" -> Broadcasted | x -> invalid_arg (sprintf "link_mode_of_string: %s" x) @@ -260,19 +260,19 @@ let parse_class = fun xml_class -> (fun xml_msg -> let name = ExtXml.attrib xml_msg "name" and link = - try - Some (link_mode_of_string (Xml.attrib xml_msg "link")) - with - Xml.No_attribute("link") -> None + try + Some (link_mode_of_string (Xml.attrib xml_msg "link")) + with + Xml.No_attribute("link") -> None in let msg = { - name = name; - fields = List.map field_of_xml (Xml.children xml_msg); - link = link + name = name; + fields = List.map field_of_xml (Xml.children xml_msg); + link = link } in let id = int_of_string (ExtXml.attrib xml_msg "id") in if Hashtbl.mem by_id id then - failwith (sprintf "Duplicated id in messages.xml: %d" id); + failwith (sprintf "Duplicated id in messages.xml: %d" id); Hashtbl.add by_id id msg; Hashtbl.add by_name name (id, msg)) (Xml.children xml_class); @@ -282,25 +282,25 @@ let parse_class = fun xml_class -> (** Returns a value and its length *) let rec value_of_bin = fun buffer index _type -> match _type with - Scalar "uint8" -> Int (Char.code buffer.[index]), sizeof _type - | Scalar "int8" -> Int (int8_of_bytes buffer index), sizeof _type - | Scalar "uint16" -> Int (Char.code buffer.[index+1] lsl 8 + Char.code buffer.[index]), sizeof _type - | Scalar "int16" -> Int (int16_of_bytes buffer index), sizeof _type - | Scalar "float" -> Float (float_of_bytes buffer index), sizeof _type - | Scalar "double" -> Float (double_of_bytes buffer index), sizeof _type - | Scalar ("int32" | "uint32") -> Int32 (int32_of_bytes buffer index), sizeof _type - | ArrayType t -> + Scalar "uint8" -> Int (Char.code buffer.[index]), sizeof _type + | Scalar "int8" -> Int (int8_of_bytes buffer index), sizeof _type + | Scalar "uint16" -> Int (Char.code buffer.[index+1] lsl 8 + Char.code buffer.[index]), sizeof _type + | Scalar "int16" -> Int (int16_of_bytes buffer index), sizeof _type + | Scalar "float" -> Float (float_of_bytes buffer index), sizeof _type + | Scalar "double" -> Float (double_of_bytes buffer index), sizeof _type + | Scalar ("int32" | "uint32") -> Int32 (int32_of_bytes buffer index), sizeof _type + | ArrayType t -> (** First get the number of values *) let n = int8_of_bytes buffer index in let type_of_elt = Scalar t in let s = sizeof type_of_elt in let size = 1 + n * s in (Array (Array.init n - (fun i -> fst (value_of_bin buffer (index+1+i*s) type_of_elt))), size) - | Scalar "string" -> + (fun i -> fst (value_of_bin buffer (index+1+i*s) type_of_elt))), size) + | Scalar "string" -> let n = Char.code buffer.[index] in (String (String.sub buffer (index+1) n), (1+n)) - | _ -> failwith "value_of_bin" + | _ -> failwith "value_of_bin" let value_field = fun buf index field -> value_of_bin buf index field._type @@ -310,68 +310,68 @@ let byte = fun x -> Char.chr (x land 0xff) (** Returns the size of outputed data *) let rec sprint_value = fun buf i _type v -> match _type, v with - Scalar "uint8", Int x -> - if x < 0 || x > 0xff then - failwith (sprintf "Value too large to fit in a uint8: %d" x); - buf.[i] <- Char.chr x; sizeof _type - | Scalar "int8", Int x -> + Scalar "uint8", Int x -> + if x < 0 || x > 0xff then + failwith (sprintf "Value too large to fit in a uint8: %d" x); + buf.[i] <- Char.chr x; sizeof _type + | Scalar "int8", Int x -> if x < -0x7f || x > 0x7f then - failwith (sprintf "Value too large to fit in a int8: %d" x); + failwith (sprintf "Value too large to fit in a int8: %d" x); sprint_int8 buf i x; sizeof _type - | Scalar "float", Float f -> sprint_float buf i f; sizeof _type - | Scalar "double", Float f -> sprint_double buf i f; sizeof _type - | Scalar ("int32"|"uint32"), Int32 x -> sprint_int32 buf i x; sizeof _type - | Scalar "int16", Int x -> sprint_int16 buf i x; sizeof _type - | Scalar ("int32" | "uint32"), Int value -> + | Scalar "float", Float f -> sprint_float buf i f; sizeof _type + | Scalar "double", Float f -> sprint_double buf i f; sizeof _type + | Scalar ("int32"|"uint32"), Int32 x -> sprint_int32 buf i x; sizeof _type + | Scalar "int16", Int x -> sprint_int16 buf i x; sizeof _type + | Scalar ("int32" | "uint32"), Int value -> assert (_type <> Scalar "uint32" || value >= 0); buf.[i+3] <- byte (value asr 24); buf.[i+2] <- byte (value lsr 16); buf.[i+1] <- byte (value lsr 8); buf.[i+0] <- byte value; sizeof _type - | Scalar "uint16", Int value -> + | Scalar "uint16", Int value -> assert (value >= 0); buf.[i+1] <- byte (value lsr 8); buf.[i+0] <- byte value; sizeof _type - | ArrayType t, Array values -> + | ArrayType t, Array values -> (** Put the size first, then the values *) let n = Array.length values in ignore (sprint_value buf i (Scalar "uint8") (Int n)); let type_of_elt = Scalar t in let s = sizeof type_of_elt in for j = 0 to n - 1 do - ignore (sprint_value buf (i+1+j*s) type_of_elt values.(j)) + ignore (sprint_value buf (i+1+j*s) type_of_elt values.(j)) done; 1 + n * s - | Scalar "string", String s -> + | Scalar "string", String s -> let n = String.length s in assert (n < 256); (** Put the length first, then the bytes *) buf.[i] <- Char.chr n; if (i + n >= String.length buf) then - failwith "Error in sprint_value: message too long"; + failwith "Error in sprint_value: message too long"; String.blit s 0 buf (i+1) n; 1 + n - | (Scalar x|ArrayType x), _ -> failwith (sprintf "Pprz.sprint_value (%s)" x) + | (Scalar x|ArrayType x), _ -> failwith (sprintf "Pprz.sprint_value (%s)" x) let hex_of_int_array = function - Array array -> - let n = Array.length array in +Array array -> + let n = Array.length array in (* One integer -> 2 chars *) - let s = String.create (2*n) in - Array.iteri - (fun i dec -> - let x = int_of_value array.(i) in - assert (0 <= x && x <= 0xff); - let hex = sprintf "%02x" x in - String.blit hex 0 s (2*i) 2) - array; - s + let s = String.create (2*n) in + Array.iteri + (fun i dec -> + let x = int_of_value array.(i) in + assert (0 <= x && x <= 0xff); + let hex = sprintf "%02x" x in + String.blit hex 0 s (2*i) 2) + array; + s | value -> - failwith (sprintf "Error: expecting array in Pprz.hex_of_int_array, found %s" (string_of_value value)) + failwith (sprintf "Error: expecting array in Pprz.hex_of_int_array, found %s" (string_of_value value)) @@ -474,7 +474,7 @@ module type MESSAGES = sig val message_of_name : string -> message_id * message val values_of_payload : Serial.payload -> message_id * ac_id * values (** [values_of_bin payload] Parses a raw payload, returns the - message id, the A/C id and the list of (field_name, value) *) + message id, the A/C id and the list of (field_name, value) *) val payload_of_values : message_id -> ac_id -> values -> Serial.payload (** [payload_of_values id ac_id vs] Returns a payload *) @@ -495,7 +495,7 @@ module type MESSAGES = sig (** [message_answerer sender msg_name callback] *) val message_req : string -> string -> values -> (string -> values -> unit) -> unit - (** [message_answerer sender msg_name values receiver] Sends a request on the Ivy bus for the specified message. On reception, [receiver] will be applied on [sender_name] and expected values. *) +(** [message_answerer sender msg_name values receiver] Sends a request on the Ivy bus for the specified message. On reception, [receiver] will be applied on [sender_name] and expected values. *) end @@ -507,14 +507,14 @@ module MessagesOfXml(Class:CLASS_Xml) = struct let select = fun x -> Xml.attrib x "name" = Class.name in parse_class (ExtXml.child Class.xml ~select "class") with - Not_found -> failwith (sprintf "Unknown message class: %s" Class.name) + Not_found -> failwith (sprintf "Unknown message class: %s" Class.name) let messages = messages_by_id let message_of_id = fun id -> try Hashtbl.find messages_by_id id with Not_found -> fprintf stderr "message_of_id :%d\n%!" id; raise Not_found let message_of_name = fun name -> try Hashtbl.find messages_by_name name with - Not_found -> raise (Unknown_msg_name (name, Class.name)) + Not_found -> raise (Unknown_msg_name (name, Class.name)) let values_of_payload = fun buffer -> @@ -525,19 +525,19 @@ module MessagesOfXml(Class:CLASS_Xml) = struct let message = message_of_id id in Debug.call 'T' (fun f -> fprintf f "Pprz.values id=%d\n" id); let rec loop = fun index fields -> - match fields with - [] -> - if index = String.length buffer then - [] - else - failwith (sprintf "Pprz.values_of_payload, too many bytes: %s" (Debug.xprint buffer)) - | (field_name, field_descr)::fs -> - let (value, n) = value_field buffer index field_descr in - (field_name, value) :: loop (index+n) fs in + match fields with + [] -> + if index = String.length buffer then + [] + else + failwith (sprintf "Pprz.values_of_payload, too many bytes: %s" (Debug.xprint buffer)) + | (field_name, field_descr)::fs -> + let (value, n) = value_field buffer index field_descr in + (field_name, value) :: loop (index+n) fs in (id, ac_id, loop offset_fields message.fields) with - Invalid_argument("index out of bounds") -> - failwith (sprintf "Pprz.values_of_payload, wrong argument: %s" (Debug.xprint buffer)) + Invalid_argument("index out of bounds") -> + failwith (sprintf "Pprz.values_of_payload, wrong argument: %s" (Debug.xprint buffer)) let payload_of_values = fun id ac_id values -> @@ -551,12 +551,12 @@ module MessagesOfXml(Class:CLASS_Xml) = struct let i = ref offset_fields in List.iter (fun (field_name, field) -> - let v = - try List.assoc field_name values with - Not_found -> default_value field._type in - let size = sprint_value p !i field._type v in - i := !i + size - ) + let v = + try List.assoc field_name values with + Not_found -> default_value field._type in + let size = sprint_value p !i field._type v in + i := !i + size + ) message.fields; (** Cut to the actual length *) @@ -567,43 +567,43 @@ module MessagesOfXml(Class:CLASS_Xml) = struct let space = Str.regexp "[ \t]+" let values_of_string = fun s -> match Str.split space s with - msg_name::args -> - begin - try - let msg_id, msg = message_of_name msg_name in - let values = List.map2 (fun (field_name, field) v -> (field_name, value field._type v)) msg.fields args in - (msg_id, values) - with - Invalid_argument "List.map2" -> failwith (sprintf "Pprz.values_of_string: incorrect number of fields in '%s'" s) - end - | [] -> invalid_arg (sprintf "Pprz.values_of_string: %s" s) + msg_name::args -> + begin + try + let msg_id, msg = message_of_name msg_name in + let values = List.map2 (fun (field_name, field) v -> (field_name, value field._type v)) msg.fields args in + (msg_id, values) + with + Invalid_argument "List.map2" -> failwith (sprintf "Pprz.values_of_string: incorrect number of fields in '%s'" s) + end + | [] -> invalid_arg (sprintf "Pprz.values_of_string: %s" s) let string_of_message = fun ?(sep=" ") msg values -> (** Check that the values are compatible with this message *) List.iter (fun (k, _) -> - if not (List.mem_assoc k msg.fields) - then invalid_arg (sprintf "Pprz.string_of_message: unknown field '%s' in message '%s'" k msg.name)) + if not (List.mem_assoc k msg.fields) + then invalid_arg (sprintf "Pprz.string_of_message: unknown field '%s' in message '%s'" k msg.name)) values; String.concat sep (msg.name:: - List.map - (fun (field_name, field) -> - let v = - try List.assoc field_name values with - Not_found -> - default_value field._type in - formatted_string_of_value field.fformat v) - msg.fields) + List.map + (fun (field_name, field) -> + let v = + try List.assoc field_name values with + Not_found -> + default_value field._type in + formatted_string_of_value field.fformat v) + msg.fields) let message_send = fun ?timestamp sender msg_name values -> let m = snd (message_of_name msg_name) in let s = string_of_message m values in let timestamp_string = match timestamp with - None -> "" - | Some x -> sprintf "%f " x in + None -> "" + | Some x -> sprintf "%f " x in let msg = sprintf "%s%s %s" timestamp_string sender s in let n = String.length msg in if n > 1000 then (** FIXME: to prevent Ivy bug on long message *) @@ -613,29 +613,29 @@ module MessagesOfXml(Class:CLASS_Xml) = struct let message_bind = fun ?sender msg_name cb -> match sender with - None -> - Ivy.bind - (fun _ args -> - let values = try snd (values_of_string args.(2)) with exc -> prerr_endline (Printexc.to_string exc); [] in - cb args.(1) values) - (sprintf "^([0-9]+\\.[0-9]+ )?([^ ]*) +(%s( .*|$))" msg_name) - | Some s -> - Ivy.bind - (fun _ args -> - let values = try snd (values_of_string args.(1)) with exc -> prerr_endline (Printexc.to_string exc); [] in - cb s values) - (sprintf "^([0-9]+\\.[0-9]+ )?%s +(%s( .*|$))" s msg_name) + None -> + Ivy.bind + (fun _ args -> + let values = try snd (values_of_string args.(2)) with exc -> prerr_endline (Printexc.to_string exc); [] in + cb args.(1) values) + (sprintf "^([0-9]+\\.[0-9]+ )?([^ ]*) +(%s( .*|$))" msg_name) + | Some s -> + Ivy.bind + (fun _ args -> + let values = try snd (values_of_string args.(1)) with exc -> prerr_endline (Printexc.to_string exc); [] in + cb s values) + (sprintf "^([0-9]+\\.[0-9]+ )?%s +(%s( .*|$))" s msg_name) let message_answerer = fun sender msg_name cb -> let ivy_cb = fun _ args -> let asker = args.(0) and asker_id = args.(1) in try (** Against [cb] exceptions *) - let values = cb asker (snd (values_of_string args.(2))) in - let m = string_of_message (snd (message_of_name msg_name)) values in - Ivy.send (sprintf "%s %s %s" asker_id sender m) + let values = cb asker (snd (values_of_string args.(2))) in + let m = string_of_message (snd (message_of_name msg_name)) values in + Ivy.send (sprintf "%s %s %s" asker_id sender m) with - exc -> fprintf stderr "Pprz.answerer %s:%s: %s\n%!" sender msg_name (Printexc.to_string exc) + exc -> fprintf stderr "Pprz.answerer %s:%s: %s\n%!" sender msg_name (Printexc.to_string exc) in Ivy.bind ivy_cb (sprintf "^([^ ]*) +([^ ]*) +(%s_REQ.*)" msg_name) diff --git a/sw/lib/ocaml/serial.ml b/sw/lib/ocaml/serial.ml index 3b9c549f15..1c20a73869 100644 --- a/sw/lib/ocaml/serial.ml +++ b/sw/lib/ocaml/serial.ml @@ -47,26 +47,26 @@ type speed = let speed_of_baudrate = fun baudrate -> match baudrate with - "0" -> B0 - | "50" -> B50 - | "75" -> B75 - | "110" -> B110 - | "134" -> B134 - | "150" -> B150 - | "200" -> B200 - | "300" -> B300 - | "600" -> B600 - | "1200" -> B1200 - | "1800" -> B1800 - | "2400" -> B2400 - | "4800" -> B4800 - | "9600" -> B9600 - | "19200" -> B19200 - | "38400" -> B38400 - | "57600" -> B57600 - | "115200" -> B115200 - | "230400" -> B230400 - | _ -> invalid_arg "Serial.speed_of_baudrate" + "0" -> B0 + | "50" -> B50 + | "75" -> B75 + | "110" -> B110 + | "134" -> B134 + | "150" -> B150 + | "200" -> B200 + | "300" -> B300 + | "600" -> B600 + | "1200" -> B1200 + | "1800" -> B1800 + | "2400" -> B2400 + | "4800" -> B4800 + | "9600" -> B9600 + | "19200" -> B19200 + | "38400" -> B38400 + | "57600" -> B57600 + | "115200" -> B115200 + | "230400" -> B230400 + | _ -> invalid_arg "Serial.speed_of_baudrate" type payload = string @@ -83,8 +83,8 @@ let opendev device speed hw_flow_control = try init_serial device speed hw_flow_control with - Failure x -> - failwith (Printf.sprintf "Error %s (%s)" x device) + Failure x -> + failwith (Printf.sprintf "Error %s (%s)" x device) let close = Unix.close @@ -109,15 +109,15 @@ let input = fun ?(read = Unix.read) f -> let rec parse = fun start n -> Debug.call 'T' (fun f -> fprintf f "input parse: %d %d\n" start n); let nb_used = f (String.sub buffer start n) in -(* Printf.fprintf stderr "n'=%d\n" nb_used; flush stderr; *) + (* Printf.fprintf stderr "n'=%d\n" nb_used; flush stderr; *) if nb_used > 0 then - parse (start + nb_used) (n - nb_used) + parse (start + nb_used) (n - nb_used) else if n = buffer_len then - (* The buffer is full and the user does not consume any. We have to - discard one char to avoid a dead lock *) + (* The buffer is full and the user does not consume any. We have to + discard one char to avoid a dead lock *) parse (start + 1) (n - 1) else - wait start n in + wait start n in parse 0 n) @@ -152,25 +152,25 @@ module Transport(Protocol:PROTOCOL) = struct (* Checks if the complete frame is available in the buffer. *) if n < end_ then - raise Not_enough; + raise Not_enough; (* Extracts the complete frame *) let msg = String.sub buf !start length in (* Checks sum *) if Protocol.checksum msg then begin - (* Calls the handler with the message *) - use (Protocol.payload msg) + (* Calls the handler with the message *) + use (Protocol.payload msg) end else begin - (* Reports the error *) - incr nb_err; - discarded_bytes := !discarded_bytes + length; - Debug.call 'T' (fun f -> fprintf f "Transport.chk: %s\n" (Debug.xprint msg)) + (* Reports the error *) + incr nb_err; + discarded_bytes := !discarded_bytes + length; + Debug.call 'T' (fun f -> fprintf f "Transport.chk: %s\n" (Debug.xprint msg)) end; (* Continues with the rest of the message *) end_ + parse use (String.sub buf end_ (String.length buf - end_)) with - Not_found -> String.length buf - | Not_enough -> !start + Not_found -> String.length buf + | Not_enough -> !start end diff --git a/sw/lib/ocaml/srtm.ml b/sw/lib/ocaml/srtm.ml index 071833d9cd..672744f070 100644 --- a/sw/lib/ocaml/srtm.ml +++ b/sw/lib/ocaml/srtm.ml @@ -49,19 +49,19 @@ let open_compressed = fun f -> let find = fun tile -> try Hashtbl.find htiles tile with - Not_found -> - let (bottom, left) = tile in - let tile_name = - Printf.sprintf "%c%.0f%c%03.0f" (if bottom >= 0. then 'N' else 'S') (abs_float bottom) (if left >= 0. then 'E' else 'W') (abs_float left) in - try - let f = open_compressed (tile_name ^".hgt") in - let n = tile_size*tile_size*2 in - let buf = String.create n in - really_input f buf 0 n; - Hashtbl.add htiles tile buf; - buf - with Not_found -> - raise (Tile_not_found tile_name) + Not_found -> + let (bottom, left) = tile in + let tile_name = + Printf.sprintf "%c%.0f%c%03.0f" (if bottom >= 0. then 'N' else 'S') (abs_float bottom) (if left >= 0. then 'E' else 'W') (abs_float left) in + try + let f = open_compressed (tile_name ^".hgt") in + let n = tile_size*tile_size*2 in + let buf = String.create n in + really_input f buf 0 n; + Hashtbl.add htiles tile buf; + buf + with Not_found -> + raise (Tile_not_found tile_name) let get = fun tile y x -> @@ -87,8 +87,8 @@ let area_of_tile = fun tile -> if t = tile then a else _area_of_tile ()) with - | End_of_file -> raise (Tile_not_found tile) - | _ -> _area_of_tile () + | End_of_file -> raise (Tile_not_found tile) + | _ -> _area_of_tile () in _area_of_tile () @@ -118,30 +118,30 @@ let horizon_slope = fun geo r psi alpha d -> let heading_psi_2alpha = pi /. 2.0 -. psi -. alpha in let rec calc_horizon = fun sum_cos_alpha_i_slope_alpha_i sum_cos_alpha_i alpha_i -> - if alpha_i > alpha2 then atan ( sum_cos_alpha_i_slope_alpha_i /. sum_cos_alpha_i ) - else - let max_slope = ref 0.0 in - let dj = ref 0.0 in - begin - while !dj < d +. 1.0 do - let s_utm = utm_q +. !dj *. cos( heading_psi_2alpha +. alpha_i) in - let t_utm = utm_p +. !dj *. sin( heading_psi_2alpha +. alpha_i) in - let h = of_utm { utm_zone = z; utm_x = s_utm; utm_y = t_utm} in - begin - begin - let slope = float_of_int (h-r ) /. !dj in - if slope > !max_slope then max_slope := slope; - (* Printf.printf " h %d dj %.2f \n" h !dj; *) - end; - end; - dj := !dj +. step_d; - done; - (* Printf.printf "alpha_i %.2f max_slope %.2f \n" alpha_i !max_slope; *) - calc_horizon (sum_cos_alpha_i_slope_alpha_i +. !max_slope *. (cos (alpha_i -. alpha))) (sum_cos_alpha_i +. (cos (alpha_i -. alpha))) (alpha_i +. step_alpha) - end + if alpha_i > alpha2 then atan ( sum_cos_alpha_i_slope_alpha_i /. sum_cos_alpha_i ) + else + let max_slope = ref 0.0 in + let dj = ref 0.0 in + begin + while !dj < d +. 1.0 do + let s_utm = utm_q +. !dj *. cos( heading_psi_2alpha +. alpha_i) in + let t_utm = utm_p +. !dj *. sin( heading_psi_2alpha +. alpha_i) in + let h = of_utm { utm_zone = z; utm_x = s_utm; utm_y = t_utm} in + begin + begin + let slope = float_of_int (h-r ) /. !dj in + if slope > !max_slope then max_slope := slope; + (* Printf.printf " h %d dj %.2f \n" h !dj; *) + end; + end; + dj := !dj +. step_d; + done; + (* Printf.printf "alpha_i %.2f max_slope %.2f \n" alpha_i !max_slope; *) + calc_horizon (sum_cos_alpha_i_slope_alpha_i +. !max_slope *. (cos (alpha_i -. alpha))) (sum_cos_alpha_i +. (cos (alpha_i -. alpha))) (alpha_i +. step_alpha) + end in begin - (* Printf.printf "debut calcul \n"; *) + (* Printf.printf "debut calcul \n"; *) calc_horizon 0.0 0.0 0.0; end diff --git a/sw/lib/ocaml/ubx.ml b/sw/lib/ocaml/ubx.ml index 2b073e15a2..f9281d5408 100644 --- a/sw/lib/ocaml/ubx.ml +++ b/sw/lib/ocaml/ubx.ml @@ -24,8 +24,8 @@ module Protocol = struct (** SYNC1 SYNC2 CLASS ID LENGTH(2) UBX_PAYLOAD CK_A CK_B - LENGTH is the lentgh of UBX_PAYLOAD - For us, the 'payload' includes also CLASS, ID and the LENGTH *) + LENGTH is the lentgh of UBX_PAYLOAD + For us, the 'payload' includes also CLASS, ID and the LENGTH *) let sync1 = Char.chr 0xb5 let sync2 = Char.chr 0x62 let offset_payload=2 @@ -34,9 +34,9 @@ module Protocol = struct let rec loop = fun i -> let i' = String.index_from buf i sync1 in if String.length buf > i'+1 && buf.[i'+1] = sync2 then - i' + i' else - loop (i'+1) in + loop (i'+1) in loop 0 let payload_length = fun buf start -> @@ -113,19 +113,19 @@ let usr_irsim () = ubx_usr_id (), ubx_get_usr_msg "IRSIM" let sizeof = function - "U4" | "I4" -> 4 +"U4" | "I4" -> 4 | "U2" | "I2" -> 2 | "U1" | "I1" -> 1 | x -> failwith (Printf.sprintf "Ubx.sizeof: unknown format '%s'" x) let assoc = fun label fields -> let rec loop o = function - [] -> raise Not_found + [] -> raise Not_found | f::fs -> - let format = ExtXml.attrib f "format" in - if ExtXml.attrib f "name" = label - then (o, format) - else loop (o + sizeof format) fs in + let format = ExtXml.attrib f "format" in + if ExtXml.attrib f "name" = label + then (o, format) + else loop (o + sizeof format) fs in loop 0 fields let byte = fun x -> Char.chr (x land 0xff) @@ -139,28 +139,28 @@ let ubx_payload = fun msg_xml values -> List.iter (fun (label, value) -> let (pos, fmt) = - try - assoc label fields - with - Not_found -> failwith (Printf.sprintf "Field '%s' not found in %s" label (Xml.to_string msg_xml)) + try + assoc label fields + with + Not_found -> failwith (Printf.sprintf "Field '%s' not found in %s" label (Xml.to_string msg_xml)) in match fmt with - | "U1" -> - assert(value >= 0 && value < 0x100); - p.[pos] <- byte value - | "I1" -> - assert(value >= -0x80 && value <= 0x80); - p.[pos] <- byte value - | "I4" | "U4" -> - assert(fmt <> "U4" || value >= 0); - p.[pos+3] <- byte (value asr 24); - p.[pos+2] <- byte (value lsr 16); - p.[pos+1] <- byte (value lsr 8); - p.[pos+0] <- byte value - | "U2" | "I2" -> - p.[pos+1] <- byte (value lsr 8); - p.[pos+0] <- byte value - | _ -> failwith (Printf.sprintf "Ubx.make_payload: unknown format '%s'" fmt) + | "U1" -> + assert(value >= 0 && value < 0x100); + p.[pos] <- byte value + | "I1" -> + assert(value >= -0x80 && value <= 0x80); + p.[pos] <- byte value + | "I4" | "U4" -> + assert(fmt <> "U4" || value >= 0); + p.[pos+3] <- byte (value asr 24); + p.[pos+2] <- byte (value lsr 16); + p.[pos+1] <- byte (value lsr 8); + p.[pos+0] <- byte value + | "U2" | "I2" -> + p.[pos+1] <- byte (value lsr 8); + p.[pos+0] <- byte value + | _ -> failwith (Printf.sprintf "Ubx.make_payload: unknown format '%s'" fmt) ) values; p diff --git a/sw/lib/ocaml/wind_sock.ml b/sw/lib/ocaml/wind_sock.ml index e8f484df06..a6fe03f561 100644 --- a/sw/lib/ocaml/wind_sock.ml +++ b/sw/lib/ocaml/wind_sock.ml @@ -1,67 +1,67 @@ -(* - * 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. - * - *) + (* + * 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.create (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 + let flatten = fun s a -> + let n = Array.length a in + let b = Array.create (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 + 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 + 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 + (* 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 + (* 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 + (* 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 + (* 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 + 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 diff --git a/sw/lib/ocaml/xbee.ml b/sw/lib/ocaml/xbee.ml index 6751920043..e91763bcfb 100644 --- a/sw/lib/ocaml/xbee.ml +++ b/sw/lib/ocaml/xbee.ml @@ -159,12 +159,12 @@ let at_set_my = fun addr -> assert (addr >= 0 && addr < 0x10000); Printf.sprintf "ATMY%04x\r" addr let baud_rates = [1200, 0; 2400, 1; 4800, 2; 9600, 3; 19200, 4; - 38400, 5; 57600, 6; 115200, 7] + 38400, 5; 57600, 6; 115200, 7] let at_set_baud_rate = fun baud -> try Printf.sprintf "ATBD%d\r" (List.assoc baud baud_rates) with - Not_found -> invalid_arg "at_set_baud_rate" + Not_found -> invalid_arg "at_set_baud_rate" let at_exit = "ATCN\r" let at_api_enable = "ATAP1\r" @@ -173,29 +173,29 @@ let api_parse_frame = fun s -> let n = String.length s in assert(n>0); match s.[0] with - x when x = api_at_command_response_id -> - assert(n >= 5); - AT_Command_Response (Char.code s.[1], String.sub s 2 2, - Char.code s.[4], String.sub s 5 (n-5)) - | x when not !mode868 && x = api_tx_status_id -> + x when x = api_at_command_response_id -> + assert(n >= 5); + AT_Command_Response (Char.code s.[1], String.sub s 2 2, + Char.code s.[4], String.sub s 5 (n-5)) + | x when not !mode868 && x = api_tx_status_id -> assert(n = 3); TX_Status (Char.code s.[1], Char.code s.[2]) - | x when !mode868 && x = api868_tx_status_id -> + | x when !mode868 && x = api868_tx_status_id -> assert(n = 7); TX868_Status (Char.code s.[1], Char.code s.[5], Char.code s.[4]) - | x when x = api_modem_status_id -> + | x when x = api_modem_status_id -> Modem_Status (Char.code s.[1]) - | x when not !mode868 && x = api_rx64_id -> + | x when not !mode868 && x = api_rx64_id -> assert(n >= 11); RX_Packet_64 (read_int64 s 1, Char.code s.[9], - Char.code s.[10], String.sub s 11 (n-11)) - | x when !mode868 && x = api868_rx64_id -> + Char.code s.[10], String.sub s 11 (n-11)) + | x when !mode868 && x = api868_rx64_id -> let idx_data = 12 in assert(n >= idx_data); RX868_Packet (read_int64 s 1, - Char.code s.[11], String.sub s idx_data (n-idx_data)) - | x when not !mode868 && (x = api_rx16_id || x = api_tx16_id) -> + Char.code s.[11], String.sub s idx_data (n-idx_data)) + | x when not !mode868 && (x = api_rx16_id || x = api_tx16_id) -> (* tx16 here allows to receive simulated xbee messages *) RX_Packet_16 (read_int16 s 1, Char.code s.[3], Char.code s.[4], String.sub s 5 (n-5)) - | x -> failwith (Printf.sprintf "Xbee.parse_frame: unknown frame id '%d'" (Char.code x)) + | x -> failwith (Printf.sprintf "Xbee.parse_frame: unknown frame id '%d'" (Char.code x)) diff --git a/sw/lib/ocaml/xml2h.ml b/sw/lib/ocaml/xml2h.ml index a718de7193..02fa83b0b3 100644 --- a/sw/lib/ocaml/xml2h.ml +++ b/sw/lib/ocaml/xml2h.ml @@ -42,7 +42,7 @@ let xml_error s = failwith ("Bad XML tag: "^s^ " expected") let sprint_float_array = fun l -> let rec loop = function - [] -> "}" + [] -> "}" | [x] -> x ^ "}" | x::xs -> x ^","^ loop xs in "{" ^ loop l diff --git a/sw/lib/ocaml/xmlCom.ml b/sw/lib/ocaml/xmlCom.ml index 0bcd49f91f..98fd8eba53 100644 --- a/sw/lib/ocaml/xmlCom.ml +++ b/sw/lib/ocaml/xmlCom.ml @@ -25,7 +25,7 @@ type state = A | B | C | D | D' | D'' | E let children = function - Nethtml.Element (_tag, _params, children) -> children +Nethtml.Element (_tag, _params, children) -> children | _ -> invalid_arg "XmlCom.children" @@ -54,30 +54,30 @@ let parse_file = fun file -> automata state in match state, char with - A, '<' -> copy_and_continue B - | A, _ -> copy_and_continue A + A, '<' -> copy_and_continue B + | A, _ -> copy_and_continue A - | B, '!' -> copy_and_continue A - | B, (' ' | '\t' | '\n') -> copy_and_continue B - | B, _ -> Buffer.add_char name char; copy_and_continue C + | B, '!' -> copy_and_continue A + | B, (' ' | '\t' | '\n') -> copy_and_continue B + | B, _ -> Buffer.add_char name char; copy_and_continue C - | C, (' ' | '\t' | '\n') -> copy_and_continue D - | C, '>' -> Buffer.clear name; copy_and_continue A - | C, '/' -> mem_and_continue E - | C, _ -> Buffer.add_char name char; copy_and_continue C + | C, (' ' | '\t' | '\n') -> copy_and_continue D + | C, '>' -> Buffer.clear name; copy_and_continue A + | C, '/' -> mem_and_continue E + | C, _ -> Buffer.add_char name char; copy_and_continue C - | D, '/' -> mem_and_continue E - | D, '>' -> Buffer.clear name; copy_and_continue A - | D, '"' -> copy_and_continue D' + | D, '/' -> mem_and_continue E + | D, '>' -> Buffer.clear name; copy_and_continue A + | D, '"' -> copy_and_continue D' | D, _ -> copy_and_continue D (* Inside a quoted string *) | D', '"' -> copy_and_continue D - | D', '\\' -> automata D'' - | D', _ -> copy_and_continue D' + | D', '\\' -> automata D'' + | D', _ -> copy_and_continue D' (* Inside a quoted string, just after a \ (backslash) *) - | D'', '"' -> Buffer.add_string buff """; automata D' + | D'', '"' -> Buffer.add_string buff """; automata D' | D'', _ -> Buffer.add_char buff '\\'; copy_and_continue D' | E, '>' -> replace_and_continue A diff --git a/sw/lib/ocaml/xmlEdit.ml b/sw/lib/ocaml/xmlEdit.ml index e26d72ea28..f7409962bd 100644 --- a/sw/lib/ocaml/xmlEdit.ml +++ b/sw/lib/ocaml/xmlEdit.ml @@ -70,9 +70,9 @@ let attribs_of_model = fun (store:GTree.tree_store) -> let editable_renderer = fun (model:GTree.tree_store) column -> let r = GTree.cell_renderer_text [`EDITABLE true] in let _ = r#connect#edited ~callback: - (fun path s -> - model#set ~row:(model#get_iter path) ~column s - ) in + (fun path s -> + model#set ~row:(model#get_iter path) ~column s + ) in r let attribs_view = fun model -> @@ -80,7 +80,7 @@ let attribs_view = fun model -> view#set_rules_hint true; let r = editable_renderer model attribute in let col = GTree.view_column ~title:"Attribute" () - ~renderer:(r, ["text",attribute]) in + ~renderer:(r, ["text",attribute]) in ignore (view#append_column col); col#set_max_width 100; @@ -102,8 +102,8 @@ let id = cols#add Gobject.Data.int let string_of_attribs = fun attribs -> match attribs with - ["PCData", data] -> data - | _ -> + ["PCData", data] -> data + | _ -> String.concat " " (List.map (fun (a,v) -> sprintf "%s=\"%s\"" a v) attribs) type id = int @@ -124,9 +124,9 @@ let encode_crs = Str.global_replace r "\\n" s (** Doesn' work. OCaml bug ? -let recode_crs = - let r = Str.regexp "\\n" in - fun s -> + let recode_crs = + let r = Str.regexp "\\n" in + fun s -> Str.global_replace r "\n" s *) @@ -149,11 +149,11 @@ let recode_crs = fun s -> let rec insert_xml = fun (store:GTree.tree_store) parent xml -> match xml with - Xml.Element _ -> - let row = store#append ~parent () in - set_xml store row xml; - List.iter (fun x -> insert_xml store row x) (Xml.children xml) - | Xml.PCData data -> + Xml.Element _ -> + let row = store#append ~parent () in + set_xml store row xml; + List.iter (fun x -> insert_xml store row x) (Xml.children xml) + | Xml.PCData data -> let row = store#append ~parent () in store#set ~row ~column:tag_col "PCData"; store#set ~row ~column:background default_background; @@ -186,9 +186,9 @@ let tree_view = fun format_attribs ?(edit=true) (model:GTree.tree_store) window let col = GTree.view_column ~title:"Tag" () ~renderer:(r, ["text",tag_col]) in col#set_cell_data_func r (set_bg_color r); let _ = r#connect#edited ~callback: - (fun path s -> - model#set ~row:(model#get_iter path) ~column:tag_col s - ) in + (fun path s -> + model#set ~row:(model#get_iter path) ~column:tag_col s + ) in ignore (view#append_column col); let r = GTree.cell_renderer_text [] in let col = GTree.view_column ~title:"Attributes" () ~renderer:(r, []) in @@ -200,42 +200,42 @@ let tree_view = fun format_attribs ?(edit=true) (model:GTree.tree_store) window (** Returns the list of all the tags appearing in the given DTD element *) let rec tags r = function - Dtd.DTDTag s -> s::r +Dtd.DTDTag s -> s::r | Dtd.DTDPCData -> r | Dtd.DTDOptional dtd_child | Dtd.DTDZeroOrMore dtd_child | Dtd.DTDOneOrMore dtd_child -> - tags r dtd_child + tags r dtd_child | Dtd.DTDChoice dtd_childs | Dtd.DTDChildren dtd_childs -> - List.fold_right (fun dc r -> tags r dc) dtd_childs r + List.fold_right (fun dc r -> tags r dc) dtd_childs r (** Returns the list of tags of possible children of the given [tag] *) let dtd_children = fun tag dtd -> let rec search = function - Dtd.DTDElement (t,det)::_ when t = tag -> det + Dtd.DTDElement (t,det)::_ when t = tag -> det | _::is -> search is | [] -> raise Not_found in match search dtd with - Dtd.DTDChild dc -> - tags [] dc - | _ -> [] + Dtd.DTDChild dc -> + tags [] dc + | _ -> [] (** Make a submenu with labels from [labels]. Attach the generic [callback] -which argument is the selected label *) + which argument is the selected label *) let submenu = fun ?(filter = fun _ -> true) menuitem ss connect -> let submenu = GMenu.menu () in List.iter (fun tag -> if filter tag then - let menuitem = GMenu.menu_item ~label:tag ~packing:submenu#append () in - let _c = menuitem#connect#activate ~callback:(fun () -> connect tag) in - ()) + let menuitem = GMenu.menu_item ~label:tag ~packing:submenu#append () in + let _c = menuitem#connect#activate ~callback:(fun () -> connect tag) in + ()) ss; menuitem#set_submenu submenu (** Returns the compulsory attributes of a given tag *) let required_attributes = fun tag dtd -> let rec filter = function - Dtd.DTDAttribute (t, a, _, (Dtd.DTDDefault s|Dtd.DTDFixed s))::dis when t = tag -> (a,s)::filter dis + Dtd.DTDAttribute (t, a, _, (Dtd.DTDDefault s|Dtd.DTDFixed s))::dis when t = tag -> (a,s)::filter dis | Dtd.DTDAttribute (t, a, _, Dtd.DTDRequired)::dis when t = tag -> (a,"???")::filter dis | _::dis -> filter dis | [] -> [] in @@ -249,59 +249,59 @@ let allowed_attributes = fun tag dtd -> filter dtd let attr_submenu = fun ?filter menuitem tag dtd connect -> - submenu ?filter menuitem (allowed_attributes tag dtd) connect + submenu ?filter menuitem (allowed_attributes tag dtd) connect let selection = fun (tree_store, tree_view) -> match tree_view#selection#get_selected_rows with - path::_ -> - tree_store, path - | _ -> raise Not_found + path::_ -> + tree_store, path + | _ -> raise Not_found let attribs_menu_popup = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) (attrib_row:Gtk.tree_iter) -> let menu = GMenu.menu () in begin match tree_view#selection#get_selected_rows with - path::_ -> - let tree_model = tree_view#model in - let row = tree_model#get_iter path in - let current_tag = tree_model#get ~row ~column:tag_col in - let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in - let current_attrib = model#get ~row:attrib_row ~column:attribute in - if not (List.mem_assoc current_attrib (required_attributes current_tag dtd)) then begin - let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in - ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#remove attrib_row))) - end; + path::_ -> + let tree_model = tree_view#model in + let row = tree_model#get_iter path in + let current_tag = tree_model#get ~row ~column:tag_col in + let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in + let current_attrib = model#get ~row:attrib_row ~column:attribute in + if not (List.mem_assoc current_attrib (required_attributes current_tag dtd)) then begin + let menuitem = GMenu.menu_item ~label:"Delete" ~packing:menu#append () in + ignore (menuitem#connect#activate ~callback:(fun () -> ignore (model#remove attrib_row))) + end; - let l = ref [] in - model#foreach (fun _path row -> - l := model#get ~row ~column:attribute :: !l; false); - let filter = fun x -> not (List.mem x !l) in + let l = ref [] in + model#foreach (fun _path row -> + l := model#get ~row ~column:attribute :: !l; false); + let filter = fun x -> not (List.mem x !l) in - let connect = fun a -> - let row = model#insert_after attrib_row in - let av = (a, "???") in - set_attr_value model row av in - attr_submenu ~filter menuitem current_tag dtd connect - | _ -> () + let connect = fun a -> + let row = model#insert_after attrib_row in + let av = (a, "???") in + set_attr_value model row av in + attr_submenu ~filter menuitem current_tag dtd connect + | _ -> () end; menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) let add_one_menu = fun dtd (tree_view:GTree.view) (model:GTree.tree_store) -> - match tree_view#selection#get_selected_rows with + match tree_view#selection#get_selected_rows with path::_ -> - let tree_model = tree_view#model in - let row = tree_model#get_iter path in - let current_tag = tree_model#get ~row ~column:tag_col in - let menu = GMenu.menu () in - let menuitem = GMenu.menu_item ~label:"Add one" ~packing:menu#append () in - let connect = fun a -> - let row = model#append () in - let av = (a, "???") in - set_attr_value model row av in - attr_submenu menuitem current_tag dtd connect; - menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) - | _ -> () + let tree_model = tree_view#model in + let row = tree_model#get_iter path in + let current_tag = tree_model#get ~row ~column:tag_col in + let menu = GMenu.menu () in + let menuitem = GMenu.menu_item ~label:"Add one" ~packing:menu#append () in + let connect = fun a -> + let row = model#append () in + let av = (a, "???") in + set_attr_value model row av in + attr_submenu menuitem current_tag dtd connect; + menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) + | _ -> () @@ -310,34 +310,34 @@ let add_context_menu = fun model view ?noselection_menu menu -> view#event#connect#button_press ~callback: (fun ev -> GdkEvent.Button.button ev = 3 - && - match view#selection#get_selected_rows, noselection_menu with - path::_, _ -> - let row = model#get_iter path in - menu model row; - true - | [], Some menu -> - menu model; - true - | _ -> false) + && + match view#selection#get_selected_rows, noselection_menu with + path::_, _ -> + let row = model#get_iter path in + menu model row; + true + | [], Some menu -> + menu model; + true + | _ -> false) let add_delete_key = fun (model:GTree.tree_store) (view:GTree.view) -> view#event#connect#key_press (fun ev -> if GdkEvent.Key.keyval ev = GdkKeysyms._Delete then match view#selection#get_selected_rows with - path::_ -> - let row = model#get_iter path in - model#get ~row ~column:event Deleted; - ignore (model#remove row); - true - | _ -> false + path::_ -> + let row = model#get_iter path in + model#get ~row ~column:event Deleted; + ignore (model#remove row); + true + | _ -> false else false) let root = fun ((model:GTree.tree_store), _) -> match model#get_iter_first with - None -> invalid_arg "XmlEdit.root" - | Some i -> (model, model#get_path i) + None -> invalid_arg "XmlEdit.root" + | Some i -> (model, model#get_path i) let attribs = fun ((model, path):node) -> @@ -349,11 +349,11 @@ let set_attribs = fun ((model, path):node) attribs -> model#set ~row ~column:attributes attribs let rec replace_assoc a v = function - [] -> [(a, v)] +[] -> [(a, v)] | (a', v')::l -> - if a = String.uppercase a' - then (a, v)::l - else (a', v')::replace_assoc a v l + if a = String.uppercase a' + then (a, v)::l + else (a', v')::replace_assoc a v l let set_attrib = fun node (a, v) -> let atbs = attribs node in @@ -363,9 +363,9 @@ let attrib = fun node at -> let at = String.uppercase at in let ats = attribs node in let rec loop = function - [] -> raise Not_found + [] -> raise Not_found | (a,v)::avs -> - if String.uppercase a = at then v else loop avs in + if String.uppercase a = at then v else loop avs in loop ats let tag = fun ((model, path):node) -> @@ -389,8 +389,8 @@ let rec xml_of_node = fun (node:node) -> and tag = tag node in if tag = "PCData" then match attrs with - ["PCData", data] -> Xml.PCData (sprintf "\n%s\n" (recode_crs data)) - | _ -> failwith (sprintf "Wrong data in %s\n" tag) + ["PCData", data] -> Xml.PCData (sprintf "\n%s\n" (recode_crs data)) + | _ -> failwith (sprintf "Wrong data in %s\n" tag) else let children = List.map xml_of_node (children node) in Xml.Element (tag, List.sort compare attrs, children) @@ -404,9 +404,9 @@ let child = fun ((model, path):node) (t:string) -> let i = model#iter_children (Some row) in let rec loop = fun () -> if model#get ~row:i ~column:tag_col = t then - (model, model#get_path i) + (model, model#get_path i) else if model#iter_next i then - loop () + loop () else failwith (sprintf "XmlEdit.child: %s" t) in loop () else @@ -419,9 +419,9 @@ let rec parent = fun ((model, path):node) (t:string) -> (model, path) else match model#iter_parent row with - None -> failwith (sprintf "XmlEdit.parent: %s" t) - | Some p -> - parent (model, model#get_path p) t + None -> failwith (sprintf "XmlEdit.parent: %s" t) + | Some p -> + parent (model, model#get_path p) t let delete = fun (model, path) -> @@ -481,29 +481,29 @@ let tree_menu_popup = fun dtd (model:GTree.tree_store) (row:Gtk.tree_iter) -> end; begin match model#iter_parent row with - Some parent -> - let copy = fun () -> - let xml = xml_of_node (model,(model#get_path row)) in - let row = model#insert_after ~parent row in - set_xml model row xml; - model#get ~row:parent ~column:event (New_child (model, model#get_path row)); - List.iter (insert_xml model row) (Xml.children xml) - in - let menuitem = GMenu.menu_item ~label:"Copy after" ~packing:menu#append () in - ignore (menuitem#connect#activate ~callback:copy); + Some parent -> + let copy = fun () -> + let xml = xml_of_node (model,(model#get_path row)) in + let row = model#insert_after ~parent row in + set_xml model row xml; + model#get ~row:parent ~column:event (New_child (model, model#get_path row)); + List.iter (insert_xml model row) (Xml.children xml) + in + let menuitem = GMenu.menu_item ~label:"Copy after" ~packing:menu#append () in + ignore (menuitem#connect#activate ~callback:copy); - let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in - let parent_tag = model#get ~row:parent ~column:tag_col in - let connect = fun t -> - let row = model#insert_after ~parent row in - let attrs = required_attributes t dtd in - let xml = Xml.Element (t, attrs, []) in - set_xml model row xml; - model#get ~row:parent ~column:event (New_child (model, model#get_path row)) - in - let tags = dtd_children parent_tag dtd in - submenu menuitem tags connect - | _ -> () + let menuitem = GMenu.menu_item ~label:"Add after" ~packing:menu#append () in + let parent_tag = model#get ~row:parent ~column:tag_col in + let connect = fun t -> + let row = model#insert_after ~parent row in + let attrs = required_attributes t dtd in + let xml = Xml.Element (t, attrs, []) in + set_xml model row xml; + model#get ~row:parent ~column:event (New_child (model, model#get_path row)) + in + let tags = dtd_children parent_tag dtd in + submenu menuitem tags connect + | _ -> () end; menu#popup ~button:1 ~time:(GtkMain.Main.get_current_event_time ()) @@ -515,12 +515,12 @@ let create = fun ?(format_attribs = string_of_attribs) ?(editable=true) ?(width let attribs_model = model_of_attribs () in let hbox = GPack.hbox () in let sw = GBin.scrolled_window ~width ~hpolicy:`AUTOMATIC - ~vpolicy:`AUTOMATIC ~packing:hbox#add () in + ~vpolicy:`AUTOMATIC ~packing:hbox#add () in let tree_view = tree_view format_attribs ~edit:editable tree_model sw in tree_view#set_border_width 10; let sw = GBin.scrolled_window ~width:150 ~hpolicy:`AUTOMATIC - ~vpolicy:`AUTOMATIC () in + ~vpolicy:`AUTOMATIC () in let attribs_view = attribs_view attribs_model in attribs_view#set_border_width 10; sw#add attribs_view#coerce; @@ -529,12 +529,12 @@ let create = fun ?(format_attribs = string_of_attribs) ?(editable=true) ?(width let update_tree = fun _path -> match tree_view#selection#get_selected_rows with - path::_ -> - let row = tree_model#get_iter path in - let new_attribs = attribs_of_model attribs_model in - tree_model#set ~row ~column:attributes new_attribs; - tree_model#get ~row ~column:event (Modified new_attribs) - | _ -> () + path::_ -> + let row = tree_model#get_iter path in + let new_attribs = attribs_of_model attribs_model in + tree_model#set ~row ~column:attributes new_attribs; + tree_model#get ~row ~column:event (Modified new_attribs) + | _ -> () in let _attribs_changed = attribs_model#connect#row_changed ~callback:(fun p _i -> update_tree p) in ignore (attribs_model#connect#row_deleted ~callback:update_tree); @@ -543,20 +543,20 @@ let create = fun ?(format_attribs = string_of_attribs) ?(editable=true) ?(width let selection_changed = fun () -> match tree_view#selection#get_selected_rows with - path::_ -> - let row = tree_model#get_iter path in - let attribs = tree_model#get ~row ~column:attributes in - attribs_model#clear (); - tag_of_last_selection := tree_model#get ~row ~column:tag_col; - set_attributes attribs_model attribs - | _ -> () in + path::_ -> + let row = tree_model#get_iter path in + let attribs = tree_model#get ~row ~column:attributes in + attribs_model#clear (); + tag_of_last_selection := tree_model#get ~row ~column:tag_col; + set_attributes attribs_model attribs + | _ -> () in let _c = tree_view#selection#connect#after#changed ~callback:selection_changed in let _ = tree_view#connect#after#row_activated ~callback: - (fun path vcol -> - let cbs = try (Hashtbl.find activated_cbs tree_model) with Not_found -> [] in - List.iter (fun cb -> cb (tree_model, path)) cbs) in + (fun path vcol -> + let cbs = try (Hashtbl.find activated_cbs tree_model) with Not_found -> [] in + List.iter (fun cb -> cb (tree_model, path)) cbs) in if editable then begin let _c = add_context_menu tree_model tree_view (tree_menu_popup dtd) in @@ -577,20 +577,20 @@ let create = fun ?(format_attribs = string_of_attribs) ?(editable=true) ?(width let row = tree_model#get_iter path in let row_tag = (tree_model#get ~row ~column:tag_col) in dropable := begin - match i with - GTK_TREE_VIEW_DROP_INTO_OR_BEFORE - | GTK_TREE_VIEW_DROP_INTO_OR_AFTER -> - List.mem !tag_of_last_selection (dtd_children row_tag dtd) - | _ -> - match tree_model#iter_parent row with - None -> false - | Some parent -> - let parent_tag = tree_model#get ~row:parent ~column:tag_col in - List.mem !tag_of_last_selection (dtd_children parent_tag dtd) + match i with + GTK_TREE_VIEW_DROP_INTO_OR_BEFORE + | GTK_TREE_VIEW_DROP_INTO_OR_AFTER -> + List.mem !tag_of_last_selection (dtd_children row_tag dtd) + | _ -> + match tree_model#iter_parent row with + None -> false + | Some parent -> + let parent_tag = tree_model#get ~row:parent ~column:tag_col in + List.mem !tag_of_last_selection (dtd_children parent_tag dtd) end; false with - Gpointer.Null -> false in + Gpointer.Null -> false in let drop = fun (context:GObj.drag_context) ~x ~y ~time -> if !dropable then false diff --git a/sw/lib/ocaml/xml_get.ml b/sw/lib/ocaml/xml_get.ml index 50dedbca39..e3790e1976 100644 --- a/sw/lib/ocaml/xml_get.ml +++ b/sw/lib/ocaml/xml_get.ml @@ -9,8 +9,8 @@ let _ = try Xml.parse_file xml_file with - Xml.Error e -> - Printf.fprintf stderr "\nError in \"%s\": %s\n\n" xml_file (Xml.error e); - exit 1 + Xml.Error e -> + Printf.fprintf stderr "\nError in \"%s\": %s\n\n" xml_file (Xml.error e); + exit 1 in Printf.printf "%s\n" (ExtXml.get_attrib xml path attribute) diff --git a/sw/tools/find_free_msg_id.ml b/sw/tools/find_free_msg_id.ml index 73d76ca7e4..c0f1b11072 100644 --- a/sw/tools/find_free_msg_id.ml +++ b/sw/tools/find_free_msg_id.ml @@ -46,35 +46,35 @@ let used_messages_id = fun xml -> if Xml.tag xml = "message" then (id_of_message xml) ::ids else List.fold_right - (fun c l -> find_message_ids c l) (Xml.children xml) ids + (fun c l -> find_message_ids c l) (Xml.children xml) ids in - List.map - (fun c -> ((Xml.attrib c "name"), find_message_ids c [])) class_xmls + List.map + (fun c -> ((Xml.attrib c "name"), find_message_ids c [])) class_xmls (* useful to display grouped ids *) let group = fun l -> let gl = ref [] in - try - let s = ref (List.hd l) in - let n = List.length l in - for i=1 to n-1 do - let li = List.nth l i and - li1= List.nth l (i-1) in - if (li - li1 > 1) - then begin - gl := - ( - if !s = li1 - then Printf.sprintf "%d" !s - else Printf.sprintf "%d-%d" !s li1) :: !gl; - s := li; - end - else if i = n -1 - then - gl := (Printf.sprintf "%d-%d" !s li) :: !gl; - done; - List.rev !gl - with Not_found -> [] + try + let s = ref (List.hd l) in + let n = List.length l in + for i=1 to n-1 do + let li = List.nth l i and + li1= List.nth l (i-1) in + if (li - li1 > 1) + then begin + gl := + ( + if !s = li1 + then Printf.sprintf "%d" !s + else Printf.sprintf "%d-%d" !s li1) :: !gl; + s := li; + end + else if i = n -1 + then + gl := (Printf.sprintf "%d-%d" !s li) :: !gl; + done; + List.rev !gl + with Not_found -> [] (* MAIN *) let () = @@ -92,16 +92,16 @@ let () = List.map (fun (c,_) -> if List.mem_assoc c umi then let used = List.assoc c umi in - (c,List.filter (fun i -> not (List.mem i used)) id_list) + (c,List.filter (fun i -> not (List.mem i used)) id_list) else (c,id_list) ) messages in (* print free IDs *) List.iter (fun (c, l) -> - Printf.printf "Class : %s \n" c; + Printf.printf "Class : %s \n" c; (*group l*) - List.iter (fun id -> Printf.printf " %d," id) l; - Printf.printf "\n\n" + List.iter (fun id -> Printf.printf " %d," id) l; + Printf.printf "\n\n" ) free_msg_id diff --git a/sw/tools/fp_proc.ml b/sw/tools/fp_proc.ml index f8b9704c05..13198f60c3 100644 --- a/sw/tools/fp_proc.ml +++ b/sw/tools/fp_proc.ml @@ -29,22 +29,22 @@ module G2D = Geometry_2d open Expr_syntax let rec list_split3 = function - [] -> ([], [], []) +[] -> ([], [], []) | (x,y,z)::l -> - let (rx, ry, rz) = list_split3 l in (x::rx, y::ry, z::rz) + let (rx, ry, rz) = list_split3 l in (x::rx, y::ry, z::rz) let parse_expression = fun s -> let lexbuf = Lexing.from_string s in try Expr_parser.expression Expr_lexer.token lexbuf with - Failure("lexing: empty token") -> - fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n" - s (Lexing.lexeme_char lexbuf 0); - exit 1 - | Parsing.Parse_error -> + Failure("lexing: empty token") -> + fprintf stderr "Lexing error in '%s': unexpected char: '%c' \n" + s (Lexing.lexeme_char lexbuf 0); + exit 1 + | Parsing.Parse_error -> fprintf stderr "Parsing error in '%s', token '%s' ?\n" - s (Lexing.lexeme lexbuf); + s (Lexing.lexeme lexbuf); exit 1 @@ -53,12 +53,12 @@ open Latlong let subst_expression = fun env e -> let rec sub = fun e -> match e with - Ident i -> Ident (try List.assoc i env with Not_found -> i) - | Int _ | Float _ | Field _ -> e - | Call (i, es) -> Call (i, List.map sub es) - | CallOperator (i, es) -> CallOperator (i, List.map sub es) - | Index (i,e) -> Index (i,sub e) - | Deref (e,f) -> Deref (sub e, f) in + Ident i -> Ident (try List.assoc i env with Not_found -> i) + | Int _ | Float _ | Field _ -> e + | Call (i, es) -> Call (i, List.map sub es) + | CallOperator (i, es) -> CallOperator (i, List.map sub es) + | Index (i,e) -> Index (i,sub e) + | Deref (e,f) -> Deref (sub e, f) in sub e @@ -72,9 +72,9 @@ let transform_values = fun attribs_not_modified env attribs -> (fun (a, v) -> let e = parse_expression v in let v' = - if List.mem (String.lowercase a) attribs_not_modified - then v - else transform_expression env e in + if List.mem (String.lowercase a) attribs_not_modified + then v + else transform_expression env e in (a, v')) attribs @@ -83,70 +83,70 @@ let prefix_or_deroute = fun prefix reroutes name attribs -> List.map (fun (a, v) -> let v' = - if String.lowercase a = name then - try List.assoc v reroutes with - Not_found -> prefix v - else v in + if String.lowercase a = name then + try List.assoc v reroutes with + Not_found -> prefix v + else v in (a, v')) attribs let transform_exception = fun prefix reroutes env xml -> match xml with - Xml.Element (tag, attribs, children) -> - assert (children=[]); - let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | _ -> failwith "transform_exception" + Xml.Element (tag, attribs, children) -> + assert (children=[]); + let attribs = prefix_or_deroute prefix reroutes "deroute" attribs in + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | _ -> failwith "transform_exception" let transform_stage = fun prefix reroutes env xml -> let rec tr = fun xml -> match xml with - Xml.Element (tag, attribs, children) -> begin - match String.lowercase tag with - "exception" -> - transform_exception prefix reroutes env xml - | "while" -> - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, List.map tr children) - | "heading" -> - assert (children=[]); - let attribs = transform_values ["vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "attitude" -> - let attribs = transform_values ["vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "go" -> - assert (children=[]); - let attribs = transform_values ["wp";"from";"hmode";"vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "xyz" -> - assert (children=[]); - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | "circle" -> - assert (children=[]); - let attribs = transform_values ["wp";"hmode";"vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "eight" -> - let attribs = transform_values ["center";"turn_around";"radius"] env attribs in - Xml.Element (tag, attribs, children) - | "deroute" -> - assert (children=[]); - let attribs = prefix_or_deroute prefix reroutes "block" attribs in - Xml.Element (tag, attribs, children) - | "stay" -> - assert (children=[]); - let attribs = transform_values ["wp"; "vmode"] env attribs in - Xml.Element (tag, attribs, children) - | "call" | "set" -> - let attribs = transform_values [] env attribs in - Xml.Element (tag, attribs, children) - | _ -> failwith (sprintf "Fp_proc: Unexpected tag: '%s'" tag) - end - | _ -> failwith "Fp_proc: Xml.Element expected" + Xml.Element (tag, attribs, children) -> begin + match String.lowercase tag with + "exception" -> + transform_exception prefix reroutes env xml + | "while" -> + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, List.map tr children) + | "heading" -> + assert (children=[]); + let attribs = transform_values ["vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "attitude" -> + let attribs = transform_values ["vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "go" -> + assert (children=[]); + let attribs = transform_values ["wp";"from";"hmode";"vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "xyz" -> + assert (children=[]); + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | "circle" -> + assert (children=[]); + let attribs = transform_values ["wp";"hmode";"vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "eight" -> + let attribs = transform_values ["center";"turn_around";"radius"] env attribs in + Xml.Element (tag, attribs, children) + | "deroute" -> + assert (children=[]); + let attribs = prefix_or_deroute prefix reroutes "block" attribs in + Xml.Element (tag, attribs, children) + | "stay" -> + assert (children=[]); + let attribs = transform_values ["wp"; "vmode"] env attribs in + Xml.Element (tag, attribs, children) + | "call" | "set" -> + let attribs = transform_values [] env attribs in + Xml.Element (tag, attribs, children) + | _ -> failwith (sprintf "Fp_proc: Unexpected tag: '%s'" tag) + end + | _ -> failwith "Fp_proc: Xml.Element expected" in tr xml @@ -175,7 +175,7 @@ let get_pc_data = fun tag xml -> try Xml.pcdata (ExtXml.child (ExtXml.child xml tag) "0") with - Not_found -> "" + Not_found -> "" let append_children = fun (tag, new_children) xml -> @@ -194,8 +194,8 @@ let parse_include = fun dir flight_plan include_xml -> let f = let procedure = ExtXml.attrib include_xml "procedure" in try Ocaml_tools.find_file [dir; Env.flight_plans_path] procedure with - Not_found -> - failwith (sprintf "parse_include: %s not found\n" procedure) in + Not_found -> + failwith (sprintf "parse_include: %s not found\n" procedure) in let proc_name = ExtXml.attrib include_xml "name" in let prefix = fun x -> proc_name ^ "." ^ x in @@ -205,20 +205,20 @@ let parse_include = fun dir flight_plan include_xml -> try let proc = ExtXml.parse_file ~noprovedtd:true f in let params = List.filter - (fun x -> ExtXml.tag_is x "param") - (Xml.children proc) in + (fun x -> ExtXml.tag_is x "param") + (Xml.children proc) in (* Build the environment with arguments and default values *) let make_assoc = fun xml -> let name = ExtXml.attrib xml "name" in try - (name, List.assoc name args_assocs) + (name, List.assoc name args_assocs) with - Not_found -> - try - (name, Xml.attrib xml "default_value") - with - _ -> failwith (sprintf "Value required for param '%s' in %s" name (Xml.to_string include_xml)) in + Not_found -> + try + (name, Xml.attrib xml "default_value") + with + _ -> failwith (sprintf "Value required for param '%s' in %s" name (Xml.to_string include_xml)) in let env = List.map make_assoc params in let waypoints = get_children "waypoints" proc @@ -238,21 +238,21 @@ let parse_include = fun dir flight_plan include_xml -> "sectors", sectors] (append_pc_data "header" header flight_plan) with - Failure msg -> fprintf stderr "Error: %s\n" msg; exit 1 + Failure msg -> fprintf stderr "Error: %s\n" msg; exit 1 let replace_children = fun xml new_children_assoc -> Xml.Element (Xml.tag xml, Xml.attribs xml, - List.map - (fun x -> - try - let new_children = List.assoc (Xml.tag x) new_children_assoc in - new_children - with - Not_found -> x - ) - (Xml.children xml)) + List.map + (fun x -> + try + let new_children = List.assoc (Xml.tag x) new_children_assoc in + new_children + with + Not_found -> x + ) + (Xml.children xml)) let process_includes = fun dir xml -> @@ -297,7 +297,7 @@ let replace_wp = fun stage waypoints -> let other_attribs = remove_attribs stage ["wp";"wp_qdr";"wp_dist"] in Xml.Element (Xml.tag stage, ("wp", name)::other_attribs, []) with - _ -> stage + _ -> stage let replace_from = fun stage waypoints -> @@ -311,18 +311,18 @@ let replace_from = fun stage waypoints -> let other_attribs = remove_attribs stage ["from";"from_qdr";"from_dist"] in Xml.Element (Xml.tag stage, ("from", name)::other_attribs, []) with - _ -> stage + _ -> stage let process_stage = fun stage waypoints -> let rec do_it = fun stage -> match String.lowercase (Xml.tag stage) with - "go" | "stay" | "circle" -> - replace_from (replace_wp stage waypoints) waypoints + "go" | "stay" | "circle" -> + replace_from (replace_wp stage waypoints) waypoints - | "while" -> - Xml.Element("while", Xml.attribs stage, List.map do_it (Xml.children stage)) - | _ -> stage in + | "while" -> + Xml.Element("while", Xml.attribs stage, List.map do_it (Xml.children stage)) + | _ -> stage in do_it stage @@ -337,11 +337,11 @@ let process_relative_waypoints = fun xml -> let blocks_list = List.map (fun block -> - let new_children = - List.map - (fun stage -> process_stage stage waypoints_list) - (Xml.children block) in - Xml.Element (Xml.tag block, Xml.attribs block, new_children) + let new_children = + List.map + (fun stage -> process_stage stage waypoints_list) + (Xml.children block) in + Xml.Element (Xml.tag block, Xml.attribs block, new_children) ) blocks_list in @@ -359,14 +359,14 @@ let stage_process_path = fun stage rest -> let waypoints = Str.split regexp_path (ExtXml.attrib stage "wpts") in let attribs = Xml.attribs stage in let rec loop = function - [] -> failwith "Waypoint expected in path stage" - | [wp] -> (* Just go to this single point *) - Xml.Element("go", ("wp", wp)::attribs, [])::rest - | wp1::wp2::ps -> - Xml.Element("go", ["from", wp1; - "hmode","route"; - "wp", wp2]@attribs, []):: - if ps = [] then rest else loop (wp2::ps) in + [] -> failwith "Waypoint expected in path stage" + | [wp] -> (* Just go to this single point *) + Xml.Element("go", ("wp", wp)::attribs, [])::rest + | wp1::wp2::ps -> + Xml.Element("go", ["from", wp1; + "hmode","route"; + "wp", wp2]@attribs, []):: + if ps = [] then rest else loop (wp2::ps) in loop waypoints else stage::rest diff --git a/sw/tools/gen_abi.ml b/sw/tools/gen_abi.ml index f6f05e0bed..2b2eb95a10 100644 --- a/sw/tools/gen_abi.ml +++ b/sw/tools/gen_abi.ml @@ -32,10 +32,10 @@ type field = _name * _type type fields = field list type message = { - name : string; - id : int; - fields : fields - } + name : string; + id : int; + fields : fields +} module Syntax = struct (** Translates a "message" XML element into a value of the 'message' type *) @@ -72,7 +72,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -98,9 +98,9 @@ module Gen_onboard = struct let print_args = fun h fields starter -> let rec args = fun h l -> match l with - [] -> Printf.fprintf h ")" - | [(n,t)] -> Printf.fprintf h "const %s %s)" t n - | (n,t)::l' -> Printf.fprintf h "const %s %s, " t n; args h l' + [] -> Printf.fprintf h ")" + | [(n,t)] -> Printf.fprintf h "const %s %s)" t n + | (n,t)::l' -> Printf.fprintf h "const %s %s, " t n; args h l' in Printf.fprintf h "(%s" starter; args h fields @@ -128,9 +128,9 @@ module Gen_onboard = struct (* print arguments *) let rec args = fun h l -> match l with - [] -> Printf.fprintf h ");\n" - | [(n,_)] -> Printf.fprintf h "%s);\n" n - | (n,_)::l' -> Printf.fprintf h "%s, " n; args h l' + [] -> Printf.fprintf h ");\n" + | [(n,_)] -> Printf.fprintf h "%s);\n" n + | (n,_)::l' -> Printf.fprintf h "%s, " n; args h l' in let name = String.capitalize msg.name in Printf.fprintf h "\nstatic inline void AbiSendMsg%s" name; @@ -196,4 +196,4 @@ let () = Printf.fprintf h "\n#endif // ABI_MESSAGES_H\n" with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_aircraft.ml b/sw/tools/gen_aircraft.ml index 0ffa0a5e72..e82a21c4c9 100644 --- a/sw/tools/gen_aircraft.ml +++ b/sw/tools/gen_aircraft.ml @@ -42,36 +42,36 @@ let check_unique_id_and_name = fun conf -> List.iter (fun x -> if String.lowercase (Xml.tag x) = "aircraft" then - let id = ExtXml.attrib x "ac_id" - and name = ExtXml.attrib x "name" in - if Hashtbl.mem ids id then begin - let other_name = Hashtbl.find ids id in - failwith (sprintf "Error: A/C Id '%s' duplicated in %s (%s and %s)" id conf_xml name other_name) - end; - if Hashtbl.mem names name then begin - let other_id = Hashtbl.find names name in - failwith (sprintf "Error: A/C name '%s' duplicated in %s (ids %s and %s)" name conf_xml id other_id) - end; - Hashtbl.add ids id name; - Hashtbl.add names name id) + let id = ExtXml.attrib x "ac_id" + and name = ExtXml.attrib x "name" in + if Hashtbl.mem ids id then begin + let other_name = Hashtbl.find ids id in + failwith (sprintf "Error: A/C Id '%s' duplicated in %s (%s and %s)" id conf_xml name other_name) + end; + if Hashtbl.mem names name then begin + let other_id = Hashtbl.find names name in + failwith (sprintf "Error: A/C name '%s' duplicated in %s (ids %s and %s)" name conf_xml id other_id) + end; + Hashtbl.add ids id name; + Hashtbl.add names name id) (Xml.children conf) (** [get_modules dir xml] - * [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *) + * [dir] is the conf directory for modules, [xml] is the parsed airframe.xml *) (*let get_modules = fun dir xml -> let modules = Gen_common.get_modules_of_airframe xml in - (* build a list (file name, (xml, xml list of flags)) *) +(* build a list (file name, (xml, xml list of flags)) *) let extract = List.map Gen_common.get_full_module_conf modules in - (* return a list of name and a list of pairs (xml, xml list) *) +(* return a list of name and a list of pairs (xml, xml list) *) List.split extract*) (** Search and dump the module section : - xml : the parsed airframe.xml - f : makefile.ac - **) + xml : the parsed airframe.xml + f : makefile.ac +**) let dump_module_section = fun xml f -> (* get modules *) let modules = Gen_common.get_modules_of_airframe xml in @@ -82,10 +82,10 @@ let dump_module_section = fun xml f -> fprintf f "\n# include modules directory for all targets\n"; (* get dir and target list *) let dir_list = Gen_common.get_modules_dir modules in -(** - let target_list = union_of_lists (List.map (fun (m,_) -> get_targets_of_module m) modules) in - List.iter (fun target -> fprintf f "%s.CFLAGS += -Imodules -Iarch/$(ARCH)/modules\n" target) target_list; -**) + (** + let target_list = union_of_lists (List.map (fun (m,_) -> get_targets_of_module m) modules) in + List.iter (fun target -> fprintf f "%s.CFLAGS += -Imodules -Iarch/$(ARCH)/modules\n" target) target_list; + **) (** include modules directory for ALL targets and not just the defined ones **) fprintf f "$(TARGET).CFLAGS += -Imodules -Iarch/$(ARCH)/modules\n"; List.iter (fun dir -> let dir_name = (String.uppercase dir)^"_DIR" in fprintf f "%s = modules/%s\n" dir_name dir) dir_list; @@ -100,17 +100,17 @@ let dump_module_section = fun xml f -> fprintf f "\n# makefile for module %s in modules/%s\n" name dir; List.iter (fun flag -> match String.lowercase (Xml.tag flag) with - "configure" -> - let value = Xml.attrib flag "value" - and name = Xml.attrib flag "name" in - fprintf f "%s = %s\n" name value - | "define" -> + "configure" -> + let value = Xml.attrib flag "value" + and name = Xml.attrib flag "name" in + fprintf f "%s = %s\n" name value + | "define" -> List.iter (fun target -> let name = ExtXml.attrib flag "name" and value = try "="^(Xml.attrib flag "value") with _ -> "" in fprintf f "%s.CFLAGS += -D%s%s\n" target name value ) module_target_list - | _ -> () + | _ -> () ) m.param; (* Look for makefile section *) List.iter (fun l -> @@ -122,11 +122,11 @@ let dump_module_section = fun xml f -> (* Look for defines, flags, files, ... *) List.iter (fun field -> match String.lowercase (Xml.tag field) with - "configure" -> - let value = Xml.attrib field "value" - and name = Xml.attrib field "name" in - fprintf f "%s = %s\n" name value - | "define" -> + "configure" -> + let value = Xml.attrib field "value" + and name = Xml.attrib field "name" in + fprintf f "%s = %s\n" name value + | "define" -> List.iter (fun target -> let value = try "="^(Xml.attrib field "value") with _ -> "" and name = Xml.attrib field "name" in @@ -135,48 +135,48 @@ let dump_module_section = fun xml f -> | "include" | "I" -> "I" | _ -> "D" in fprintf f "%s.CFLAGS += -%s%s%s\n" target flag_type name value - ) targets - | "file" -> + ) targets + | "file" -> let name = Xml.attrib field "name" in let dir_name = ExtXml.attrib_or_default field "dir" ("$("^dir_name^")") in List.iter (fun target -> fprintf f "%s.srcs += %s/%s\n" target dir_name name) targets - | "file_arch" -> + | "file_arch" -> let name = Xml.attrib field "name" in let dir_name = ExtXml.attrib_or_default field "dir" ("$("^dir_name^")") in List.iter (fun target -> fprintf f "%s.srcs += arch/$(ARCH)/%s/%s\n" target dir_name name) targets - | "raw" -> + | "raw" -> begin match Xml.children field with - [Xml.PCData s] -> fprintf f "%s\n" s - | _ -> fprintf stderr "Warning: wrong makefile section in module '%s'\n" name + [Xml.PCData s] -> fprintf f "%s\n" s + | _ -> fprintf stderr "Warning: wrong makefile section in module '%s'\n" name end - | _ -> () - ) (Xml.children l) + | _ -> () + ) (Xml.children l) end) (Xml.children m.xml) - ) modules; + ) modules; (** returns a list of modules file name *) List.map (fun m -> m.file) modules (** - Search and dump the makefile sections + Search and dump the makefile sections **) let dump_makefile_section = fun xml makefile_ac airframe_infile location -> List.iter (fun x -> if ExtXml.tag_is x "makefile" then begin let loc = ExtXml.attrib_or_default x "location" "before" in match (location, loc) with - ("before", "before") | ("after", "after") -> - fprintf makefile_ac "\n# raw makefile\n"; - begin match Xml.children x with - [Xml.PCData s] -> fprintf makefile_ac "%s\n" s - | _ -> failwith (sprintf "Warning: wrong makefile section in '%s': %s\n" airframe_infile (Xml.to_string_fmt x)) - end - | (_, _) -> () + ("before", "before") | ("after", "after") -> + fprintf makefile_ac "\n# raw makefile\n"; + begin match Xml.children x with + [Xml.PCData s] -> fprintf makefile_ac "%s\n" s + | _ -> failwith (sprintf "Warning: wrong makefile section in '%s': %s\n" airframe_infile (Xml.to_string_fmt x)) + end + | (_, _) -> () end) - (Xml.children xml) + (Xml.children xml) (** - * Firmware Children - * **) + * Firmware Children + * **) (* print a configure (firmware) *) let print_firmware_configure = fun f p -> @@ -248,7 +248,7 @@ let parse_firmware = fun makefile_ac firmware -> (** Search and dump the firmware section - **) +**) let dump_firmware_sections = fun xml makefile_ac -> List.iter (fun tag -> if ExtXml.tag_is tag "firmware" then begin @@ -259,7 +259,7 @@ let dump_firmware_sections = fun xml makefile_ac -> parse_firmware makefile_ac tag with _ -> failwith "Warning: firmware name is undeclared" end) - (Xml.children xml) + (Xml.children xml) @@ -287,13 +287,13 @@ let extract_makefile = fun airframe_file makefile_ac -> let is_older = fun target_file dep_files -> not (Sys.file_exists target_file) || - let target_file_time = (U.stat target_file).U.st_mtime in - let rec loop = function - [] -> false - | f::fs -> - target_file_time < (U.stat f).U.st_mtime || - loop fs in - loop dep_files + let target_file_time = (U.stat target_file).U.st_mtime in + let rec loop = function + [] -> false + | f::fs -> + target_file_time < (U.stat f).U.st_mtime || + loop fs in + loop dep_files let make_element = fun t a c -> Xml.Element (t,a,c) @@ -309,9 +309,9 @@ let () = check_unique_id_and_name conf; let aircraft_xml = try - ExtXml.child conf ~select:(fun x -> Xml.attrib x "name" = aircraft) "aircraft" + ExtXml.child conf ~select:(fun x -> Xml.attrib x "name" = aircraft) "aircraft" with - Not_found -> failwith (sprintf "Aircraft '%s' not found in '%s'" aircraft conf_xml) + Not_found -> failwith (sprintf "Aircraft '%s' not found in '%s'" aircraft conf_xml) in let value = fun attrib -> ExtXml.attrib aircraft_xml attrib in @@ -333,17 +333,17 @@ let () = let settings = try value "settings" with - _ -> - fprintf stderr "\nWARNING: No 'settings' attribute specified for A/C '%s', using 'settings/basic.xml'\n\n%!" aircraft; - "settings/basic.xml" in + _ -> + fprintf stderr "\nWARNING: No 'settings' attribute specified for A/C '%s', using 'settings/basic.xml'\n\n%!" aircraft; + "settings/basic.xml" in (** Expands the configuration of the A/C into one single file *) let conf_aircraft = Env.expand_ac_xml aircraft_xml in let configuration = make_element - "configuration" - [] - [make_element "conf" [] [conf_aircraft]; Pprz.messages_xml ()] in + "configuration" + [] + [make_element "conf" [] [conf_aircraft]; Pprz.messages_xml ()] in let conf_aircraft_file = aircraft_conf_dir // "conf_aircraft.xml" in let f = open_out conf_aircraft_file in Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); @@ -354,19 +354,19 @@ let () = let md5sum_file = aircraft_conf_dir // "aircraft.md5" in (* Store only if different from previous one *) if not (Sys.file_exists md5sum_file - && md5sum = input_line (open_in md5sum_file)) then begin - let f = open_out md5sum_file in - Printf.fprintf f "%s\n" md5sum; - close_out f; + && md5sum = input_line (open_in md5sum_file)) then begin + let f = open_out md5sum_file in + Printf.fprintf f "%s\n" md5sum; + close_out f; (** Save the configuration for future use *) - let d = U.localtime (U.gettimeofday ()) in - let filename = sprintf "%02d_%02d_%02d__%02d_%02d_%02d_%s_%s.conf" (d.U.tm_year mod 100) (d.U.tm_mon+1) (d.U.tm_mday) (d.U.tm_hour) (d.U.tm_min) (d.U.tm_sec) md5sum aircraft in - let d = Env.paparazzi_home // "var" // "conf" in - mkdir d; - let f = open_out (d // filename) in - Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); - close_out f end; + let d = U.localtime (U.gettimeofday ()) in + let filename = sprintf "%02d_%02d_%02d__%02d_%02d_%02d_%s_%s.conf" (d.U.tm_year mod 100) (d.U.tm_mon+1) (d.U.tm_mday) (d.U.tm_hour) (d.U.tm_min) (d.U.tm_sec) md5sum aircraft in + let d = Env.paparazzi_home // "var" // "conf" in + mkdir d; + let f = open_out (d // filename) in + Printf.fprintf f "%s\n" (ExtXml.to_string_fmt configuration); + close_out f end; let airframe_file = value "airframe" in @@ -379,20 +379,20 @@ let () = let make = fun target options -> let c = sprintf "make -f Makefile.ac AIRCRAFT=%s AC_ID=%s AIRFRAME_XML=%s TELEMETRY=%s SETTINGS=\"%s\" MD5SUM=\"%s\" %s %s" aircraft (value "ac_id") airframe_file (value "telemetry") settings md5sum options target in begin (** Quiet is speficied in the Makefile *) - try if Sys.getenv "Q" <> "@" then raise Not_found with - Not_found -> prerr_endline c + try if Sys.getenv "Q" <> "@" then raise Not_found with + Not_found -> prerr_endline c end; let returned_code = Sys.command c in if returned_code <> 0 then - exit returned_code in + exit returned_code in (** Calls the makefile if the optional attribute is available *) let make_opt = fun target var attr -> try - let value = Xml.attrib aircraft_xml attr in - make target (sprintf "%s=%s" var value) + let value = Xml.attrib aircraft_xml attr in + make target (sprintf "%s=%s" var value) with - Xml.No_attribute _ -> () in + Xml.No_attribute _ -> () in let temp_makefile_ac = Filename.temp_file "Makefile.ac" "tmp" in let abs_airframe_file = paparazzi_conf // airframe_file in @@ -411,6 +411,6 @@ let () = make_opt "radio_ac_h" "RADIO" "radio"; make_opt "flight_plan_ac_h" "FLIGHT_PLAN" "flight_plan" with - Failure f -> - prerr_endline f; - exit 1 + Failure f -> + prerr_endline f; + exit 1 diff --git a/sw/tools/gen_airframe.ml b/sw/tools/gen_airframe.ml index f0998578c3..543199b8ff 100644 --- a/sw/tools/gen_airframe.ml +++ b/sw/tools/gen_airframe.ml @@ -39,7 +39,7 @@ let get_servo_driver = fun servo_name -> try Hashtbl.find servos_drivers servo_name with - Not_found -> failwith (sprintf "gen_airframe, Unknown servo: %s" servo_name) + Not_found -> failwith (sprintf "gen_airframe, Unknown servo: %s" servo_name) let get_list_of_drivers = fun () -> let l = ref [] in Hashtbl.iter @@ -52,10 +52,10 @@ let define_macro name n x = let a = fun s -> ExtXml.attrib x s in printf "#define %s(" name; match n with (* Do we really need more ??? *) - 1 -> printf "x1) (%s*(x1))\n" (a "coeff1") - | 2 -> printf "x1,x2) (%s*(x1)+ %s*(x2))\n" (a "coeff1") (a "coeff2") - | 3 -> printf "x1,x2,x3) (%s*(x1)+ %s*(x2)+%s*(x3))\n" (a "coeff1") (a "coeff2") (a "coeff3") - | _ -> failwith "define_macro" + 1 -> printf "x1) (%s*(x1))\n" (a "coeff1") + | 2 -> printf "x1,x2) (%s*(x1)+ %s*(x2))\n" (a "coeff1") (a "coeff2") + | 3 -> printf "x1,x2,x3) (%s*(x1)+ %s*(x2)+%s*(x3))\n" (a "coeff1") (a "coeff2") (a "coeff3") + | _ -> failwith "define_macro" let define_integer name v n = let max_val = 1 lsl n in @@ -84,9 +84,9 @@ let convert_value_with_code_unit_coef_of_xml = function xml -> let cu = ExtXml.attrib_or_default xml "code_unit" "" in (* default value for code_unit is rad[/s] when unit is deg[/s] *) let conv = try (Pprz.scale_of_units u cu) with - | Pprz.Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; exit 1 - | Pprz.Unknown_conversion (su, scu) -> prerr_endline (sprintf "Warning: unknown unit conversion: from %s to %s" su scu); flush stderr; failwith "Unknown unit conversion" - | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in + | Pprz.Unit_conversion_error s -> prerr_endline (sprintf "Unit conversion error: %s" s); flush stderr; exit 1 + | Pprz.Unknown_conversion (su, scu) -> prerr_endline (sprintf "Warning: unknown unit conversion: from %s to %s" su scu); flush stderr; failwith "Unknown unit conversion" + | Pprz.No_automatic_conversion _ | _ -> failwith "Unit conversion error" in let v = try ExtXml.float_attrib xml "value" with _ -> prerr_endline (sprintf "Error: Unit conversion of parameter %s impossible because '%s' is not a float" (Xml.attrib xml "name") (Xml.attrib xml "value")); flush stderr; exit 1 in v *. conv @@ -168,74 +168,74 @@ let print_actuators_idx = fun () -> let parse_command_laws = fun command -> let a = fun s -> ExtXml.attrib command s in - match Xml.tag command with - "set" -> - let servo = a "servo" - and value = a "value" in - let v = preprocess_value value "values" "COMMAND" in - printf " command_value = %s; \\\n" v; - printf " command_value *= command_value>0 ? SERVO_%s_TRAVEL_UP_NUM : SERVO_%s_TRAVEL_DOWN_NUM; \\\n" servo servo; - printf " command_value /= command_value>0 ? SERVO_%s_TRAVEL_UP_DEN : SERVO_%s_TRAVEL_DOWN_DEN; \\\n" servo servo; - printf " servo_value = SERVO_%s_NEUTRAL + command_value; \\\n" servo; - printf " Set_%s_Servo(servo_value); \\\n\\\n" servo - | "let" -> - let var = a "var" - and value = a "value" in - let v = preprocess_value value "values" "COMMAND" in - printf " int16_t _var_%s = %s; \\\n" var v - | "call" -> - let f = a "fun" in - printf " %s; \\\n\\\n" f - | "ratelimit" -> - let var = a "var" - and value = a "value" - and rate_min = a "rate_min" - and rate_max = a "rate_max" in - let v = preprocess_value value "values" "COMMAND" in - printf " static int16_t _var_%s = 0; _var_%s += Chop((%s) - (_var_%s), (%s), (%s)); \\\n" var var v var rate_min rate_max - | "define" -> - parse_element "" command - | _ -> xml_error "set|let" + match Xml.tag command with + "set" -> + let servo = a "servo" + and value = a "value" in + let v = preprocess_value value "values" "COMMAND" in + printf " command_value = %s; \\\n" v; + printf " command_value *= command_value>0 ? SERVO_%s_TRAVEL_UP_NUM : SERVO_%s_TRAVEL_DOWN_NUM; \\\n" servo servo; + printf " command_value /= command_value>0 ? SERVO_%s_TRAVEL_UP_DEN : SERVO_%s_TRAVEL_DOWN_DEN; \\\n" servo servo; + printf " servo_value = SERVO_%s_NEUTRAL + command_value; \\\n" servo; + printf " Set_%s_Servo(servo_value); \\\n\\\n" servo + | "let" -> + let var = a "var" + and value = a "value" in + let v = preprocess_value value "values" "COMMAND" in + printf " int16_t _var_%s = %s; \\\n" var v + | "call" -> + let f = a "fun" in + printf " %s; \\\n\\\n" f + | "ratelimit" -> + let var = a "var" + and value = a "value" + and rate_min = a "rate_min" + and rate_max = a "rate_max" in + let v = preprocess_value value "values" "COMMAND" in + printf " static int16_t _var_%s = 0; _var_%s += Chop((%s) - (_var_%s), (%s), (%s)); \\\n" var var v var rate_min rate_max + | "define" -> + parse_element "" command + | _ -> xml_error "set|let" let parse_rc_commands = fun rc -> let a = fun s -> ExtXml.attrib rc s in match Xml.tag rc with - "set" -> - let com = a "command" + "set" -> + let com = a "command" + and value = a "value" in + let v = preprocess_value value "_rc_array" "RADIO" in + printf " _commands_array[COMMAND_%s] = %s;\\\n" com v; + | "let" -> + let var = a "var" and value = a "value" in - let v = preprocess_value value "_rc_array" "RADIO" in - printf " _commands_array[COMMAND_%s] = %s;\\\n" com v; - | "let" -> - let var = a "var" - and value = a "value" in - let v = preprocess_value value "rc_values" "RADIO" in - printf " int16_t _var_%s = %s;\\\n" var v - | "define" -> - parse_element "" rc - | _ -> xml_error "set|let" + let v = preprocess_value value "rc_values" "RADIO" in + printf " int16_t _var_%s = %s;\\\n" var v + | "define" -> + parse_element "" rc + | _ -> xml_error "set|let" let parse_ap_only_commands = fun ap_only -> let a = fun s -> ExtXml.attrib ap_only s in match Xml.tag ap_only with - "copy" -> - let com = a "command" in - printf " commands[COMMAND_%s] = ap_commands[COMMAND_%s];\\\n" com com - | _ -> xml_error "copy" + "copy" -> + let com = a "command" in + printf " commands[COMMAND_%s] = ap_commands[COMMAND_%s];\\\n" com com + | _ -> xml_error "copy" let parse_command = fun command no -> - let command_name = "COMMAND_"^ExtXml.attrib command "name" in - define command_name (string_of_int no); - let failsafe_value = int_of_string (ExtXml.attrib command "failsafe_value") in - { failsafe_value = failsafe_value; foo = 0} + let command_name = "COMMAND_"^ExtXml.attrib command "name" in + define command_name (string_of_int no); + let failsafe_value = int_of_string (ExtXml.attrib command "failsafe_value") in + { failsafe_value = failsafe_value; foo = 0} let rec parse_section = fun s -> match Xml.tag s with - "section" -> - let prefix = ExtXml.attrib_or_default s "prefix" "" in - define ("SECTION_"^ExtXml.attrib s "name") "1"; - List.iter (parse_element prefix) (Xml.children s); - nl () - | "servos" -> + "section" -> + let prefix = ExtXml.attrib_or_default s "prefix" "" in + define ("SECTION_"^ExtXml.attrib s "name") "1"; + List.iter (parse_element prefix) (Xml.children s); + nl () + | "servos" -> let driver = ExtXml.attrib_or_default s "driver" "Default" in let servos = Xml.children s in let nb_servos = List.fold_right (fun s m -> Pervasives.max (int_of_string (ExtXml.attrib s "no")) m) servos min_int + 1 in @@ -245,25 +245,25 @@ let rec parse_section = fun s -> nl (); List.iter (parse_servo driver) servos; nl () - | "commands" -> + | "commands" -> let commands = Array.of_list (Xml.children s) in let commands_params = Array.mapi (fun i c -> parse_command c i) commands in define "COMMANDS_NB" (string_of_int (Array.length commands)); define "COMMANDS_FAILSAFE" (sprint_float_array (List.map (fun x -> string_of_int x.failsafe_value) (Array.to_list commands_params))); nl (); nl () - | "rc_commands" -> + | "rc_commands" -> printf "#define SetCommandsFromRC(_commands_array, _rc_array) { \\\n"; List.iter parse_rc_commands (Xml.children s); printf "}\n\n" - | "auto_rc_commands" -> + | "auto_rc_commands" -> printf "#define SetAutoCommandsFromRC(_commands_array, _rc_array) { \\\n"; List.iter parse_rc_commands (Xml.children s); printf "}\n\n" - | "ap_only_commands" -> + | "ap_only_commands" -> printf "#define SetApOnlyCommands(ap_commands) { \\\n"; List.iter parse_ap_only_commands (Xml.children s); printf "}\n\n" - | "command_laws" -> + | "command_laws" -> print_actuators_idx (); printf "#define SetActuatorsFromCommands(values) { \\\n"; @@ -279,16 +279,16 @@ let rec parse_section = fun s -> printf "#define AllActuatorsInit() { \\\n"; List.iter (fun d -> printf " Actuators%sInit();\\\n" d) drivers; printf "}\n\n"; - | "include" -> + | "include" -> let filename = ExtXml.attrib s "href" in let subxml = Xml.parse_file filename in printf "/* XML %s */" filename; nl (); List.iter parse_section (Xml.children subxml) - | "makefile" -> + | "makefile" -> () - (** Ignoring this section *) - | _ -> () + (** Ignoring this section *) + | _ -> () let h_name = "AIRFRAME_H" @@ -301,7 +301,7 @@ let hex_to_bin = fun s -> b.[4*i] <- '\\'; Scanf.sscanf (String.sub s (2*i) 2) "%2x" (fun x -> - String.blit (sprintf "%03o" x) 0 b (4*i+1) 3) + String.blit (sprintf "%03o" x) 0 b (4*i+1) 3) done; b @@ -322,7 +322,7 @@ let _ = List.iter parse_section (Xml.children xml); finish h_name with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_autopilot.ml b/sw/tools/gen_autopilot.ml index 40b7cb604d..4001d4bdaf 100644 --- a/sw/tools/gen_autopilot.ml +++ b/sw/tools/gen_autopilot.ml @@ -22,7 +22,7 @@ (* * XML preprocessing for core autopilot - *) + *) open Printf open Xml2h @@ -67,8 +67,8 @@ let print_modes = fun modes out_h -> lprintf out_h "#define %s %d\n" (print_mode_name name) !mode_idx; mode_idx := !mode_idx + 1; with _ -> () - ) - modes + ) + modes (** Init function: set last_mode to initial ap_mode *) (* TODO really needed ? *) let print_ap_init = fun modes out_h -> @@ -78,9 +78,9 @@ let print_ap_init = fun modes out_h -> List.exists (fun s -> if Xml.tag s = "select" then Xml.attrib s "cond" = "$DEFAULT_MODE" else false) (Xml.children m) ) modes in match List.length default with - 0 -> List.hd modes - | 1 -> List.hd default - | _ -> failwith "Autopilot Core Error: only one default mode can be set" + 0 -> List.hd modes + | 1 -> List.hd default + | _ -> failwith "Autopilot Core Error: only one default mode can be set" in let default = find_default_mode () in @@ -101,13 +101,13 @@ let print_test_select = fun modes out_h -> List.iter (fun s -> (* In each mode, build condition and exceptions' list *) let cond = Xml.attrib s "cond" in let except = try String.concat " || " - (List.map (fun e -> Printf.sprintf "private_autopilot_mode != %s" (print_mode_name e)) - (Str.split (Str.regexp "|") (Xml.attrib s "exception")) - ) with _ -> "" in + (List.map (fun e -> Printf.sprintf "private_autopilot_mode != %s" (print_mode_name e)) + (Str.split (Str.regexp "|") (Xml.attrib s "exception")) + ) with _ -> "" in match (cond, String.length except) with - ("$DEFAULT_MODE", _) -> () - | (_, 0) -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name (Xml.attrib m "name")) - | (_, _) -> lprintf out_h "if ((%s) && (%s)) { return %s; }\n" cond except (print_mode_name (Xml.attrib m "name")) + ("$DEFAULT_MODE", _) -> () + | (_, 0) -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name (Xml.attrib m "name")) + | (_, _) -> lprintf out_h "if ((%s) && (%s)) { return %s; }\n" cond except (print_mode_name (Xml.attrib m "name")) ) select; ) modes; lprintf out_h "return private_autopilot_mode;\n"; @@ -116,16 +116,16 @@ let print_test_select = fun modes out_h -> (** Function to test exceptions on modes - * The generated function returns the new mode if an exception is true - *) + * The generated function returns the new mode if an exception is true +*) let print_test_exception = fun modes out_h -> (** Test condition and deroute to given mode or last mode *) let print_exception = fun ex -> let name = Xml.attrib ex "deroute" and cond = Xml.attrib ex "cond" in match name with - "$LAST_MODE" -> lprintf out_h "if (%s) { return last_autopilot_mode; }\n" cond - | _ -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name name) + "$LAST_MODE" -> lprintf out_h "if (%s) { return last_autopilot_mode; }\n" cond + | _ -> lprintf out_h "if (%s) { return %s; }\n" cond (print_mode_name name) in lprintf out_h "\nstatic inline uint8_t autopilot_core_mode_exceptions(uint8_t mode) {\n"; @@ -153,8 +153,8 @@ let print_test_exception = fun modes out_h -> lprintf out_h "}\n" (** Function to test global exceptions - * The generated function returns the mode of the last true exception in the list - *) + * The generated function returns the mode of the last true exception in the list +*) let print_global_exceptions = fun exceptions out_h -> lprintf out_h "\nstatic inline uint8_t autopilot_core_global_exceptions(uint8_t mode) {\n"; right (); @@ -206,12 +206,12 @@ let print_set_mode = fun modes out_h -> (** Peridiodic function: calls control loops according to the ap_mode *) let print_ap_periodic = fun modes ctrl_block main_freq out_h -> - (** Print function *) + (** Print function *) let print_call = fun call -> try let f = Xml.attrib call "fun" in let cond = try String.concat "" ["if ("; (Xml.attrib call "cond"); ") { "; f; "; }\n"] - with _ -> String.concat "" [f; ";\n"] in + with _ -> String.concat "" [f; ";\n"] in lprintf out_h "%s" cond with _ -> () in @@ -219,9 +219,9 @@ let print_ap_periodic = fun modes ctrl_block main_freq out_h -> let print_ctrl = fun ctrl -> List.iter (fun c -> match (Xml.tag c) with - "call" -> print_call c - | "call_block" -> List.iter print_call (Xml.children (List.find (fun n -> (Xml.attrib c "name") = (Xml.attrib n "name")) ctrl_block)) - | _ -> () + "call" -> print_call c + | "call_block" -> List.iter print_call (Xml.children (List.find (fun n -> (Xml.attrib c "name") = (Xml.attrib n "name")) ctrl_block)) + | _ -> () ) (Xml.children ctrl) in (** Equivalent to the RunOnceEvery macro *) @@ -261,9 +261,9 @@ let print_ap_periodic = fun modes ctrl_block main_freq out_h -> let ctrl_freq = try int_of_string (Xml.attrib c "freq") with _ -> main_freq in let prescaler = main_freq / ctrl_freq in match prescaler with - 0 -> failwith "Autopilot Core Error: control freq higher than main freq" - | 1 -> print_ctrl c (* no prescaler if running at main_freq *) - | _ -> print_prescaler prescaler c + 0 -> failwith "Autopilot Core Error: control freq higher than main freq" + | 1 -> print_ctrl c (* no prescaler if running at main_freq *) + | _ -> print_prescaler prescaler c ) (get_control m); left (); lprintf out_h "}\n"; @@ -296,16 +296,16 @@ let parse_modes ap freq out_h = let h_name = "AUTOPILOT_CORE_H" (** Main generation function - * Usage: main_freq xml_file_input h_file_output - *) + * Usage: main_freq xml_file_input h_file_output +*) let gen_autopilot main_freq xml_file h_file = let out_h = open_out h_file in try let ap_xml = start_and_begin_out xml_file h_name out_h in let _ = try - let ap_name = Xml.attrib ap_xml "name" in - fprintf out_h "/*** %s ***/\n\n" ap_name; - with _ -> () in + let ap_name = Xml.attrib ap_xml "name" in + fprintf out_h "/*** %s ***/\n\n" ap_name; + with _ -> () in fprintf out_h "#ifdef AUTOPILOT_CORE_C\n"; fprintf out_h "#define EXTERN_AP\n"; fprintf out_h "#else\n"; @@ -315,10 +315,10 @@ let gen_autopilot main_freq xml_file h_file = fprintf out_h "\n#endif // %s\n" h_name; close_out out_h with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 (* Main call *) let () = @@ -332,14 +332,12 @@ let () = gen_autopilot ap_freq autopilot h_file; () with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 - | Not_found -> + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + | Not_found -> let out_h = open_out h_file in fprintf out_h "/*** Sorry, no autopilot file found ***/\n"; close_out out_h; exit 0 - - diff --git a/sw/tools/gen_common.ml b/sw/tools/gen_common.ml index 2d5a821dc8..54ede59123 100644 --- a/sw/tools/gen_common.ml +++ b/sw/tools/gen_common.ml @@ -39,9 +39,9 @@ let default_freq = 60 let singletonize = fun l -> let rec loop = fun l -> match l with - [] | [_] -> l - | x::((x'::_) as xs) -> - if x = x' then loop xs else x::loop xs in + [] | [_] -> l + | x::((x'::_) as xs) -> + if x = x' then loop xs else x::loop xs in loop (List.sort compare l) (** union of two lists *) @@ -56,75 +56,75 @@ let union_of_lists = fun l -> singletonize sl (** [targets_of_field] - * Returns the targets of a makefile node in modules - * Default "ap|sim" *) + * Returns the targets of a makefile node in modules + * Default "ap|sim" *) let pipe_regexp = Str.regexp "|" let targets_of_field = fun field default -> try Str.split pipe_regexp (ExtXml.attrib_or_default field "target" default) with - _ -> [] + _ -> [] (** [get_autopilot_of_airframe xml] - * Returns (autopilot xml, main freq) from airframe xml file *) + * Returns (autopilot xml, main freq) from airframe xml file *) let get_autopilot_of_airframe = fun xml -> (* extract all "modules" sections *) let section = List.filter (fun s -> compare (Xml.tag s) "autopilot" = 0) (Xml.children xml) in (* Raise error if more than one modules section *) match section with - [autopilot] -> - let freq = try int_of_string (Xml.attrib autopilot "freq") with _ -> default_freq in - let ap = try Xml.attrib autopilot "name" with _ -> raise Not_found in - (autopilot_dir // ap, freq) - | [] -> raise Not_found - | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file" + [autopilot] -> + let freq = try int_of_string (Xml.attrib autopilot "freq") with _ -> default_freq in + let ap = try Xml.attrib autopilot "name" with _ -> raise Not_found in + (autopilot_dir // ap, freq) + | [] -> raise Not_found + | _ -> failwith "Error: you have more than one 'autopilot' section in your airframe file" (** [get_modules_of_airframe xml] - * Returns a list of module configuration from airframe file *) + * Returns a list of module configuration from airframe file *) let rec get_modules_of_airframe = fun xml -> (* extract all "modules" sections *) let section = List.filter (fun s -> compare (Xml.tag s) "modules" = 0) (Xml.children xml) in (* get autopilot file if any *) let ap_file = try - let (ap, _) = get_autopilot_of_airframe xml in - ap - with _ -> "" in + let (ap, _) = get_autopilot_of_airframe xml in + ap + with _ -> "" in (* Raise error if more than one modules section *) match section with - [modules] -> + [modules] -> (* if only one section, returns a list of configuration *) - let t_global = targets_of_field modules "" in - let get_module = fun m t -> - let file = modules_dir // ExtXml.attrib m "name" in - let targets = singletonize (t @ targets_of_field m "") in - { xml = ExtXml.parse_file file; file = file; param = Xml.children m; extra_targets = targets } - in - let modules_list = List.map (fun m -> - if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load"; - get_module m t_global - ) (Xml.children modules) in - let ap_modules = try - get_modules_of_airframe (ExtXml.parse_file ap_file) - with _ -> [] in - modules_list @ ap_modules - | [] -> [] - | _ -> failwith "Error: you have more than one 'modules' section in your airframe file" + let t_global = targets_of_field modules "" in + let get_module = fun m t -> + let file = modules_dir // ExtXml.attrib m "name" in + let targets = singletonize (t @ targets_of_field m "") in + { xml = ExtXml.parse_file file; file = file; param = Xml.children m; extra_targets = targets } + in + let modules_list = List.map (fun m -> + if compare (Xml.tag m) "load" <> 0 then Xml2h.xml_error "load"; + get_module m t_global + ) (Xml.children modules) in + let ap_modules = try + get_modules_of_airframe (ExtXml.parse_file ap_file) + with _ -> [] in + modules_list @ ap_modules + | [] -> [] + | _ -> failwith "Error: you have more than one 'modules' section in your airframe file" (** [get_targets_of_module xml] - * Returns the list of targets of a module *) + * Returns the list of targets of a module *) let get_targets_of_module = fun conf -> let targets = List.map (fun x -> match String.lowercase (Xml.tag x) with - "makefile" -> targets_of_field x default_module_targets - | _ -> [] + "makefile" -> targets_of_field x default_module_targets + | _ -> [] ) (Xml.children conf.xml) in let targets = (List.flatten targets) @ conf.extra_targets in (* return a singletonized list *) singletonize (List.sort compare targets) (** [unload_unused_modules modules ?print_error] - * Returns a list of [modules] where unused modules are removed - * If [print_error] is true, a warning is printed *) + * Returns a list of [modules] where unused modules are removed + * If [print_error] is true, a warning is printed *) let unload_unused_modules = fun modules print_error -> let target = try Sys.getenv "TARGET" with _ -> "" in let is_target_in_module = fun m -> @@ -139,7 +139,7 @@ let unload_unused_modules = fun modules print_error -> List.find_all is_target_in_module modules (** [get_modules_name xml] - * Returns a list of loaded modules' name *) + * Returns a list of loaded modules' name *) let get_modules_name = fun xml -> (* extract all "modules" sections *) let modules = get_modules_of_airframe xml in @@ -149,7 +149,7 @@ let get_modules_name = fun xml -> List.map (fun m -> ExtXml.attrib m.xml "name") modules (** [get_modules_dir xml] - * Returns the list of modules directories *) + * Returns the list of modules directories *) let get_modules_dir = fun modules -> let dir = List.map (fun m -> try Xml.attrib m.xml "dir" with _ -> ExtXml.attrib m.xml "name") modules in singletonize (List.sort compare dir) diff --git a/sw/tools/gen_flight_plan.ml b/sw/tools/gen_flight_plan.ml index ecc2d66cd4..cdcdad33ac 100644 --- a/sw/tools/gen_flight_plan.ml +++ b/sw/tools/gen_flight_plan.ml @@ -48,11 +48,11 @@ let parse = fun s -> exit 1 in begin try - Expr_syntax.check_expression e + Expr_syntax.check_expression e with - Expr_syntax.Unknown_operator x -> unexpected "operator" x - | Expr_syntax.Unknown_ident x -> unexpected "ident" x - | Expr_syntax.Unknown_function x -> unexpected "function" x + Expr_syntax.Unknown_operator x -> unexpected "operator" x + | Expr_syntax.Unknown_ident x -> unexpected "ident" x + | Expr_syntax.Unknown_function x -> unexpected "function" x end end; Expr_syntax.sprint e @@ -80,8 +80,8 @@ let float_attrib = fun xml a -> try float_of_string (Xml.attrib xml a) with - Failure "float_of_string" -> - failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml)) + Failure "float_of_string" -> + failwith (sprintf "Float expected in attribute '%s' from %s" a (Xml.to_string_fmt xml)) let name_of = fun wp -> ExtXml.attrib wp "name" @@ -99,14 +99,14 @@ let localize_waypoint = fun rel_utm_of_wgs84 waypoint -> try let (x, y) = rel_utm_of_wgs84 - (Latlong.make_geo_deg - (Latlong.deg_of_string (Xml.attrib waypoint "lat")) - (Latlong.deg_of_string (Xml.attrib waypoint "lon"))) in + (Latlong.make_geo_deg + (Latlong.deg_of_string (Xml.attrib waypoint "lat")) + (Latlong.deg_of_string (Xml.attrib waypoint "lon"))) in let x = sprintf "%.2f" x and y = sprintf "%.2f" y in ExtXml.subst_attrib "y" y (ExtXml.subst_attrib "x" x waypoint) with - Xml.No_attribute "lat" | Xml.No_attribute "lon" -> - waypoint + Xml.No_attribute "lat" | Xml.No_attribute "lon" -> + waypoint let print_waypoint = fun default_alt waypoint -> @@ -132,7 +132,7 @@ let get_index_block = fun x -> try List.assoc x !index_of_blocks with - Not_found -> failwith (sprintf "Unknown block: '%s'" x) + Not_found -> failwith (sprintf "Unknown block: '%s'" x) let print_exception = fun x -> let i = get_index_block (ExtXml.attrib x "deroute") in @@ -152,16 +152,16 @@ let get_index_waypoint = fun x l -> try string_of_int (List.assoc x l) with - Not_found -> failwith (sprintf "Unknown waypoint: %s" x) + Not_found -> failwith (sprintf "Unknown waypoint: %s" x) let pprz_throttle = fun s -> begin try let g = float_of_string s in if g < 0. || g > 1. then - failwith "throttle must be > 0 and < 1" + failwith "throttle must be > 0 and < 1" with - Failure "float_of_string" -> () (* No possible check on expression *) + Failure "float_of_string" -> () (* No possible check on expression *) end; sprintf "9600*(%s)" s @@ -178,44 +178,44 @@ let output_vmode = fun stage_xml wp last_wp -> let vmode = try ExtXml.attrib stage_xml "vmode" with _ -> "alt" in begin match vmode with - "climb" -> - lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") - | "alt" -> - let alt = - try - let a = parsed_attrib stage_xml "alt" in - begin + "climb" -> + lprintf "NavVerticalClimbMode(%s);\n" (parsed_attrib stage_xml "climb") + | "alt" -> + let alt = try - check_altitude (float_of_string a) stage_xml - with + let a = parsed_attrib stage_xml "alt" in + begin + try + check_altitude (float_of_string a) stage_xml + with (* Impossible to check the altitude on an expression: *) - Failure "float_of_string" -> () - end; - a - with _ -> - try - let h = parsed_attrib stage_xml "height" in - begin - try - check_altitude ((float_of_string h) +. !ground_alt) stage_xml - with + Failure "float_of_string" -> () + end; + a + with _ -> + try + let h = parsed_attrib stage_xml "height" in + begin + try + check_altitude ((float_of_string h) +. !ground_alt) stage_xml + with (* Impossible to check the altitude on an expression: *) - Failure "float_of_string" -> () - end; - sprintf "Height(%s)" h - with _ -> - if wp = "" - then failwith "alt or waypoint required in alt vmode" - else sprintf "WaypointAlt(%s)" wp in - lprintf "NavVerticalAltitudeMode(%s, 0.);\n" alt; - | "xyz" -> () (** Handled in Goto3D() *) - | "glide" -> - lprintf "NavGlide(%s, %s);\n" last_wp wp - | "throttle" -> - if (pitch = "auto") then - failwith "auto pich mode not compatible with vmode=throttle"; - lprintf "NavVerticalThrottleMode(%s);\n" (pprz_throttle (parsed_attrib stage_xml "throttle")) - | x -> failwith (sprintf "Unknown vmode '%s'" x) + Failure "float_of_string" -> () + end; + sprintf "Height(%s)" h + with _ -> + if wp = "" + then failwith "alt or waypoint required in alt vmode" + else sprintf "WaypointAlt(%s)" wp in + lprintf "NavVerticalAltitudeMode(%s, 0.);\n" alt; + | "xyz" -> () (** Handled in Goto3D() *) + | "glide" -> + lprintf "NavGlide(%s, %s);\n" last_wp wp + | "throttle" -> + if (pitch = "auto") then + failwith "auto pich mode not compatible with vmode=throttle"; + lprintf "NavVerticalThrottleMode(%s);\n" (pprz_throttle (parsed_attrib stage_xml "throttle")) + | x -> failwith (sprintf "Unknown vmode '%s'" x) end; vmode @@ -225,16 +225,16 @@ let output_hmode x wp last_wp = let hmode = ExtXml.attrib x "hmode" in begin match hmode with - "route" -> - if last_wp = "last_wp" then - fprintf stderr "Warning: Deprecated use of 'route' using last waypoint in %s\n"(Xml.to_string x); - lprintf "NavSegment(%s, %s);\n" last_wp wp - | "direct" -> lprintf "NavGotoWaypoint(%s);\n" wp - | x -> failwith (sprintf "Unknown hmode '%s'" x) + "route" -> + if last_wp = "last_wp" then + fprintf stderr "Warning: Deprecated use of 'route' using last waypoint in %s\n"(Xml.to_string x); + lprintf "NavSegment(%s, %s);\n" last_wp wp + | "direct" -> lprintf "NavGotoWaypoint(%s);\n" wp + | x -> failwith (sprintf "Unknown hmode '%s'" x) end; hmode with - ExtXml.Error _ -> lprintf "NavGotoWaypoint(%s);\n" wp; "direct" (* Default behaviour *) + ExtXml.Error _ -> lprintf "NavGotoWaypoint(%s);\n" wp; "direct" (* Default behaviour *) @@ -242,29 +242,29 @@ let output_hmode x wp last_wp = let rec index_stage = fun x -> begin match Xml.tag x with - "for" -> - incr stage; (* Init of i *) - incr stage; - let n = !stage in - let l = List.map index_stage (Xml.children x) in - incr stage; (* To count the loop stage *) - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) - | "while" -> - incr stage; - let n = !stage in - let l = List.map index_stage (Xml.children x) in - incr stage; (* To count the loop stage *) - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) - | "return" | "goto" | "deroute" | "exit_block" | "follow" | "call" | "home" - | "heading" | "attitude" | "go" | "stay" | "xyz" | "set" | "circle" -> - incr stage; - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) - | "survey_rectangle" | "eight" | "oval"-> - incr stage; incr stage; - Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) - | "exception" -> - x - | s -> failwith (sprintf "Unknown stage: %s\n" s) + "for" -> + incr stage; (* Init of i *) + incr stage; + let n = !stage in + let l = List.map index_stage (Xml.children x) in + incr stage; (* To count the loop stage *) + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) + | "while" -> + incr stage; + let n = !stage in + let l = List.map index_stage (Xml.children x) in + incr stage; (* To count the loop stage *) + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi n], l) + | "return" | "goto" | "deroute" | "exit_block" | "follow" | "call" | "home" + | "heading" | "attitude" | "go" | "stay" | "xyz" | "set" | "circle" -> + incr stage; + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) + | "survey_rectangle" | "eight" | "oval"-> + incr stage; incr stage; + Xml.Element (Xml.tag x, Xml.attribs x@["no", soi !stage], Xml.children x) + | "exception" -> + x + | s -> failwith (sprintf "Unknown stage: %s\n" s) end @@ -274,229 +274,229 @@ let rec print_stage = fun index_of_waypoints x -> let stage () = incr stage;lprintf "Stage(%d)\n" !stage; right () in begin match String.lowercase (Xml.tag x) with - "return" -> - stage (); - lprintf "Return()\n"; - lprintf "break\n"; - | "goto" -> - stage (); - lprintf "Goto(%s)\n" (name_of x) - | "deroute" -> - stage (); - lprintf "GotoBlock(%d);\n" (get_index_block (ExtXml.attrib x "block")); - lprintf "break;\n" - | "exit_block" -> - lprintf "default:\n"; - stage (); - lprintf "NextBlock();\n"; - lprintf "break;\n" - | "while" -> - let w = gen_label "while" in - let e = gen_label "endwhile" in - output_label w; - stage (); - let c = try parsed_attrib x "cond" with _ -> "TRUE" in - lprintf "if (! (%s)) Goto(%s) else NextStageAndBreak();\n" c e; - List.iter (print_stage index_of_waypoints) (Xml.children x); - print_stage index_of_waypoints (goto w); - output_label e - | "for" -> - let f = gen_label "for" in - let e = gen_label "endfor" in - let v = Expr_syntax.c_var_of_ident (ExtXml.attrib x "var") - and from_ = parsed_attrib x "from" - and to_expr = parsed_attrib x "to" in - let to_var = v ^ "_to" in - lprintf "static int8_t %s;\n" v; - lprintf "static int8_t %s;\n" to_var; + "return" -> + stage (); + lprintf "Return()\n"; + lprintf "break\n"; + | "goto" -> + stage (); + lprintf "Goto(%s)\n" (name_of x) + | "deroute" -> + stage (); + lprintf "GotoBlock(%d);\n" (get_index_block (ExtXml.attrib x "block")); + lprintf "break;\n" + | "exit_block" -> + lprintf "default:\n"; + stage (); + lprintf "NextBlock();\n"; + lprintf "break;\n" + | "while" -> + let w = gen_label "while" in + let e = gen_label "endwhile" in + output_label w; + stage (); + let c = try parsed_attrib x "cond" with _ -> "TRUE" in + lprintf "if (! (%s)) Goto(%s) else NextStageAndBreak();\n" c e; + List.iter (print_stage index_of_waypoints) (Xml.children x); + print_stage index_of_waypoints (goto w); + output_label e + | "for" -> + let f = gen_label "for" in + let e = gen_label "endfor" in + let v = Expr_syntax.c_var_of_ident (ExtXml.attrib x "var") + and from_ = parsed_attrib x "from" + and to_expr = parsed_attrib x "to" in + let to_var = v ^ "_to" in + lprintf "static int8_t %s;\n" v; + lprintf "static int8_t %s;\n" to_var; (* init *) - stage (); - lprintf "%s = %s - 1;\n" v from_; - lprintf "%s = %s;\n" to_var to_expr; - left (); + stage (); + lprintf "%s = %s - 1;\n" v from_; + lprintf "%s = %s;\n" to_var to_expr; + left (); - output_label f; - stage (); - lprintf "if (++%s > %s) Goto(%s) else NextStageAndBreak();\n" v to_var e; - List.iter (print_stage index_of_waypoints) (Xml.children x); - print_stage index_of_waypoints (goto f); - output_label e - | "heading" -> - stage (); - let until = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak() else {\n" until; - right (); - lprintf "NavHeading(RadOfDeg(%s));\n" (parsed_attrib x "course"); - ignore (output_vmode x "" ""); - left (); lprintf "}\n"; - lprintf "break;\n" - | "follow" -> - stage (); - let id = ExtXml.attrib x "ac_id" - and d = ExtXml.attrib x "distance" - and h = ExtXml.attrib x "height" in - lprintf "NavFollow(%s, %s, %s);\n" id d h; - lprintf "break;\n" - | "attitude" -> - stage (); - begin - try + output_label f; + stage (); + lprintf "if (++%s > %s) Goto(%s) else NextStageAndBreak();\n" v to_var e; + List.iter (print_stage index_of_waypoints) (Xml.children x); + print_stage index_of_waypoints (goto f); + output_label e + | "heading" -> + stage (); let until = parsed_attrib x "until" in lprintf "if (%s) NextStageAndBreak() else {\n" until; - with ExtXml.Error _ -> - lprintf "{\n" - end; - right (); - lprintf "NavAttitude(RadOfDeg(%s));\n" (parsed_attrib x "roll"); - ignore (output_vmode x "" ""); - left (); lprintf "}\n"; - lprintf "break;\n" - | "go" -> - stage (); - let wp = - try - get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints - with - ExtXml.Error _ -> - lprintf "waypoints[0].x = %s;\n" (parsed_attrib x "x"); - lprintf "waypoints[0].y = %s;\n" (parsed_attrib x "y"); - "0" - in - let at = try ExtXml.attrib x "approaching_time" with _ -> "CARROT" in - let last_wp = - try - get_index_waypoint (ExtXml.attrib x "from") index_of_waypoints - with ExtXml.Error _ -> "last_wp" in - if last_wp = "last_wp" then - lprintf "if (NavApproaching(%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp at wp - else - lprintf "if (NavApproachingFrom(%s,%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp last_wp at wp; - right (); - let hmode = output_hmode x wp last_wp in - let vmode = output_vmode x wp last_wp in - if vmode = "glide" && hmode <> "route" then - failwith "glide vmode requires route hmode"; - left (); lprintf "}\n"; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "stay" -> - stage (); - begin - try + right (); + lprintf "NavHeading(RadOfDeg(%s));\n" (parsed_attrib x "course"); + ignore (output_vmode x "" ""); + left (); lprintf "}\n"; + lprintf "break;\n" + | "follow" -> + stage (); + let id = ExtXml.attrib x "ac_id" + and d = ExtXml.attrib x "distance" + and h = ExtXml.attrib x "height" in + lprintf "NavFollow(%s, %s, %s);\n" id d h; + lprintf "break;\n" + | "attitude" -> + stage (); + begin + try + let until = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak() else {\n" until; + with ExtXml.Error _ -> + lprintf "{\n" + end; + right (); + lprintf "NavAttitude(RadOfDeg(%s));\n" (parsed_attrib x "roll"); + ignore (output_vmode x "" ""); + left (); lprintf "}\n"; + lprintf "break;\n" + | "go" -> + stage (); + let wp = + try + get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints + with + ExtXml.Error _ -> + lprintf "waypoints[0].x = %s;\n" (parsed_attrib x "x"); + lprintf "waypoints[0].y = %s;\n" (parsed_attrib x "y"); + "0" + in + let at = try ExtXml.attrib x "approaching_time" with _ -> "CARROT" in + let last_wp = + try + get_index_waypoint (ExtXml.attrib x "from") index_of_waypoints + with ExtXml.Error _ -> "last_wp" in + if last_wp = "last_wp" then + lprintf "if (NavApproaching(%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp at wp + else + lprintf "if (NavApproachingFrom(%s,%s,%s)) NextStageAndBreakFrom(%s) else {\n" wp last_wp at wp; + right (); + let hmode = output_hmode x wp last_wp in + let vmode = output_vmode x wp last_wp in + if vmode = "glide" && hmode <> "route" then + failwith "glide vmode requires route hmode"; + left (); lprintf "}\n"; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" + | "stay" -> + stage (); + begin + try + let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in + ignore (output_hmode x wp ""); + ignore (output_vmode x wp ""); + with + Xml2h.Error _ -> + lprintf "NavGotoXY(last_x, last_y);\n"; + ignore(output_vmode x "" "") + end; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" + | "xyz" -> + stage (); + let r = try parsed_attrib x "radius" with _ -> "100" in + lprintf "Goto3D(%s)\n" r; + let x = ExtXml.subst_attrib "vmode" "xyz" x in + ignore (output_vmode x "" ""); (** To handle "pitch" *) + lprintf "break;\n" + | "home" -> + stage (); + lprintf "nav_home();\n"; + lprintf "break;\n" + | "circle" -> + stage (); let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in - ignore (output_hmode x wp ""); - ignore (output_vmode x wp ""); - with - Xml2h.Error _ -> - lprintf "NavGotoXY(last_x, last_y);\n"; - ignore(output_vmode x "" "") - end; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "xyz" -> - stage (); - let r = try parsed_attrib x "radius" with _ -> "100" in - lprintf "Goto3D(%s)\n" r; - let x = ExtXml.subst_attrib "vmode" "xyz" x in - ignore (output_vmode x "" ""); (** To handle "pitch" *) - lprintf "break;\n" - | "home" -> - stage (); - lprintf "nav_home();\n"; - lprintf "break;\n" - | "circle" -> - stage (); - let wp = get_index_waypoint (ExtXml.attrib x "wp") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x wp "" in - lprintf "NavCircleWaypoint(%s, %s);\n" wp r; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "eight" -> - stage (); - lprintf "nav_eight_init();\n"; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - let center = get_index_waypoint (ExtXml.attrib x "center") index_of_waypoints - and turn_about = get_index_waypoint (ExtXml.attrib x "turn_around") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x center "" in - lprintf "Eight(%s, %s, %s);\n" center turn_about r; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "oval" -> - stage (); - lprintf "nav_oval_init();\n"; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - let p1 = get_index_waypoint (ExtXml.attrib x "p1") index_of_waypoints - and p2 = get_index_waypoint (ExtXml.attrib x "p2") index_of_waypoints in - let r = parsed_attrib x "radius" in - let _vmode = output_vmode x p1 "" in - lprintf "Oval(%s, %s, %s);\n" p1 p2 r; - begin - try - let c = parsed_attrib x "until" in - lprintf "if (%s) NextStageAndBreak();\n" c - with - ExtXml.Error _ -> () - end; - lprintf "break;\n" - | "set" -> - stage (); - let var = ExtXml.attrib x "var" - and value = parsed_attrib x "value" in - lprintf "%s = %s;\n" var value; - lprintf "NextStageAndBreak();\n"; - lprintf "break;\n" - | "call" -> - stage (); - let statement = ExtXml.attrib x "fun" in - lprintf "if (! (%s))\n" statement; - lprintf " NextStageAndBreak();\n"; - lprintf "break;\n" - | "survey_rectangle" -> - let grid = parsed_attrib x "grid" - and wp1 = get_index_waypoint (ExtXml.attrib x "wp1") index_of_waypoints - and wp2 = get_index_waypoint (ExtXml.attrib x "wp2") index_of_waypoints - and orientation = ExtXml.attrib_or_default x "orientation" "NS" in - stage (); - if orientation <> "NS" && orientation <> "WE" then - failwith (sprintf "Unknown survey orientation (NS or WE): %s" orientation); - lprintf "NavSurveyRectangleInit(%s, %s, %s, %s);\n" wp1 wp2 grid orientation; - lprintf "NextStageAndBreak();\n"; - left (); - stage (); - lprintf "NavSurveyRectangle(%s, %s);\n" wp1 wp2; - lprintf "break;\n" - | _s -> failwith "Unreachable" + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x wp "" in + lprintf "NavCircleWaypoint(%s, %s);\n" wp r; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" + | "eight" -> + stage (); + lprintf "nav_eight_init();\n"; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + let center = get_index_waypoint (ExtXml.attrib x "center") index_of_waypoints + and turn_about = get_index_waypoint (ExtXml.attrib x "turn_around") index_of_waypoints in + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x center "" in + lprintf "Eight(%s, %s, %s);\n" center turn_about r; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" + | "oval" -> + stage (); + lprintf "nav_oval_init();\n"; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + let p1 = get_index_waypoint (ExtXml.attrib x "p1") index_of_waypoints + and p2 = get_index_waypoint (ExtXml.attrib x "p2") index_of_waypoints in + let r = parsed_attrib x "radius" in + let _vmode = output_vmode x p1 "" in + lprintf "Oval(%s, %s, %s);\n" p1 p2 r; + begin + try + let c = parsed_attrib x "until" in + lprintf "if (%s) NextStageAndBreak();\n" c + with + ExtXml.Error _ -> () + end; + lprintf "break;\n" + | "set" -> + stage (); + let var = ExtXml.attrib x "var" + and value = parsed_attrib x "value" in + lprintf "%s = %s;\n" var value; + lprintf "NextStageAndBreak();\n"; + lprintf "break;\n" + | "call" -> + stage (); + let statement = ExtXml.attrib x "fun" in + lprintf "if (! (%s))\n" statement; + lprintf " NextStageAndBreak();\n"; + lprintf "break;\n" + | "survey_rectangle" -> + let grid = parsed_attrib x "grid" + and wp1 = get_index_waypoint (ExtXml.attrib x "wp1") index_of_waypoints + and wp2 = get_index_waypoint (ExtXml.attrib x "wp2") index_of_waypoints + and orientation = ExtXml.attrib_or_default x "orientation" "NS" in + stage (); + if orientation <> "NS" && orientation <> "WE" then + failwith (sprintf "Unknown survey orientation (NS or WE): %s" orientation); + lprintf "NavSurveyRectangleInit(%s, %s, %s, %s);\n" wp1 wp2 grid orientation; + lprintf "NextStageAndBreak();\n"; + left (); + stage (); + lprintf "NavSurveyRectangle(%s, %s);\n" wp1 wp2; + lprintf "break;\n" + | _s -> failwith "Unreachable" end; left () @@ -508,16 +508,16 @@ let indexed_stages = fun blocks -> let block_name = name_of b and block_no = ExtXml.attrib b "no" in let rec f = fun stage -> - try - let stage_no = Xml.attrib stage "no" in - lstages := - Xml.Element ("stage", [ "block", block_no; - "block_name", block_name; - "stage", stage_no], [stage]):: !lstages; - if (ExtXml.tag_is stage "for" || ExtXml.tag_is stage "while") then - List.iter f (Xml.children stage) - with Xml.No_attribute "no" -> - assert (ExtXml.tag_is stage "exception") + try + let stage_no = Xml.attrib stage "no" in + lstages := + Xml.Element ("stage", [ "block", block_no; + "block_name", block_name; + "stage", stage_no], [stage]):: !lstages; + if (ExtXml.tag_is stage "for" || ExtXml.tag_is stage "while") then + List.iter f (Xml.children stage) + with Xml.No_attribute "no" -> + assert (ExtXml.tag_is stage "exception") in List.iter f (Xml.children b)) blocks; @@ -531,14 +531,14 @@ let index_blocks = fun xml -> let indexed_blocks = List.map (fun b -> - incr block; - let name = name_of b in - if List.mem_assoc name !index_of_blocks then - failwith (Printf.sprintf "Error in flight plan: Block '%s' defined twice" name); - index_of_blocks := (name, !block) :: !index_of_blocks; - stage := -1; - let indexed_stages = List.map index_stage (Xml.children b) in - Xml.Element (Xml.tag b, Xml.attribs b@["no", soi !block], indexed_stages)) + incr block; + let name = name_of b in + if List.mem_assoc name !index_of_blocks then + failwith (Printf.sprintf "Error in flight plan: Block '%s' defined twice" name); + index_of_blocks := (name, !block) :: !index_of_blocks; + stage := -1; + let indexed_stages = List.map index_stage (Xml.children b) in + Xml.Element (Xml.tag b, Xml.attribs b@["no", soi !block], indexed_stages)) (Xml.children xml) in Xml.Element (Xml.tag xml, Xml.attribs xml, indexed_blocks) @@ -590,12 +590,12 @@ let define_waypoints_indices = fun wpts -> let home = fun waypoints -> let rec loop i = function - [] -> failwith "Waypoint 'HOME' required" + [] -> failwith "Waypoint 'HOME' required" | w::ws -> - if name_of w = "HOME" then - (float_attrib w "x", float_attrib w "y") - else - loop (i+1) ws in + if name_of w = "HOME" then + (float_attrib w "x", float_attrib w "y") + else + loop (i+1) ws in loop 0 waypoints @@ -628,10 +628,10 @@ let check_geo_ref = fun wgs84 xml -> let dummy_waypoint = Xml.Element ("waypoint", - ["name", "dummy"; - "x", "42."; - "y", "42." ], - []) + ["name", "dummy"; + "x", "42."; + "y", "42." ], + []) @@ -641,12 +641,12 @@ let print_inside_polygon = fun pts -> if i = j then let {G2D.top=yl; left_side=(xg, ag); right_side=(xd, ad)} = layers.(i) in if xg > xd then begin - lprintf "return FALSE;\n" + lprintf "return FALSE;\n" end else begin - if ad <> 0. || ag <> 0. then - lprintf "float dy = _y - %.1f;\n" yl; - let dy_times = fun f -> if f = 0. then "" else sprintf "+dy*%f" f in - lprintf "return (%.1f%s<= _x && _x <= %.1f%s);\n" xg (dy_times ag) xd (dy_times ad) + if ad <> 0. || ag <> 0. then + lprintf "float dy = _y - %.1f;\n" yl; + let dy_times = fun f -> if f = 0. then "" else sprintf "+dy*%f" f in + lprintf "return (%.1f%s<= _x && _x <= %.1f%s);\n" xg (dy_times ag) xd (dy_times ad) end else let ij2 = (i+j) / 2 in @@ -679,7 +679,7 @@ let parse_wpt_sector = fun waypoints xml -> and y = float_attrib wp "y" in {G2D.x2D = x; G2D.y2D = y } with - Not_found -> failwith (sprintf "Error: corner '%s' of sector '%s' not found" name sector_name) + Not_found -> failwith (sprintf "Error: corner '%s' of sector '%s' not found" name sector_name) in (sector_name, List.map p2D_of (Xml.children xml)) @@ -689,7 +689,7 @@ let () = let xml_file = ref "fligh_plan.xml" and dump = ref false in Arg.parse [ ("-check", Arg.Set check_expressions, "Enable expression checking"); - ("-dump", Arg.Set dump, "Dump compile result") ] + ("-dump", Arg.Set dump, "Dump compile result") ] (fun f -> xml_file := f) "Usage:"; if !xml_file = "" then @@ -739,10 +739,10 @@ let () = printf "#include \"generated/modules.h\"\n"; begin - try - let header = ExtXml.child (ExtXml.child xml "header") "0" in - printf "%s\n" (Xml.pcdata header) - with _ -> () + try + let header = ExtXml.child (ExtXml.child xml "header") "0" in + printf "%s\n" (Xml.pcdata header) + with _ -> () end; let name = ExtXml.attrib xml "name" in @@ -756,8 +756,8 @@ let () = security_height := get_float "security_height"; ground_alt := get_float "ground_alt"; let home_mode_height = try - max (get_float "home_mode_height") !security_height - with _ -> !security_height in + max (get_float "home_mode_height") !security_height + with _ -> !security_height in check_altitude (float_of_string alt) xml; @@ -795,8 +795,8 @@ let () = Xml2h.define "MAX_DIST_FROM_HOME" (sof mdfh); let index_of_waypoints = - let i = ref (-1) in - List.map (fun w -> incr i; (name_of w, !i)) waypoints in + let i = ref (-1) in + List.map (fun w -> incr i; (name_of w, !i)) waypoints in let sectors_element = try ExtXml.child xml "sectors" with Not_found -> Xml.Element ("", [], []) in let sectors = List.filter (fun x -> String.lowercase (Xml.tag x) = "sector") (Xml.children sectors_element) in @@ -822,11 +822,11 @@ let () = let airspace = Xml.attrib xml "airspace" in lprintf "#define InAirspace(_x, _y) %s(_x, _y)\n" (inside_function airspace) with - _ -> () + _ -> () end; Xml2h.finish h_name end with - Failure x -> - fprintf stderr "%s: %s\n" !xml_file x; exit 1 + Failure x -> + fprintf stderr "%s: %s\n" !xml_file x; exit 1 diff --git a/sw/tools/gen_messages.ml b/sw/tools/gen_messages.ml index 3318a4a7d7..b6ab00f2d5 100644 --- a/sw/tools/gen_messages.ml +++ b/sw/tools/gen_messages.ml @@ -35,11 +35,11 @@ type field = _type * string * format option type fields = field list type message = { - name : string; - id : int; - period : float option; - fields : fields - } + name : string; + id : int; + period : float option; + fields : fields +} module Syntax = struct (** Parse a type name and returns a _type value *) @@ -56,15 +56,15 @@ module Syntax = struct try List.assoc t Pprz.types with - Not_found -> - failwith (sprintf "Error: '%s' unknown type" t) + Not_found -> + failwith (sprintf "Error: '%s' unknown type" t) let rec sizeof = function - Basic t -> string_of_int (assoc_types t).Pprz.size + Basic t -> string_of_int (assoc_types t).Pprz.size | Array (t, varname) -> sprintf "1+%s*%s" (length_name varname) (sizeof (Basic t)) let rec nameof = function - Basic t -> String.capitalize t + Basic t -> String.capitalize t | Array _ -> failwith "nameof" (** Translates a "message" XML element into a value of the 'message' type *) @@ -74,13 +74,13 @@ module Syntax = struct and period = try Some (ExtXml.float_attrib xml "period") with _ -> None and fields = List.map - (fun field -> - let id = ExtXml.attrib field "name" - and type_name = ExtXml.attrib field "type" - and fmt = try Some (Xml.attrib field "format") with _ -> None in - let _type = parse_type type_name id in - (_type, id, fmt)) - (Xml.children xml) in + (fun field -> + let id = ExtXml.attrib field "name" + and type_name = ExtXml.attrib field "type" + and fmt = try Some (Xml.attrib field "format") with _ -> None in + let _type = parse_type type_name id in + (_type, id, fmt)) + (Xml.children xml) in { id=id; name = name; period = period; fields = fields } let check_single_ids = fun msgs -> @@ -104,7 +104,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -112,43 +112,43 @@ end (* module Suntax *) module Gen_onboard = struct let print_field = fun h (t, name, (_f: format option)) -> match t with - Basic _ -> - fprintf h "\t DownlinkPut%sByAddr(_trans, _dev, (%s)); \\\n" (Syntax.nameof t) name - | Array (t, varname) -> - let _s = Syntax.sizeof (Basic t) in - fprintf h "\t DownlinkPut%sArray(_trans, _dev, %s, %s); \\\n" (Syntax.nameof (Basic t)) (Syntax.length_name varname) name + Basic _ -> + fprintf h "\t DownlinkPut%sByAddr(_trans, _dev, (%s)); \\\n" (Syntax.nameof t) name + | Array (t, varname) -> + let _s = Syntax.sizeof (Basic t) in + fprintf h "\t DownlinkPut%sArray(_trans, _dev, %s, %s); \\\n" (Syntax.nameof (Basic t)) (Syntax.length_name varname) name let print_parameter h = function - (Array _, s, _) -> fprintf h "%s, %s" (Syntax.length_name s) s + (Array _, s, _) -> fprintf h "%s, %s" (Syntax.length_name s) s | (_, s, _) -> fprintf h "%s" s let print_macro_parameters h = function - [] -> () + [] -> () | f::fields -> - print_parameter h f; - List.iter (fun f -> fprintf h ", "; print_parameter h f) fields + print_parameter h f; + List.iter (fun f -> fprintf h ", "; print_parameter h f) fields let rec size_fields = fun fields size -> match fields with - [] -> size - | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) + [] -> size + | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) let size_of_message = fun m -> size_fields m.fields "0" let estimated_size_of_message = fun m -> try List.fold_right - (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) - m.fields - 0 + (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) + m.fields + 0 with - Failure "int_of_string" -> 0 + Failure "int_of_string" -> 0 let print_downlink_macro = fun h {name=s; fields = fields} -> if List.length fields > 0 then begin fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev, " s; end else - fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev " s; + fprintf h "#define DOWNLINK_SEND_%s(_trans, _dev " s; print_macro_parameters h fields; fprintf h "){ \\\n"; let size = (size_fields fields "0") in @@ -176,7 +176,7 @@ module Gen_onboard = struct fprintf stderr "Error: message %s has id %d but should be between 0 and 255\n" m.name m.id; exit 1; end else fprintf h "#define DL_%s %d\n" m.name m.id - ) messages; + ) messages; fprintf h "#define DL_MSG_%s_NB %d\n\n" class_ (List.length messages) (** Prints the table of the messages lengths *) @@ -195,8 +195,8 @@ module Gen_onboard = struct let sizes = List.map - (fun m -> (estimated_size_of_message m, m.name)) - messages in + (fun m -> (estimated_size_of_message m, m.name)) + messages in let sizes = List.sort (fun (s1,_) (s2,_) -> compare s2 s1) sizes in List.iter @@ -221,48 +221,48 @@ module Gen_onboard = struct (** Prints the macro for one field, using the global [offset] ref *) let parse_field = fun (_type, field_name, _format) -> if !offset < 0 then - failwith "FIXME: No field allowed after an array field (print_get_macros)"; + failwith "FIXME: No field allowed after an array field (print_get_macros)"; (** Converts bytes into the required type *) let typed = fun o pprz_type -> (* o for offset *) - let size = pprz_type.Pprz.size in - if check_alignment && o mod (min size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + let size = pprz_type.Pprz.size in + if check_alignment && o mod (min size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - match size with - 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o - | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o - | 4 when pprz_type.Pprz.inttype = "float" -> - sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o - | 8 when pprz_type.Pprz.inttype = "double" -> - let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in - for i = 1 to 7 do - s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) - done; + match size with + 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o + | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o + | 4 when pprz_type.Pprz.inttype = "float" -> + sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o + | 8 when pprz_type.Pprz.inttype = "double" -> + let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in + for i = 1 to 7 do + s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) + done; - sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s - | 4 -> - sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o - | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in + sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s + | 4 -> + sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o + | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in (** To be an array or not to be an array: *) match _type with - Basic t -> - let pprz_type = Syntax.assoc_types t in - fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); - offset := !offset + pprz_type.Pprz.size + Basic t -> + let pprz_type = Syntax.assoc_types t in + fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); + offset := !offset + pprz_type.Pprz.size - | Array (t, _varname) -> - (** The macro to access to the length of the array *) - fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); - incr offset; + | Array (t, _varname) -> + (** The macro to access to the length of the array *) + fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); + incr offset; - (** The macro to access to the array itself *) - let pprz_type = Syntax.assoc_types t in - if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + (** The macro to access to the array itself *) + let pprz_type = Syntax.assoc_types t in + if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; - offset := -1 (** Mark for no more fields *) + fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; + offset := -1 (** Mark for no more fields *) in fprintf h "\n"; @@ -307,4 +307,4 @@ let () = List.iter (Gen_onboard.print_get_macros h check_alignment) messages with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_messages2.ml b/sw/tools/gen_messages2.ml index 88dad3439d..2234059c76 100644 --- a/sw/tools/gen_messages2.ml +++ b/sw/tools/gen_messages2.ml @@ -32,38 +32,38 @@ type _type = let c_type = fun format -> match format with - "Float" -> "float" - | "Double" -> "double" - | "Int32" -> "int32_t" - | "Int16" -> "int16_t" - | "Int8" -> "int8_t" - | "Uint32" -> "uint32_t" - | "Uint16" -> "uint16_t" - | "Uint8" -> "uint8_t" - | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) + "Float" -> "float" + | "Double" -> "double" + | "Int32" -> "int32_t" + | "Int16" -> "int16_t" + | "Int8" -> "int8_t" + | "Uint32" -> "uint32_t" + | "Uint16" -> "uint16_t" + | "Uint8" -> "uint8_t" + | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) let dl_type = fun format -> match format with - "Float" -> "DL_TYPE_FLOAT" - | "Double" -> "DL_TYPE_DOUBLE" - | "Int32" -> "DL_TYPE_INT32" - | "Int16" -> "DL_TYPE_INT16" - | "Int8" -> "DL_TYPE_INT8" - | "Uint32" -> "DL_TYPE_UINT32" - | "Uint16" -> "DL_TYPE_UINT16" - | "Uint8" -> "DL_TYPE_UINT8" - | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) + "Float" -> "DL_TYPE_FLOAT" + | "Double" -> "DL_TYPE_DOUBLE" + | "Int32" -> "DL_TYPE_INT32" + | "Int16" -> "DL_TYPE_INT16" + | "Int8" -> "DL_TYPE_INT8" + | "Uint32" -> "DL_TYPE_UINT32" + | "Uint16" -> "DL_TYPE_UINT16" + | "Uint8" -> "DL_TYPE_UINT8" + | _ -> failwith (sprintf "gen_messages.c_type: unknown format '%s'" format) type field = _type * string * format option type fields = field list type message = { - name : string; - id : int; - period : float option; - fields : fields - } + name : string; + id : int; + period : float option; + fields : fields +} module Syntax = struct (** Parse a type name and returns a _type value *) @@ -80,15 +80,15 @@ module Syntax = struct try List.assoc t Pprz.types with - Not_found -> - failwith (sprintf "Error: '%s' unknown type" t) + Not_found -> + failwith (sprintf "Error: '%s' unknown type" t) let rec sizeof = function - Basic t -> string_of_int (assoc_types t).Pprz.size + Basic t -> string_of_int (assoc_types t).Pprz.size | Array (t, varname) -> sprintf "1+%s*%s" (length_name varname) (sizeof (Basic t)) let rec nameof = function - Basic t -> String.capitalize t + Basic t -> String.capitalize t | Array _ -> failwith "nameof" (** Translates a "message" XML element into a value of the 'message' type *) @@ -98,13 +98,13 @@ module Syntax = struct and period = try Some (ExtXml.float_attrib xml "period") with _ -> None and fields = List.map - (fun field -> - let id = ExtXml.attrib field "name" - and type_name = ExtXml.attrib field "type" - and fmt = try Some (Xml.attrib field "format") with _ -> None in - let _type = parse_type type_name id in - (_type, id, fmt)) - (Xml.children xml) in + (fun field -> + let id = ExtXml.attrib field "name" + and type_name = ExtXml.attrib field "type" + and fmt = try Some (Xml.attrib field "format") with _ -> None in + let _type = parse_type type_name id in + (_type, id, fmt)) + (Xml.children xml) in { id=id; name = name; period = period; fields = fields } let check_single_ids = fun msgs -> @@ -128,7 +128,7 @@ module Syntax = struct check_single_ids msgs; msgs with - Not_found -> failwith (sprintf "No class '%s' found" class_) + Not_found -> failwith (sprintf "No class '%s' found" class_) end (* module Suntax *) @@ -136,44 +136,44 @@ end (* module Suntax *) module Gen_onboard = struct let print_field = fun h (t, name, (_f: format option)) -> match t with - Basic _ -> - fprintf h "\t tp->PutBytes(tp->impl, %s, %s, (void *) _%s); \n" (dl_type (Syntax.nameof t)) (Syntax.sizeof t) name - | Array (t, varname) -> - let _s = Syntax.sizeof (Basic t) in - fprintf h "\t tp->PutBytes(tp->impl, DL_TYPE_ARRAY_LENGTH, 1, (void *) &%s); \n" (Syntax.length_name varname); - fprintf h "\t tp->PutBytes(tp->impl, %s, %s * %s, (void *) _%s); \n" (dl_type (Syntax.nameof (Basic t))) (Syntax.sizeof (Basic t)) (Syntax.length_name varname) name + Basic _ -> + fprintf h "\t tp->PutBytes(tp->impl, %s, %s, (void *) _%s); \n" (dl_type (Syntax.nameof t)) (Syntax.sizeof t) name + | Array (t, varname) -> + let _s = Syntax.sizeof (Basic t) in + fprintf h "\t tp->PutBytes(tp->impl, DL_TYPE_ARRAY_LENGTH, 1, (void *) &%s); \n" (Syntax.length_name varname); + fprintf h "\t tp->PutBytes(tp->impl, %s, %s * %s, (void *) _%s); \n" (dl_type (Syntax.nameof (Basic t))) (Syntax.sizeof (Basic t)) (Syntax.length_name varname) name let print_parameter h = function - (Array (t, varname), s, _) -> fprintf h "uint8_t %s, %s *_%s" (Syntax.length_name s) (c_type (Syntax.nameof (Basic t))) s + (Array (t, varname), s, _) -> fprintf h "uint8_t %s, %s *_%s" (Syntax.length_name s) (c_type (Syntax.nameof (Basic t))) s | (t, s, _) -> fprintf h "%s *_%s" (c_type (Syntax.nameof t)) s let print_macro_parameters h = function - [] -> () + [] -> () | f::fields -> - print_parameter h f; - List.iter (fun f -> fprintf h ", "; print_parameter h f) fields + print_parameter h f; + List.iter (fun f -> fprintf h ", "; print_parameter h f) fields let rec size_fields = fun fields size -> match fields with - [] -> size - | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) + [] -> size + | (t, _, _)::fields -> size_fields fields (size ^"+"^Syntax.sizeof t) let size_of_message = fun m -> size_fields m.fields "0" let estimated_size_of_message = fun m -> try List.fold_right - (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) - m.fields - 0 + (fun (t, _, _) r -> int_of_string (Syntax.sizeof t)+r) + m.fields + 0 with - Failure "int_of_string" -> 0 + Failure "int_of_string" -> 0 let print_downlink_macro = fun h {name=s; fields = fields} -> if List.length fields > 0 then begin fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp, " s; end else - fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp " s; + fprintf h "static inline void DOWNLINK_SEND_%s(struct DownlinkTransport *tp " s; print_macro_parameters h fields; fprintf h "){ \n"; let size = (size_fields fields "0") in @@ -201,7 +201,7 @@ module Gen_onboard = struct fprintf stderr "Error: message %s has id %d but should be between 0 and 255\n" m.name m.id; exit 1; end else fprintf h "#define DL_%s %d\n" m.name m.id - ) messages; + ) messages; fprintf h "#define DL_MSG_%s_NB %d\n\n" class_ (List.length messages) (** Prints the table of the messages lengths *) @@ -220,8 +220,8 @@ module Gen_onboard = struct let sizes = List.map - (fun m -> (estimated_size_of_message m, m.name)) - messages in + (fun m -> (estimated_size_of_message m, m.name)) + messages in let sizes = List.sort (fun (s1,_) (s2,_) -> compare s2 s1) sizes in List.iter @@ -246,48 +246,48 @@ module Gen_onboard = struct (** Prints the macro for one field, using the global [offset] ref *) let parse_field = fun (_type, field_name, _format) -> if !offset < 0 then - failwith "FIXME: No field allowed after an array field (print_get_macros)"; + failwith "FIXME: No field allowed after an array field (print_get_macros)"; (** Converts bytes into the required type *) let typed = fun o pprz_type -> (* o for offset *) - let size = pprz_type.Pprz.size in - if check_alignment && o mod (min size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + let size = pprz_type.Pprz.size in + if check_alignment && o mod (min size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - match size with - 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o - | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o - | 4 when pprz_type.Pprz.inttype = "float" -> - sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o - | 8 when pprz_type.Pprz.inttype = "double" -> - let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in - for i = 1 to 7 do - s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) - done; + match size with + 1 -> sprintf "(%s)(*((uint8_t*)_payload+%d))" pprz_type.Pprz.inttype o + | 2 -> sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8)" pprz_type.Pprz.inttype o o + | 4 when pprz_type.Pprz.inttype = "float" -> + sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24); _f.f; })" o o o o + | 8 when pprz_type.Pprz.inttype = "double" -> + let s = ref (sprintf "*((uint8_t*)_payload+%d)" o) in + for i = 1 to 7 do + s := !s ^ sprintf "|((uint64_t)*((uint8_t*)_payload+%d+%d))<<%d" o i (8*i) + done; - sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s - | 4 -> - sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o - | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in + sprintf "({ union { uint64_t u; double f; } _f; _f.u = (uint64_t)(%s); Swap32IfBigEndian(_f.u); _f.f; })" !s + | 4 -> + sprintf "(%s)(*((uint8_t*)_payload+%d)|*((uint8_t*)_payload+%d+1)<<8|((uint32_t)*((uint8_t*)_payload+%d+2))<<16|((uint32_t)*((uint8_t*)_payload+%d+3))<<24)" pprz_type.Pprz.inttype o o o o + | _ -> failwith "unexpected size in Gen_messages.print_get_macros" in (** To be an array or not to be an array: *) match _type with - Basic t -> - let pprz_type = Syntax.assoc_types t in - fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); - offset := !offset + pprz_type.Pprz.size + Basic t -> + let pprz_type = Syntax.assoc_types t in + fprintf h "#define DL_%s_%s(_payload) (%s)\n" msg_name field_name (typed !offset pprz_type); + offset := !offset + pprz_type.Pprz.size - | Array (t, _varname) -> - (** The macro to access to the length of the array *) - fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); - incr offset; + | Array (t, _varname) -> + (** The macro to access to the length of the array *) + fprintf h "#define DL_%s_%s_length(_payload) (%s)\n" msg_name field_name (typed !offset (Syntax.assoc_types "uint8")); + incr offset; - (** The macro to access to the array itself *) - let pprz_type = Syntax.assoc_types t in - if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then - failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); + (** The macro to access to the array itself *) + let pprz_type = Syntax.assoc_types t in + if check_alignment && !offset mod (min pprz_type.Pprz.size 4) <> 0 then + failwith (sprintf "Wrong alignment of field '%s' in message '%s" field_name msg_name); - fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; - offset := -1 (** Mark for no more fields *) + fprintf h "#define DL_%s_%s(_payload) ((%s*)(_payload+%d))\n" msg_name field_name pprz_type.Pprz.inttype !offset; + offset := -1 (** Mark for no more fields *) in fprintf h "\n"; @@ -337,4 +337,4 @@ let () = Printf.fprintf h "#endif // _VAR_MESSAGES2_%s_H_\n" class_name with - Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) + Xml.Error (msg, pos) -> failwith (sprintf "%s:%d : %s\n" filename (Xml.line pos) (Xml.error_msg msg)) diff --git a/sw/tools/gen_modules.ml b/sw/tools/gen_modules.ml index 48fc984e25..1b4db5371f 100644 --- a/sw/tools/gen_modules.ml +++ b/sw/tools/gen_modules.ml @@ -51,9 +51,9 @@ let print_headers = fun modules -> List.iter (fun h -> let dir = ExtXml.attrib_or_default h "dir" dir_name in lprintf out_h "#include \"%s/%s\"\n" dir (Xml.attrib h "name")) - (Xml.children headers) + (Xml.children headers) with _ -> ()) - modules + modules let get_status_name = fun f n -> let func = (Xml.attrib f "fun") in @@ -67,10 +67,10 @@ let get_period_and_freq = fun f max_freq -> let period = try Some (float_of_string (Xml.attrib f "period")) with _ -> None and freq = try Some (float_of_string (Xml.attrib f "freq")) with _ -> None in match period, freq with - | None, None -> (1. /. max_freq, max_freq) - | Some _p, None -> (_p, 1. /. _p) - | None, Some _f -> (1. /. _f, _f) - | Some _p, Some _ -> + | None, None -> (1. /. max_freq, max_freq) + | Some _p, None -> (_p, 1. /. _p) + | None, Some _f -> (1. /. _f, _f) + | Some _p, Some _ -> fprintf stderr "Warning: both period and freq are defined but only period is used for function %s\n" (ExtXml.attrib f "fun"); (_p, 1. /. _p) @@ -78,10 +78,10 @@ let get_period_and_freq = fun f max_freq -> let get_cap_name = fun f -> let name = Str.full_split (Str.regexp "[()]") f in match name with - | [Str.Text t] - | [Str.Text t; Str.Delim "("; Str.Delim ")"] - | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase t - | _ -> failwith "Gen_modules: not a valid function name" + | [Str.Text t] + | [Str.Text t; Str.Delim "("; Str.Delim ")"] + | [Str.Text t; Str.Delim "("; Str.Text _ ; Str.Delim ")"] -> String.uppercase t + | _ -> failwith "Gen_modules: not a valid function name" let print_function_freq = fun modules -> let max_freq = float !freq in @@ -89,14 +89,14 @@ let print_function_freq = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "periodic" -> - let fname = get_cap_name (Xml.attrib i "fun") in - let p, f = get_period_and_freq i max_freq in - lprintf out_h "#define %s_PERIOD %f\n" fname p; - lprintf out_h "#define %s_FREQ %f\n" fname f; - | _ -> ()) - (Xml.children m)) - modules + "periodic" -> + let fname = get_cap_name (Xml.attrib i "fun") in + let p, f = get_period_and_freq i max_freq in + lprintf out_h "#define %s_PERIOD %f\n" fname p; + lprintf out_h "#define %s_FREQ %f\n" fname f; + | _ -> ()) + (Xml.children m)) + modules let is_status_lock = fun p -> let mode = ExtXml.attrib_or_default p "autorun" "LOCK" in @@ -108,13 +108,13 @@ let print_status = fun modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "periodic" -> - if not (is_status_lock i) then begin - lprintf out_h "EXTERN_MODULES uint8_t %s;\n" (get_status_name i module_name); - end - | _ -> ()) - (Xml.children m)) - modules + "periodic" -> + if not (is_status_lock i) then begin + lprintf out_h "EXTERN_MODULES uint8_t %s;\n" (get_status_name i module_name); + end + | _ -> ()) + (Xml.children m)) + modules let print_init_functions = fun modules -> lprintf out_h "\nstatic inline void modules_init(void) {\n"; @@ -123,16 +123,16 @@ let print_init_functions = fun modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "init" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") - | "periodic" -> if not (is_status_lock i) then - lprintf out_h "%s = %s;\n" (get_status_name i module_name) (try match Xml.attrib i "autorun" with - "TRUE" | "true" -> "MODULES_START" - | "FALSE" | "false" | "LOCK" | "lock" -> "MODULES_IDLE" - | _ -> failwith "Error: Unknown autorun value (possible values are: TRUE, FALSE, LOCK(default))" - with _ -> "MODULES_IDLE" (* this should not be possible anyway *)) - | _ -> ()) - (Xml.children m)) - modules; + "init" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") + | "periodic" -> if not (is_status_lock i) then + lprintf out_h "%s = %s;\n" (get_status_name i module_name) (try match Xml.attrib i "autorun" with + "TRUE" | "true" -> "MODULES_START" + | "FALSE" | "false" | "LOCK" | "lock" -> "MODULES_IDLE" + | _ -> failwith "Error: Unknown autorun value (possible values are: TRUE, FALSE, LOCK(default))" + with _ -> "MODULES_IDLE" (* this should not be possible anyway *)) + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -152,17 +152,17 @@ let print_periodic_functions = fun modules -> let p, _ = get_period_and_freq x max_freq in if p < min_period || p > max_period then fprintf stderr "Warning: period is bound between %.3fs and %.3fs (%fHz and %.1fHz) for function %s\n%!" - min_period max_period max_freq min_freq (ExtXml.attrib x "fun"); + min_period max_period max_freq min_freq (ExtXml.attrib x "fun"); ((x, module_name), min 65535 (max 1 (int_of_float (p *. float_of_int !freq)))) - ) periodic) - modules) in + ) periodic) + modules) in let modulos = GC.singletonize (List.map snd functions_modulo) in (** Print modulos *) List.iter (fun modulo -> let v = sprintf "i%d" modulo in let _type = if modulo >= 256 then "uint16_t" else "uint8_t" in lprintf out_h "static %s %s; %s++; if (%s>=%d) %s=0;\n" _type v v v modulo v;) - modulos; + modulos; (** Print start and stop functions *) List.iter (fun m -> let module_name = ExtXml.attrib m "name" in @@ -171,7 +171,7 @@ let print_periodic_functions = fun modules -> List.iter (fun f -> if (is_status_lock f) then begin try lprintf out_h "%s;\n" (Xml.attrib f "start") with _ -> (); - try let stop = Xml.attrib f "stop" in fprintf stderr "Warning: stop %s function will not be called\n" stop with _ -> (); + try let stop = Xml.attrib f "stop" in fprintf stderr "Warning: stop %s function will not be called\n" stop with _ -> (); end else begin let status = get_status_name f module_name in @@ -180,9 +180,9 @@ let print_periodic_functions = fun modules -> let stop = (ExtXml.attrib_or_default f "stop" "") in lprintf out_h "if (%s == MODULES_STOP) { %s; %s = MODULES_IDLE; }\n" status stop status; end - ) - periodic) - modules; + ) + periodic) + modules; (** Print periodic functions *) let functions = List.sort (fun (_,p) (_,p') -> compare p p') functions_modulo in let i = ref 0 in (** Basic balancing:1 function every 10Hz FIXME *) @@ -211,7 +211,7 @@ let print_periodic_functions = fun modules -> if delay >= p then fprintf stderr "Warning: delay is bound between 0 and %d for function %s\n" (p-1) function_name; let delay_p = delay mod p in let else_ = if List.mem_assoc p !l && not (List.mem (p, delay_p) !l) then - "else " else "" in + "else " else "" in if (is_status_lock func) then lprintf out_h "%sif (i%d == %d) {\n" else_ p delay_p else @@ -245,10 +245,10 @@ let print_event_functions = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "event" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") - | _ -> ()) - (Xml.children m)) - modules; + "event" -> lprintf out_h "%s;\n" (Xml.attrib i "fun") + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -261,12 +261,12 @@ let print_datalink_functions = fun modules -> List.iter (fun m -> List.iter (fun i -> match Xml.tag i with - "datalink" -> - lprintf out_h "%sif (msg_id == DL_%s) { %s; }\n" !else_ (ExtXml.attrib i "message") (ExtXml.attrib i "fun"); - else_ := "else " - | _ -> ()) - (Xml.children m)) - modules; + "datalink" -> + lprintf out_h "%sif (msg_id == DL_%s) { %s; }\n" !else_ (ExtXml.attrib i "message") (ExtXml.attrib i "fun"); + else_ := "else " + | _ -> ()) + (Xml.children m)) + modules; left (); lprintf out_h "}\n" @@ -296,7 +296,7 @@ let dep_of_field = fun field att -> try Str.split pipe_regexp (Xml.attrib field att) with - _ -> [] + _ -> [] let check_dependencies = fun modules names -> List.iter (fun m -> @@ -306,12 +306,12 @@ let check_dependencies = fun modules names -> List.iter (fun req -> if not (List.exists (fun c -> String.compare c req == 0) names) then fprintf stderr "\nWARNING: Dependency not satisfied: module %s requires %s\n" (Xml.attrib m "name") req) - require; + require; let conflict = dep_of_field dep "conflict" in List.iter (fun con -> if List.exists (fun c -> String.compare c con == 0) names then fprintf stderr "\nWARNING: Dependency not satisfied: module %s conflicts with %s\n" (Xml.attrib m "name") con) - conflict + conflict with _ -> () ) modules @@ -325,18 +325,18 @@ let write_settings = fun xml_file out_set modules -> let module_name = ExtXml.attrib m "name" in List.iter (fun i -> match Xml.tag i with - "periodic" -> - if not (is_status_lock i) then begin - if (not !setting_exist) then begin - fprintf out_set " \n"; - setting_exist := true; - end; - fprintf out_set " \n" - (get_status_name i module_name) (get_status_shortname i) - end - | _ -> ()) - (Xml.children m)) - modules; + "periodic" -> + if not (is_status_lock i) then begin + if (not !setting_exist) then begin + fprintf out_set " \n"; + setting_exist := true; + end; + fprintf out_set " \n" + (get_status_name i module_name) (get_status_shortname i) + end + | _ -> ()) + (Xml.children m)) + modules; if !setting_exist then fprintf out_set " \n"; fprintf out_set " \n"; fprintf out_set "\n" @@ -371,7 +371,7 @@ let () = (* Extract modules names (file name and module name) *) let modules_name = (List.map (fun m -> try Xml.attrib m.GC.xml "name" with _ -> "") modules) @ - (List.map (fun m -> m.GC.file) modules) in + (List.map (fun m -> m.GC.file) modules) in (* Extract xml modules nodes *) let modules_list = List.map (fun m -> m.GC.xml) modules in check_dependencies modules_list modules_name; @@ -380,7 +380,7 @@ let () = write_settings xml_file out_set modules_list; close_out out_set; with - Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 - | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 - | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 - | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 + Xml.Error e -> fprintf stderr "%s: XML error:%s\n" xml_file (Xml.error e); exit 1 + | Dtd.Prove_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.prove_error e); exit 1 + | Dtd.Check_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.check_error e); exit 1 + | Dtd.Parse_error e -> fprintf stderr "%s: DTD error:%s\n%!" xml_file (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_mtk.ml b/sw/tools/gen_mtk.ml index 57bf8ce516..2fb96de0ad 100644 --- a/sw/tools/gen_mtk.ml +++ b/sw/tools/gen_mtk.ml @@ -27,7 +27,7 @@ open Printf let out = stdout let sizeof = function - "U4" | "I4" -> 4 +"U4" | "I4" -> 4 | "U2" | "I2" -> 2 | "U1" | "I1" -> 1 | "U4BE" | "I4BE" -> 4 @@ -38,29 +38,29 @@ let (+=) = fun r x -> r := !r + x let c_type = fun format -> match format with - "I2" -> "int16_t" - | "I4" -> "int32_t" - | "U2" -> "uint16_t" - | "U4" -> "uint32_t" - | "U1" -> "uint8_t" - | "I1" -> "int8_t" - | "I2BE" -> "int16_t" - | "I4BE" -> "int32_t" - | "U2BE" -> "uint16_t" - | "U4BE" -> "uint32_t" - | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) + "I2" -> "int16_t" + | "I4" -> "int32_t" + | "U2" -> "uint16_t" + | "U4" -> "uint32_t" + | "U1" -> "uint8_t" + | "I1" -> "int8_t" + | "I2BE" -> "int16_t" + | "I4BE" -> "int32_t" + | "U2BE" -> "uint16_t" + | "U4BE" -> "uint32_t" + | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) let get_at = fun offset format block_size -> let t = c_type format in let block_offset = if block_size = 0 then "" else sprintf "+%d*_mtk_block" block_size in match format with - "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+2+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s))" t offset block_offset - | "U4BE" | "I4BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+3+%d%s)|*((uint8_t*)_mtk_payload+2+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+1+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2BE" | "I2BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+1+%d%s)|*((uint8_t*)_mtk_payload+%d%s)<<8)" t offset block_offset offset block_offset - | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) + "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+2+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s)|*((uint8_t*)_mtk_payload+1+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+%d%s))" t offset block_offset + | "U4BE" | "I4BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+3+%d%s)|*((uint8_t*)_mtk_payload+2+%d%s)<<8|((%s)*((uint8_t*)_mtk_payload+1+%d%s))<<16|((%s)*((uint8_t*)_mtk_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2BE" | "I2BE" -> sprintf "(%s)(*((uint8_t*)_mtk_payload+1+%d%s)|*((uint8_t*)_mtk_payload+%d%s)<<8)" t offset block_offset offset block_offset + | _ -> failwith (sprintf "Gen_mtk.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -83,19 +83,19 @@ let parse_message = fun class_name m -> let offset = ref 0 in let rec gen_access_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - let block_no = if block_size = 0 then "" else ",_mtk_block" in - define (sprintf "MTK_%s_%s_%s(_mtk_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_access_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + let block_no = if block_size = 0 then "" else ",_mtk_block" in + define (sprintf "MTK_%s_%s_%s(_mtk_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_access_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in List.iter (gen_access_macro 0) (Xml.children m); @@ -104,7 +104,7 @@ let parse_message = fun class_name m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end; (** Generating send function *) @@ -121,14 +121,14 @@ let parse_message = fun class_name m -> fprintf out " MtkHeader(MTK_%s_ID, %s, %d);\\\n" class_name msg_id !offset; let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - fprintf out " %s _%s = %s; MtkSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + fprintf out " %s _%s = %s; MtkSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " MtkTrailer();\\\n"; fprintf out "}\n\n#define MTK_%s_%s_LENGTH %d\n" class_name msg_name !offset @@ -159,16 +159,16 @@ let _ = List.iter parse_class (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD check error: %s\n\n" xml_file (Dtd.prove_error e) diff --git a/sw/tools/gen_periodic.ml b/sw/tools/gen_periodic.ml index 546e34427e..253182f8c3 100644 --- a/sw/tools/gen_periodic.ml +++ b/sw/tools/gen_periodic.ml @@ -50,20 +50,20 @@ let output_modes = fun out_h process_name modes freq modules -> (** Filter message list to remove messages linked to unloaded modules *) let filtered_msg = List.filter (fun msg -> try let att = Xml.attrib msg "module" in List.exists (fun name -> String.compare name att = 0) modules with _ -> true - ) (Xml.children mode) in + ) (Xml.children mode) in (** Computes the required modulos *) let messages = List.map (fun x -> let p = float_of_string (ExtXml.attrib x "period") in if p < min_period || p > max_period then fprintf stderr "Warning: period is bound between %.3fs and %.3fs for message %s\n%!" min_period max_period (ExtXml.attrib x "name"); (x, min 65535 (max 1 (int_of_float (p*.float_of_int freq)))) - ) filtered_msg in + ) filtered_msg in let modulos = GC.singletonize (List.map snd messages) in List.iter (fun m -> let v = sprintf "i%d" m in let _type = if m >= 256 then "uint16_t" else "uint8_t" in lprintf out_h "static %s %s = 0; %s++; if (%s>=%d) %s=0;\\\n" _type v v v m v; - ) modulos; + ) modulos; (** For each message in this mode *) let messages = List.sort (fun (_,p) (_,p') -> compare p p') messages in @@ -104,14 +104,14 @@ let write_settings = fun xml_file out_set telemetry_xml -> let modes = List.map (fun m -> Xml.attrib m "name") (Xml.children p) in let nb_modes = List.length modes in match nb_modes with - 0 | 1 -> () (* Nothing to do if 1 or zero mode *) - | _ -> (* add settings with all modes *) + 0 | 1 -> () (* Nothing to do if 1 or zero mode *) + | _ -> (* add settings with all modes *) fprintf out_set " \n" (nb_modes-1) process_name process_name (String.concat "|" modes); let i = ref 0 in List.iter (fun m -> try - let key = Xml.attrib m "key_press" in - fprintf out_set " \n" key (string_of_int !i); - incr i + let key = Xml.attrib m "key_press" in + fprintf out_set " \n" key (string_of_int !i); + incr i with _ -> incr i) (Xml.children p); fprintf out_set " \n" ) (Xml.children telemetry_xml); diff --git a/sw/tools/gen_radio.ml b/sw/tools/gen_radio.ml index c66f72614f..5d48af1a8b 100644 --- a/sw/tools/gen_radio.ml +++ b/sw/tools/gen_radio.ml @@ -31,20 +31,20 @@ let fos = float_of_string type us = int type channel = { - name : string; - min : us; - max : us; - neutral : us; - averaged : bool } + name : string; + min : us; + max : us; + neutral : us; + averaged : bool } (* Characters used in Gen_airframe.pprz_value *) let check_function_name = fun s -> for i = 0 to String.length s - 1 do match s.[i] with - 'A'..'Z' | '0'..'9' | '_' -> () - | _ -> - failwith (sprintf "Character '%c' not allowed in function name '%s'" s.[i] s) + 'A'..'Z' | '0'..'9' | '_' -> () + | _ -> + failwith (sprintf "Character '%c' not allowed in function name '%s'" s.[i] s) done let parse_channel = @@ -125,7 +125,7 @@ let gen_normalize_ppm_iir = fun channels -> printf " _rc.values[RADIO_%s] = (pprz_t)((RADIO_FILTER * _rc.values[RADIO_%s] + tmp_value) / (RADIO_FILTER + 1));\\\n\\\n" c.name c.name else printf " _rc.values[RADIO_%s] = (pprz_t)(tmp_value);\\\n\\\n" c.name - ) + ) channels; (*printf " rc_values_contains_avg_channels = TRUE;\\\n";*) printf "}\n" diff --git a/sw/tools/gen_settings.ml b/sw/tools/gen_settings.ml index d9ba0a5f5a..32313bd37a 100644 --- a/sw/tools/gen_settings.ml +++ b/sw/tools/gen_settings.ml @@ -40,10 +40,10 @@ let rec flatten = fun xml r -> xml::r else match Xml.children xml with - [] -> r - | x::xs -> - List.iter (fun y -> assert(ExtXml.tag_is y (Xml.tag x))) xs; - List.fold_right flatten (x::xs) r + [] -> r + | x::xs -> + List.iter (fun y -> assert(ExtXml.tag_is y (Xml.tag x))) xs; + List.fold_right flatten (x::xs) r module StringSet = Set.Make(struct type t = string let compare = compare end) @@ -142,14 +142,14 @@ let print_dl_settings = fun settings -> left() (* - Generate code for persistent settings + Generate code for persistent settings *) let print_persistent_settings = fun settings -> let settings = flatten settings [] in let pers_settings = List.filter (fun x -> try let _ = Xml.attrib x "persistent" in true with _ -> false) settings in (* structure declaration *) -(* if List.length pers_settings > 0 then begin *) + (* if List.length pers_settings > 0 then begin *) lprintf "\n/* Persistent Settings */\n"; lprintf "struct PersistentSettings {\n"; right(); @@ -185,7 +185,7 @@ let print_persistent_settings = fun settings -> let h = ExtXml.attrib s "handler" and m = ExtXml.attrib s "module" in lprintf "%s_%s( pers_settings.s_%d );\n" (Filename.basename m) h !idx ; - (* lprintf "%s = pers_settings.s_%d;\n" v !idx *) (* do we want to set the value too or just call the handler ? *) + (* lprintf "%s = pers_settings.s_%d;\n" v !idx *) (* do we want to set the value too or just call the handler ? *) with ExtXml.Error e -> lprintf "%s = pers_settings.s_%d;\n" v !idx end; @@ -197,10 +197,10 @@ let print_persistent_settings = fun settings -> (* - Blaaaaaa2 + Blaaaaaa2 *) let calib_mode_of_rc = function - "gain_1_up" -> 1, "up" +"gain_1_up" -> 1, "up" | "gain_1_down" -> 1, "down" | "gain_2_up" -> 2, "up" | "gain_2_down" -> 2, "down" @@ -209,7 +209,7 @@ let calib_mode_of_rc = function let param_macro_of_type = fun x -> "ParamVal"^String.capitalize x let inttype = function - "int16" -> "int16_t" +"int16" -> "int16_t" | "float" -> "float" | x -> failwith (sprintf "Gen_calib.inttype: unknown type '%s'" x) @@ -221,7 +221,7 @@ let parse_rc_setting = fun xml -> let param_macro = param_macro_of_type t in let dot_pos = try String.rindex var '.' + 1 with - Not_found -> 0 in + Not_found -> 0 in let var_nostruct = String.sub var dot_pos (String.length var - dot_pos) in let var_init = var_nostruct ^ "_init" in @@ -259,7 +259,7 @@ let join_xml_files = fun xml_files -> Not_found -> [] in let these_dl_settings = try Xml.children (ExtXml.child xml "dl_settings") with - Not_found -> [] in + Not_found -> [] in rc_settings := these_rc_settings @ !rc_settings; dl_settings := these_dl_settings @ !dl_settings) xml_files; @@ -302,6 +302,6 @@ let _ = finish h_name with - Xml.Error e -> prerr_endline (Xml.error e); exit 1 - | Dtd.Prove_error e -> prerr_endline (Dtd.prove_error e); exit 1 - | Dtd.Parse_error e -> prerr_endline (Dtd.parse_error e); exit 1 + Xml.Error e -> prerr_endline (Xml.error e); exit 1 + | Dtd.Prove_error e -> prerr_endline (Dtd.prove_error e); exit 1 + | Dtd.Parse_error e -> prerr_endline (Dtd.parse_error e); exit 1 diff --git a/sw/tools/gen_srtm.ml b/sw/tools/gen_srtm.ml index af8e44f268..2f10ea555a 100644 --- a/sw/tools/gen_srtm.ml +++ b/sw/tools/gen_srtm.ml @@ -58,23 +58,23 @@ let () = () ) area_list; (* reading file names in dir *) - let file_names = Sys.readdir srtm_tmp_dir in + let file_names = Sys.readdir srtm_tmp_dir in (* Open temporary file *) - let file, out = Filename.open_temp_file ~temp_dir:var_dir "srtm" ".data" in + let file, out = Filename.open_temp_file ~temp_dir:var_dir "srtm" ".data" in (* Parse files for xml and read them *) - Array.iter (read_file_and_print out) file_names; + Array.iter (read_file_and_print out) file_names; (* Close file *) - close_out out; + close_out out; (* Compress file *) - let _ = Sys.command ("bzip2 -z "^file) in + let _ = Sys.command ("bzip2 -z "^file) in (* Move to final name *) - Unix.rename (file^".bz2") srtm_data; - prerr_endline ("Srtm data: "^srtm_data) + Unix.rename (file^".bz2") srtm_data; + prerr_endline ("Srtm data: "^srtm_data) diff --git a/sw/tools/gen_ubx.ml b/sw/tools/gen_ubx.ml index a18bf34cf5..f9509158fa 100644 --- a/sw/tools/gen_ubx.ml +++ b/sw/tools/gen_ubx.ml @@ -27,7 +27,7 @@ open Printf let out = stdout let sizeof = function - "U4" | "I4" -> 4 +"U4" | "I4" -> 4 | "U2" | "I2" -> 2 | "U1" | "I1" -> 1 | x -> failwith (sprintf "sizeof: unknown format '%s'" x) @@ -36,23 +36,23 @@ let (+=) = fun r x -> r := !r + x let c_type = fun format -> match format with - "I2" -> "int16_t" - | "I4" -> "int32_t" - | "U2" -> "uint16_t" - | "U4" -> "uint32_t" - | "U1" -> "uint8_t" - | "I1" -> "int8_t" - | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) + "I2" -> "int16_t" + | "I4" -> "int32_t" + | "U2" -> "uint16_t" + | "U4" -> "uint32_t" + | "U1" -> "uint8_t" + | "I1" -> "int8_t" + | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) let get_at = fun offset format block_size -> let t = c_type format in let block_offset = if block_size = 0 then "" else sprintf "+%d*_ubx_block" block_size in match format with - "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8|((%s)*((uint8_t*)_ubx_payload+2+%d%s))<<16|((%s)*((uint8_t*)_ubx_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s))" t offset block_offset - | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) + "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8|((%s)*((uint8_t*)_ubx_payload+2+%d%s))<<16|((%s)*((uint8_t*)_ubx_payload+3+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s)|*((uint8_t*)_ubx_payload+1+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_ubx_payload+%d%s))" t offset block_offset + | _ -> failwith (sprintf "Gen_ubx.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -75,19 +75,19 @@ let parse_message = fun class_name m -> let offset = ref 0 in let rec gen_access_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - let block_no = if block_size = 0 then "" else ",_ubx_block" in - define (sprintf "UBX_%s_%s_%s(_ubx_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_access_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + let block_no = if block_size = 0 then "" else ",_ubx_block" in + define (sprintf "UBX_%s_%s_%s(_ubx_payload%s)" class_name msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_access_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in List.iter (gen_access_macro 0) (Xml.children m); @@ -96,7 +96,7 @@ let parse_message = fun class_name m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end; (** Generating send function *) @@ -113,14 +113,14 @@ let parse_message = fun class_name m -> fprintf out " UbxHeader(UBX_%s_ID, %s, %d);\\\n" class_name msg_id !offset; let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - fprintf out " %s _%s = %s; UbxSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + fprintf out " %s _%s = %s; UbxSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " UbxTrailer();\\\n"; fprintf out "}\n" @@ -151,16 +151,16 @@ let _ = List.iter parse_class (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD check error: %s\n\n" xml_file (Dtd.prove_error e) diff --git a/sw/tools/gen_xsens.ml b/sw/tools/gen_xsens.ml index 11543e1496..af5b665f1c 100644 --- a/sw/tools/gen_xsens.ml +++ b/sw/tools/gen_xsens.ml @@ -29,7 +29,7 @@ let out = stdout exception Variable_data let sizeof = function - "U32" -> 32 +"U32" -> 32 | "U8" -> 8 | "U4" | "I4" | "R4" -> 4 | "U2" | "I2" -> 2 @@ -39,20 +39,20 @@ let sizeof = function let (+=) = fun r x -> r := !r + x let test_type = function - "U32" | "U8" -> "skip" +"U32" | "U8" -> "skip" | "V" -> "variable" | _ -> "fixe" let c_type = fun format -> match format with - "R4" -> "float" - | "I4" -> "int32_t" - | "I2" -> "int16_t" - | "I1" -> "int8_t" - | "U4" -> "uint32_t" - | "U2" -> "uint16_t" - | "U1" -> "uint8_t" - | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) + "R4" -> "float" + | "I4" -> "int32_t" + | "I2" -> "int16_t" + | "I1" -> "int8_t" + | "U4" -> "uint32_t" + | "U2" -> "uint16_t" + | "U1" -> "uint8_t" + | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) (* format is BigEndian *) let get_at = fun offset format block_size -> @@ -60,11 +60,11 @@ let get_at = fun offset format block_size -> let block_offset = if block_size = 0 then "" else sprintf "+%d*_xsens_block" block_size in match format with - "R4" -> sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((uint32_t)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((uint32_t)*((uint8_t*)_xsens_payload+%d%s))<<24); _f.f; })" offset block_offset offset block_offset offset block_offset offset block_offset - | "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((%s)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((%s)*((uint8_t*)_xsens_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset - | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+1+%d%s)|*((uint8_t*)_xsens_payload+%d%s)<<8)" t offset block_offset offset block_offset - | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+%d%s))" t offset block_offset - | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) + "R4" -> sprintf "({ union { uint32_t u; float f; } _f; _f.u = (uint32_t)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((uint32_t)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((uint32_t)*((uint8_t*)_xsens_payload+%d%s))<<24); _f.f; })" offset block_offset offset block_offset offset block_offset offset block_offset + | "U4" | "I4" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+3+%d%s)|*((uint8_t*)_xsens_payload+2+%d%s)<<8|((%s)*((uint8_t*)_xsens_payload+1+%d%s))<<16|((%s)*((uint8_t*)_xsens_payload+%d%s))<<24)" t offset block_offset offset block_offset t offset block_offset t offset block_offset + | "U2" | "I2" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+1+%d%s)|*((uint8_t*)_xsens_payload+%d%s)<<8)" t offset block_offset offset block_offset + | "U1" | "I1" -> sprintf "(%s)(*((uint8_t*)_xsens_payload+%d%s))" t offset block_offset + | _ -> failwith (sprintf "Gen_xsens.c_type: unknown format '%s'" format) let define = fun x y -> fprintf out "#define %s %s\n" x y @@ -88,25 +88,25 @@ let parse_message = fun m -> (** Generating read function *) let rec gen_read_macro = fun block_size f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fmt = format f in - begin - match test_type (format f) with - "fixe" -> - let block_no = if block_size = 0 then "" else ",_xsens_block" in - define (sprintf "XSENS_%s_%s(_xsens_payload%s)" msg_name fn block_no) (get_at !offset fmt block_size); - offset += sizeof fmt; - | "variable" -> fprintf out "/* XSENS_%s_%s: variable data size */\n" msg_name fn; - | _ -> offset += sizeof fmt; - end - | "block" -> - let s = int_of_string (Xml.attrib f "length") in - let o = !offset in - List.iter (gen_read_macro s) (Xml.children f); - let s' = !offset - o in - if s <> s' then raise (Length_error (f, s, s')) - | x -> failwith ("Unexpected field: " ^ x) + "field" -> + let fn = field_name f + and fmt = format f in + begin + match test_type (format f) with + "fixe" -> + let block_no = if block_size = 0 then "" else ",_xsens_block" in + define (sprintf "XSENS_%s_%s(_xsens_payload%s)" msg_name fn block_no) (get_at !offset fmt block_size); + offset += sizeof fmt; + | "variable" -> fprintf out "/* XSENS_%s_%s: variable data size */\n" msg_name fn; + | _ -> offset += sizeof fmt; + end + | "block" -> + let s = int_of_string (Xml.attrib f "length") in + let o = !offset in + List.iter (gen_read_macro s) (Xml.children f); + let s' = !offset - o in + if s <> s' then raise (Length_error (f, s, s')) + | x -> failwith ("Unexpected field: " ^ x) in (** Generating send function *) @@ -128,15 +128,15 @@ let parse_message = fun m -> fprintf out " XsensHeader(%s, %s);\\\n" msg_id (get_msg_length m); let rec send_one_field = fun f -> match Xml.tag f with - "field" -> - let s = sizeof (format f) in - let p = param_name f in - let t = param_type f in - offset += sizeof (format f); - fprintf out " %s _%s = %s; XsensSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p - | "block" -> - List.iter send_one_field (Xml.children f) - | _ -> assert (false) in + "field" -> + let s = sizeof (format f) in + let p = param_name f in + let t = param_type f in + offset += sizeof (format f); + fprintf out " %s _%s = %s; XsensSend%dByAddr((uint8_t*)&_%s);\\\n" t p p s p + | "block" -> + List.iter send_one_field (Xml.children f) + | _ -> assert (false) in List.iter send_one_field (Xml.children m); fprintf out " XsensTrailer();\\\n"; fprintf out "}" @@ -144,9 +144,9 @@ let parse_message = fun m -> let gen_access_macro = match Xml.attrib m "to" with - "MT" -> gen_send_macro (); - | "host" -> List.iter (gen_read_macro 0) (Xml.children m); - | _ -> failwith "Unexpected direction"; + "MT" -> gen_send_macro (); + | "host" -> List.iter (gen_read_macro 0) (Xml.children m); + | _ -> failwith "Unexpected direction"; in gen_access_macro; @@ -155,7 +155,7 @@ let parse_message = fun m -> let l = int_of_string (Xml.attrib m "length") in if l <> !offset then raise (Length_error (m, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end @@ -176,19 +176,19 @@ let parse_data = fun d -> (** Generating read function *) let gen_read_macro = fun f -> match Xml.tag f with - "field" -> - let fn = field_name f - and fdt = format f in - begin - match test_type (format f) with - "fixe" -> + "field" -> + let fn = field_name f + and fdt = format f in + begin + match test_type (format f) with + "fixe" -> (* _xsens_block used as offset value *) - define (sprintf "XSENS_DATA_%s_%s(_xsens_payload,_xsens_block)" data_name fn) (get_at !offset fdt 1); - offset += sizeof fdt; - | "variable" -> failwith (sprintf "XSENS_%s_%s: variable data size" data_name fn); - | _ -> offset += sizeof fdt; - end - | x -> failwith ("Unexpected field: " ^ x) + define (sprintf "XSENS_DATA_%s_%s(_xsens_payload,_xsens_block)" data_name fn) (get_at !offset fdt 1); + offset += sizeof fdt; + | "variable" -> failwith (sprintf "XSENS_%s_%s: variable data size" data_name fn); + | _ -> offset += sizeof fdt; + end + | x -> failwith ("Unexpected field: " ^ x) in List.iter gen_read_macro (Xml.children d); @@ -197,7 +197,7 @@ let parse_data = fun d -> let l = int_of_string (Xml.attrib d "length") in if l <> !offset then raise (Length_error (d, l, !offset)) with - Xml.No_attribute("length") -> () (** Undefined length authorized *) + Xml.No_attribute("length") -> () (** Undefined length authorized *) end let parse_mask = fun m -> @@ -211,10 +211,10 @@ let parse_mask = fun m -> let parse_all = fun m -> match Xml.tag m with - "message" -> parse_message m - | "data" -> parse_data m - | "mask" -> parse_mask m - | x -> failwith (sprintf "Unexpected tag: %s" x) + "message" -> parse_message m + | "data" -> parse_data m + | "mask" -> parse_mask m + | x -> failwith (sprintf "Unexpected tag: %s" x) @@ -234,18 +234,18 @@ let _ = List.iter parse_all (Xml.children xml) with - Xml.Error (em, ep) -> - let l = Xml.line ep - and c1, c2 = Xml.range ep in - fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; - fprintf stderr "%s\n" (Xml.error_msg em); - exit 1 - | Length_error (m, l1, l2) -> + Xml.Error (em, ep) -> + let l = Xml.line ep + and c1, c2 = Xml.range ep in + fprintf stderr "File \"%s\", line %d, characters %d-%d:\n" xml_file l c1 c2; + fprintf stderr "%s\n" (Xml.error_msg em); + exit 1 + | Length_error (m, l1, l2) -> fprintf stderr "File \"%s\", inconsistent length: %d expected, %d found from fields in message:\n %s\n" xml_file l1 l2 (Xml.to_string_fmt m); exit 1 - | Dtd.Parse_error e -> + | Dtd.Parse_error e -> fprintf stderr "File \"%s\", DTD parse error: %s\n" xml_file (Dtd.parse_error e) - | Dtd.Check_error e -> + | Dtd.Check_error e -> fprintf stderr "File \"%s\", DTD check error: %s\n" xml_file (Dtd.check_error e) - | Dtd.Prove_error e -> + | Dtd.Prove_error e -> fprintf stderr "\nFile \"%s\", DTD prove error: %s\n\n" xml_file (Dtd.prove_error e) From 29d855ed3640be0ed4b4576d666a36bfba37516e Mon Sep 17 00:00:00 2001 From: Loic Drumettaz Date: Tue, 26 Mar 2013 09:14:57 +0100 Subject: [PATCH 082/109] speed and accel saturations along the course reference: keep trajectory towards the setpoint position even when speed and/or accel are saturated --- .../rotorcraft/guidance/guidance_h_ref.h | 126 +++++++++++++----- 1 file changed, 95 insertions(+), 31 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h index 868e2b4026..357f14fe85 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h @@ -19,7 +19,7 @@ * Boston, MA 02111-1307, USA. */ -/** @file firmwares/rotorcraft/guidance/guidance_h_ref.h +/** @file firmware/rotorcraft/guidance/guidance_h_ref.h * Reference generation for horizontal guidance. * */ @@ -43,7 +43,7 @@ extern struct Int32Vect2 b2_gh_accel_ref; #define B2_GH_ACCEL_REF_FRAC 8 /* reference model speed in meters/sec (output) */ -/* Q14.17 : accuracy 0.0000076 , range 16384m/s2 */ +/* Q14.17 : accuracy 0.0000076 , range 16384m/s */ extern struct Int32Vect2 b2_gh_speed_ref; #define B2_GH_SPEED_REF_FRAC (B2_GH_ACCEL_REF_FRAC + B2_GH_FREQ_FRAC) @@ -52,17 +52,20 @@ extern struct Int32Vect2 b2_gh_speed_ref; extern struct Int64Vect2 b2_gh_pos_ref; #define B2_GH_POS_REF_FRAC (B2_GH_SPEED_REF_FRAC + B2_GH_FREQ_FRAC) -/* Saturations definition */ -#ifndef GUIDANCE_H_REF_MAX_ACCEL +/* Accel saturation */ /* tanf(RadOfDeg(30.))*9.81 = 5.66 */ -#define GUIDANCE_H_REF_MAX_ACCEL 5.66 +#ifndef GUIDANCE_H_REF_MAX_ACCEL +#define GUIDANCE_H_REF_MAX_ACCEL 5.66 #endif -#define B2_GH_MAX_ACCEL BFP_OF_REAL(GUIDANCE_H_REF_MAX_ACCEL, B2_GH_ACCEL_REF_FRAC) +#define B2_GH_MAX_ACCEL BFP_OF_REAL(GUIDANCE_H_REF_MAX_ACCEL, B2_GH_ACCEL_REF_FRAC) +/*Speed saturation*/ #ifndef GUIDANCE_H_REF_MAX_SPEED -#define GUIDANCE_H_REF_MAX_SPEED ( 5. ) +#define GUIDANCE_H_REF_MAX_SPEED 5. #endif -#define B2_GH_MAX_SPEED BFP_OF_REAL(GUIDANCE_H_REF_MAX_SPEED, B2_GH_SPEED_REF_FRAC) +/*FIX ME :B2_GH_MAX_SPEED must be limited to 2^14 to avoid overflow*/ +#define B2_GH_MAX_SPEED_REF_FRAC 7 +#define B2_GH_MAX_SPEED BFP_OF_REAL(GUIDANCE_H_REF_MAX_SPEED, B2_GH_MAX_SPEED_REF_FRAC) /* second order model natural frequency and damping */ #ifndef GUIDANCE_H_REF_OMEGA @@ -88,7 +91,12 @@ static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp); struct Int64Vect2 b2_gh_pos_ref; struct Int32Vect2 b2_gh_speed_ref; +struct Int32Vect2 b2_gh_max_speed_ref; struct Int32Vect2 b2_gh_accel_ref; +struct Int32Vect2 b2_gh_max_accel_ref; + +int32_t route_ref; +int32_t s_route_ref, c_route_ref; static inline void b2_gh_set_ref(struct Int32Vect2 pos, struct Int32Vect2 speed, struct Int32Vect2 accel) { struct Int64Vect2 new_pos; @@ -121,36 +129,63 @@ static inline void b2_gh_update_ref_from_pos_sp(struct Int32Vect2 pos_sp) { INT32_VECT2_RSHIFT(pos, pos, B2_GH_OMEGA_2_FRAC); // sum accel VECT2_SUM(b2_gh_accel_ref, speed, pos); + + /* Compute route reference before saturation */ + // use metric precision or values are too large + INT32_ATAN2(route_ref,-pos_err.y,-pos_err.x); + /* Compute North and East route components */ + PPRZ_ITRIG_SIN(s_route_ref, route_ref); + PPRZ_ITRIG_COS(c_route_ref, route_ref); + c_route_ref=abs(c_route_ref); + s_route_ref=abs(s_route_ref); + /* Compute maximum acceleration*/ + b2_gh_max_accel_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,c_route_ref,INT32_TRIG_FRAC); + b2_gh_max_accel_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,s_route_ref,INT32_TRIG_FRAC); + /* Compute maximum speed*/ + b2_gh_max_speed_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,c_route_ref,INT32_TRIG_FRAC); + b2_gh_max_speed_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,s_route_ref,INT32_TRIG_FRAC); + /* restore b2_gh_speed_ref range (Q14.17) */ + INT32_VECT2_LSHIFT(b2_gh_max_speed_ref, b2_gh_max_speed_ref,B2_GH_SPEED_REF_FRAC - B2_GH_MAX_SPEED_REF_FRAC); - /* Saturate accelerations */ - VECT2_STRIM(b2_gh_accel_ref, -B2_GH_MAX_ACCEL, B2_GH_MAX_ACCEL); - - /* Saturate speed and adjust acceleration accordingly */ - if (b2_gh_speed_ref.x <= -B2_GH_MAX_SPEED) { - b2_gh_speed_ref.x = -B2_GH_MAX_SPEED; + /* Saturate accelerations */ + if (b2_gh_accel_ref.x <= -b2_gh_max_accel_ref.x) { + b2_gh_accel_ref.x = -b2_gh_max_accel_ref.x; + } + else if (b2_gh_accel_ref.x >= b2_gh_max_accel_ref.x) { + b2_gh_accel_ref.x = b2_gh_max_accel_ref.x; + } + if (b2_gh_accel_ref.y <= -b2_gh_max_accel_ref.y) { + b2_gh_accel_ref.y = -b2_gh_max_accel_ref.y; + } + else if (b2_gh_accel_ref.y >= b2_gh_max_accel_ref.y) { + b2_gh_accel_ref.y = b2_gh_max_accel_ref.y; + } + + /* Saturate speed and adjust acceleration accordingly */ + if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { + b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; if (b2_gh_accel_ref.x < 0) b2_gh_accel_ref.x = 0; } - else if (b2_gh_speed_ref.x >= B2_GH_MAX_SPEED) { - b2_gh_speed_ref.x = B2_GH_MAX_SPEED; + else if (b2_gh_speed_ref.x >= b2_gh_max_speed_ref.x) { + b2_gh_speed_ref.x = b2_gh_max_speed_ref.x; if (b2_gh_accel_ref.x > 0) b2_gh_accel_ref.x = 0; } - if (b2_gh_speed_ref.y <= -B2_GH_MAX_SPEED) { - b2_gh_speed_ref.y = -B2_GH_MAX_SPEED; + if (b2_gh_speed_ref.y <= -b2_gh_max_speed_ref.y) { + b2_gh_speed_ref.y = -b2_gh_max_speed_ref.y; if (b2_gh_accel_ref.y < 0) b2_gh_accel_ref.y = 0; } - else if (b2_gh_speed_ref.y >= B2_GH_MAX_SPEED) { - b2_gh_speed_ref.y = B2_GH_MAX_SPEED; + else if (b2_gh_speed_ref.y >= b2_gh_max_speed_ref.y) { + b2_gh_speed_ref.y = b2_gh_max_speed_ref.y; if (b2_gh_accel_ref.y > 0) b2_gh_accel_ref.y = 0; } } - static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { - +/* WARNING: SPEED SATURATION UNTESTED */ VECT2_ADD(b2_gh_pos_ref, b2_gh_speed_ref); VECT2_ADD(b2_gh_speed_ref, b2_gh_accel_ref); @@ -164,27 +199,56 @@ static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { VECT2_SMUL(b2_gh_accel_ref, speed_err, -B2_GH_REF_INV_THAU); INT32_VECT2_RSHIFT(b2_gh_accel_ref, b2_gh_accel_ref, B2_GH_REF_INV_THAU_FRAC); + /* Compute route reference before saturation */ + // use metric precision or values are too large + INT32_ATAN2(route_ref,-speed_sp.y,-speed_sp.x); + /* Compute North and East route components */ + PPRZ_ITRIG_SIN(s_route_ref, route_ref); + PPRZ_ITRIG_COS(c_route_ref, route_ref); + c_route_ref=abs(c_route_ref); + s_route_ref=abs(s_route_ref); + + /* Compute maximum acceleration*/ + b2_gh_max_accel_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,c_route_ref,INT32_TRIG_FRAC); + b2_gh_max_accel_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,s_route_ref,INT32_TRIG_FRAC); + /* Compute maximum speed*/ + b2_gh_max_speed_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,c_route_ref,INT32_TRIG_FRAC); + b2_gh_max_speed_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,s_route_ref,INT32_TRIG_FRAC); + /* restore b2_gh_speed_ref range (Q14.17) */ + INT32_VECT2_LSHIFT(b2_gh_max_speed_ref, b2_gh_max_speed_ref,B2_GH_SPEED_REF_FRAC - B2_GH_MAX_SPEED_REF_FRAC); + /* Saturate accelerations */ - VECT2_STRIM(b2_gh_accel_ref, -B2_GH_MAX_ACCEL, B2_GH_MAX_ACCEL); + if (b2_gh_accel_ref.x <= -b2_gh_max_accel_ref.x) { + b2_gh_accel_ref.x = -b2_gh_max_accel_ref.x; + } + else if (b2_gh_accel_ref.x >= b2_gh_max_accel_ref.x) { + b2_gh_accel_ref.x = b2_gh_max_accel_ref.x; + } + if (b2_gh_accel_ref.y <= -b2_gh_max_accel_ref.y) { + b2_gh_accel_ref.y = -b2_gh_max_accel_ref.y; + } + else if (b2_gh_accel_ref.y >= b2_gh_max_accel_ref.y) { + b2_gh_accel_ref.y = b2_gh_max_accel_ref.y; + } /* Saturate speed and adjust acceleration accordingly */ - if (b2_gh_speed_ref.x <= -B2_GH_MAX_SPEED) { - b2_gh_speed_ref.x = -B2_GH_MAX_SPEED; + if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { + b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; if (b2_gh_accel_ref.x < 0) b2_gh_accel_ref.x = 0; } - else if (b2_gh_speed_ref.x >= B2_GH_MAX_SPEED) { - b2_gh_speed_ref.x = B2_GH_MAX_SPEED; + else if (b2_gh_speed_ref.x >= b2_gh_max_speed_ref.x) { + b2_gh_speed_ref.x = b2_gh_max_speed_ref.x; if (b2_gh_accel_ref.x > 0) b2_gh_accel_ref.x = 0; } - if (b2_gh_speed_ref.y <= -B2_GH_MAX_SPEED) { - b2_gh_speed_ref.y = -B2_GH_MAX_SPEED; + if (b2_gh_speed_ref.y <= -b2_gh_max_speed_ref.y) { + b2_gh_speed_ref.y = -b2_gh_max_speed_ref.y; if (b2_gh_accel_ref.y < 0) b2_gh_accel_ref.y = 0; } - else if (b2_gh_speed_ref.y >= B2_GH_MAX_SPEED) { - b2_gh_speed_ref.y = B2_GH_MAX_SPEED; + else if (b2_gh_speed_ref.y >= b2_gh_max_speed_ref.y) { + b2_gh_speed_ref.y = b2_gh_max_speed_ref.y; if (b2_gh_accel_ref.y > 0) b2_gh_accel_ref.y = 0; } From c0da3885e12a08f1b073b613142d1f4255f10678 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 26 Mar 2013 11:15:56 +0100 Subject: [PATCH 083/109] [rotorcraft] guidance_h_ref: cleanup comments, indentation, trailing whitespaces --- .../rotorcraft/guidance/guidance_h_ref.h | 105 ++++++++++-------- 1 file changed, 58 insertions(+), 47 deletions(-) diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h index 357f14fe85..b70c12d7cf 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h @@ -1,5 +1,5 @@ /* - * Copyright (C) 2008-2009 ENAC + * Copyright (C) 2008-2013 The Paparazzi Team * * This file is part of paparazzi. * @@ -19,7 +19,7 @@ * Boston, MA 02111-1307, USA. */ -/** @file firmware/rotorcraft/guidance/guidance_h_ref.h +/** @file firmwares/rotorcraft/guidance/guidance_h_ref.h * Reference generation for horizontal guidance. * */ @@ -36,41 +36,50 @@ #define B2_GH_FREQ_FRAC 9 #define B2_GH_FREQ (1<= b2_gh_max_accel_ref.y) { b2_gh_accel_ref.y = b2_gh_max_accel_ref.y; } - + /* Saturate speed and adjust acceleration accordingly */ if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; @@ -201,22 +212,22 @@ static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { /* Compute route reference before saturation */ // use metric precision or values are too large - INT32_ATAN2(route_ref,-speed_sp.y,-speed_sp.x); + INT32_ATAN2(route_ref, -speed_sp.y, -speed_sp.x); /* Compute North and East route components */ PPRZ_ITRIG_SIN(s_route_ref, route_ref); PPRZ_ITRIG_COS(c_route_ref, route_ref); - c_route_ref=abs(c_route_ref); - s_route_ref=abs(s_route_ref); - - /* Compute maximum acceleration*/ - b2_gh_max_accel_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,c_route_ref,INT32_TRIG_FRAC); - b2_gh_max_accel_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL,s_route_ref,INT32_TRIG_FRAC); - /* Compute maximum speed*/ - b2_gh_max_speed_ref.x= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,c_route_ref,INT32_TRIG_FRAC); - b2_gh_max_speed_ref.y= INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED,s_route_ref,INT32_TRIG_FRAC); + c_route_ref = abs(c_route_ref); + s_route_ref = abs(s_route_ref); + + /* Compute maximum acceleration*/ + b2_gh_max_accel_ref.x = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL, c_route_ref, INT32_TRIG_FRAC); + b2_gh_max_accel_ref.y = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL, s_route_ref, INT32_TRIG_FRAC); + /* Compute maximum speed*/ + b2_gh_max_speed_ref.x = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED, c_route_ref, INT32_TRIG_FRAC); + b2_gh_max_speed_ref.y = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED, s_route_ref, INT32_TRIG_FRAC); /* restore b2_gh_speed_ref range (Q14.17) */ - INT32_VECT2_LSHIFT(b2_gh_max_speed_ref, b2_gh_max_speed_ref,B2_GH_SPEED_REF_FRAC - B2_GH_MAX_SPEED_REF_FRAC); - + INT32_VECT2_LSHIFT(b2_gh_max_speed_ref, b2_gh_max_speed_ref, (B2_GH_SPEED_REF_FRAC - B2_GH_MAX_SPEED_REF_FRAC)); + /* Saturate accelerations */ if (b2_gh_accel_ref.x <= -b2_gh_max_accel_ref.x) { b2_gh_accel_ref.x = -b2_gh_max_accel_ref.x; @@ -232,7 +243,7 @@ static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { } /* Saturate speed and adjust acceleration accordingly */ - if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { + if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; if (b2_gh_accel_ref.x < 0) b2_gh_accel_ref.x = 0; From 0b3f40aeaa876145a784aed20f2441ad578b6d43 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Tue, 26 Mar 2013 11:58:07 +0100 Subject: [PATCH 084/109] [sim] ivy_transport: don't add trailing space to ivy messages --- sw/airborne/arch/sim/ivy_transport.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/airborne/arch/sim/ivy_transport.h b/sw/airborne/arch/sim/ivy_transport.h index 8d416e89e9..219e6cafa9 100644 --- a/sw/airborne/arch/sim/ivy_transport.h +++ b/sw/airborne/arch/sim/ivy_transport.h @@ -10,7 +10,7 @@ extern char* ivy_p; #define IvyTransportHeader(_dev,len) ivy_p=ivy_buf; -#define IvyTransportTrailer(_dev) { *ivy_p = '\0'; IvySendMsg("%s",ivy_buf); } +#define IvyTransportTrailer(_dev) { *(--ivy_p) = '\0'; IvySendMsg("%s",ivy_buf); } #define IvyTransportPutUint8(_dev,x) { ivy_p += sprintf(ivy_p, "%u ", x); } #define IvyTransportPutNamedUint8(_dev,_name, _x) { ivy_p += sprintf(ivy_p, "%s ", _name); } From fc82e6bb15c17734c983cecbb9cf8a9f720e089d Mon Sep 17 00:00:00 2001 From: Stephen Dwyer Date: Tue, 26 Mar 2013 14:03:06 -0600 Subject: [PATCH 085/109] [joystick] need to statically link on OS X for the SDL joystick functionality unfortunately --- sw/ground_segment/joystick/Makefile | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/sw/ground_segment/joystick/Makefile b/sw/ground_segment/joystick/Makefile index 6cd13ca02d..ce13743102 100644 --- a/sw/ground_segment/joystick/Makefile +++ b/sw/ground_segment/joystick/Makefile @@ -46,13 +46,25 @@ GLIB_LDFLAGS = $(shell pkg-config glib-2.0 --libs) -lglibivy # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want SDL_LDIRS = $(shell pkg-config sdl --libs-only-L) SDL_LIBS = -lSDL -SDL_LDFLAGS = $(SDL_LDIRS) $(SDL_LIBS) +# we do however need -lSDLmain for test_stick, which is just c +SDL_LDFLAGS = $(shell sdl-config --libs) # apparently on OSX `sdl-config --libs` also has -lSDLmain which we don't want ML_SDL_LFLAGS = $(foreach u,$(SDL_LDIRS),-ccopt $(u)) $(foreach u,$(SDL_LIBS),-cclib $(u)) libSDL.so ML_SDL_LFLAGS += -dllpath ${PAPARAZZI_SRC}/sw/ground_segment/joystick INCLUDES += -I $(shell ocamlc -where) +SDL_STICK_DEPS = sdl_stick.o ml_sdl_stick.o +# apparently on OSX you cannot dynamically link with SDL, see ocamlsdl readme +UNAME = $(shell uname -s) + +ifeq ("$(UNAME)","Darwin") + ML_SDL_OCAMLFLAGS = -custom + INPUT2IVY_DEPS = $(SDL_STICK_DEPS) input2ivy.cmo +else + ML_SDL_OCAMLFLAGS = + INPUT2IVY_DEPS = sdl_stick.so input2ivy.cmo +endif all: test_stick input2ivy @@ -60,14 +72,14 @@ test_stick: test_sdl_stick.o @echo BUILD $@ $(Q)$(CC) -g -O2 -DSTICK_DBG $(GLIB_CFLAGS) -o $@ $^ sdl_stick.c $(GLIB_LDFLAGS) $(SDL_LDFLAGS) -input2ivy: sdl_stick.so input2ivy.cmo +input2ivy: $(INPUT2IVY_DEPS) @echo OL $@ - $(Q)$(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_LFLAGS) + $(Q)$(OCAMLC) $(OCAMLINCLUDES) -o $@ $(LINKPKG) $(TOOLSDIR)/fp_proc.cmo $^ $(ML_SDL_OCAMLFLAGS) $(ML_SDL_LFLAGS) # dependency of input2ivy input2ivy: $(TOOLSDIR)/fp_proc.cmo -sdl_stick.so : sdl_stick.o ml_sdl_stick.o +sdl_stick.so : $(SDL_STICK_DEPS) @echo BUILD $@ $(Q)$(CC) -shared -o $@ $^ From cf14957de89eb466460f81ebb73e3428767d693e Mon Sep 17 00:00:00 2001 From: Stephen Dwyer Date: Tue, 26 Mar 2013 14:06:42 -0600 Subject: [PATCH 086/109] [sim] need to include path to caml/*.h files for compiling c files on OS X --- sw/simulator/Makefile | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/sw/simulator/Makefile b/sw/simulator/Makefile index d12a3eb96c..8875deef01 100644 --- a/sw/simulator/Makefile +++ b/sw/simulator/Makefile @@ -48,6 +48,13 @@ AIRBORNE = ../airborne VARINCLUDE=$(PAPARAZZI_HOME)/var/include ACINCLUDE = $(PAPARAZZI_HOME)/var/$(AIRCRAFT) +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + CAML_CFLAGS = -I/opt/local/lib/ocaml +else + CAML_CFLAGS = +endif + all : gaia sitl.cma simhitl @@ -81,7 +88,7 @@ diffusion : stdlib.cmo diffusion.cmo %.o : %.c @echo CC $< - $(Q)$(CC) $(FPIC) -c $< + $(Q)$(CC) $(FPIC) -c $< $(CAML_CFLAGS) %.cmx : %.ml @echo OOC $< From e06a57717a86cb73415a68512f0e2245a024a6e1 Mon Sep 17 00:00:00 2001 From: Stephen Dwyer Date: Tue, 26 Mar 2013 14:10:16 -0600 Subject: [PATCH 087/109] [makefile] on os x the default mktemp doesn't behave the same (older version), need to use gmktemp from the coreutils macport --- Makefile | 24 ++++++++++++++++-------- Makefile.ac | 23 +++++++++++++++-------- data/maps/Makefile | 9 ++++++++- sw/in_progress/button/Makefile | 9 ++++++++- sw/lib/ocaml/Makefile | 14 ++++++++++---- sw/logalizer/Makefile | 9 ++++++++- sw/supervision/Makefile | 11 +++++++++-- 7 files changed, 74 insertions(+), 25 deletions(-) diff --git a/Makefile b/Makefile index 4f313de206..55a4289af0 100644 --- a/Makefile +++ b/Makefile @@ -45,6 +45,14 @@ OCAML=$(shell which ocaml) OCAMLRUN=$(shell which ocamlrun) BUILD_DATETIME:=$(shell date +%Y%m%d-%H%M%S) +# default mktemp in OS X doesn't work, use gmktemp with macports coreutils +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + # # define some paths # @@ -155,7 +163,7 @@ static_h: $(GEN_HEADERS) $(MESSAGES_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< telemetry > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -163,49 +171,49 @@ $(MESSAGES_H) : $(MESSAGES_XML) tools $(MESSAGES2_H) : $(MESSAGES_XML) tools $(Q)test -d $(STATICINCLUDE) || mkdir -p $(STATICINCLUDE) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< telemetry > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(UBX_PROTOCOL_H) : $(UBX_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_ubx.out $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(MTK_PROTOCOL_H) : $(MTK_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_mtk.out $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(XSENS_PROTOCOL_H) : $(XSENS_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_xsens.out $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(DL_PROTOCOL_H) : $(MESSAGES_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages.out $< datalink > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(DL_PROTOCOL2_H) : $(MESSAGES_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_messages2.out $< datalink > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ $(ABI_MESSAGES_H) : $(MESSAGES_XML) tools @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)PAPARAZZI_SRC=$(PAPARAZZI_SRC) PAPARAZZI_HOME=$(PAPARAZZI_HOME) $(TOOLS)/gen_abi.out $< airborne > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ diff --git a/Makefile.ac b/Makefile.ac index 64f79c35f2..f9a91ff083 100644 --- a/Makefile.ac +++ b/Makefile.ac @@ -49,6 +49,13 @@ MODULES_DIR=$(PAPARAZZI_HOME)/conf/modules/ AUTOPILOT_H=$(AC_GENERATED)/autopilot_core.h AIRCRAFT_MD5=$(AIRCRAFT_CONF_DIR)/aircraft.md5 +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + # "make Q=''" to get full echo Q=@ @@ -87,7 +94,7 @@ makefile_ac: $(MAKEFILE_AC) $(AIRFRAME_H) : $(CONF)/$(AIRFRAME_XML) $(CONF_XML) $(AIRCRAFT_MD5) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_airframe.out $(AC_ID) $(AIRCRAFT) $(MD5SUM) $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -96,7 +103,7 @@ $(AIRFRAME_H) : $(CONF)/$(AIRFRAME_XML) $(CONF_XML) $(AIRCRAFT_MD5) $(RADIO_H) : $(CONF)/$(RADIO) $(CONF_XML) $(TOOLS)/gen_radio.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_radio.out $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -105,7 +112,7 @@ $(RADIO_H) : $(CONF)/$(RADIO) $(CONF_XML) $(TOOLS)/gen_radio.out $(PERIODIC_H) : $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF_XML) $(CONF)/$(TELEMETRY) $(MAKEFILE_AC) $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_periodic.out $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF)/$(TELEMETRY) $(TELEMETRY_FREQUENCY) $(SETTINGS_TELEMETRY) > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -114,7 +121,7 @@ $(PERIODIC_H) : $(CONF)/$(AIRFRAME_XML) $(MESSAGES_XML) $(CONF_XML) $(CONF)/$(TE $(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_flight_plan.out $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -122,7 +129,7 @@ $(FLIGHT_PLAN_H) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.o $(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan.out @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_flight_plan.out -dump $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -130,7 +137,7 @@ $(FLIGHT_PLAN_XML) : $(CONF)/$(FLIGHT_PLAN) $(CONF_XML) $(TOOLS)/gen_flight_plan $(SETTINGS_H) : $(SETTINGS_XMLS) $(CONF_XML) $(SETTINGS_MODULES) $(SETTINGS_TELEMETRY) $(TOOLS)/gen_settings.out $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_settings.out $(SETTINGS_XML) $(SETTINGS_TELEMETRY) $(SETTINGS_XMLS) $(SETTINGS_MODULES) > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -139,7 +146,7 @@ $(SETTINGS_H) : $(SETTINGS_XMLS) $(CONF_XML) $(SETTINGS_MODULES) $(SETTINGS_TELE $(MODULES_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_modules.out $(CONF)/modules/*.xml $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_modules.out $(SETTINGS_MODULES) $< > $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ @@ -147,7 +154,7 @@ $(MODULES_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_modules.out $(CONF)/modules/ $(AUTOPILOT_H) : $(CONF)/$(AIRFRAME_XML) $(TOOLS)/gen_autopilot.out $(CONF)/autopilot/*.xml $(Q)test -d $(AC_GENERATED) || mkdir -p $(AC_GENERATED) @echo GENERATE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)$(TOOLS)/gen_autopilot.out $(CONF)/$(AIRFRAME_XML) $($@_TMP) $(Q)mv $($@_TMP) $@ $(Q)chmod a+r $@ diff --git a/data/maps/Makefile b/data/maps/Makefile index 2fe5289a7c..13c26a90c6 100644 --- a/data/maps/Makefile +++ b/data/maps/Makefile @@ -3,6 +3,13 @@ DATADIR = $(PAPARAZZI_HOME)/conf/maps_data Q=@ +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + all: $(PAPARAZZI_HOME)/conf/maps.xml clean: @@ -22,7 +29,7 @@ $(DATADIR)/maps.google.com: $(DATADIR) FORCE $(PAPARAZZI_HOME)/conf/maps.xml: $(DATADIR)/maps.google.com $(eval GOOGLE_VERSION := $(shell grep -E "http://khm[0-9]+.google.com/kh/v=[0-9]+.x26" $(DATADIR)/maps.google.com | sed -E 's#.*http://khm[0-9]+.google.com/kh/v=##;s#.x26.*##')) - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) @echo "Updated google maps version to $(GOOGLE_VERSION)" @echo "-----------------------------------------------" $(Q)echo "" > $($@_TMP) diff --git a/sw/in_progress/button/Makefile b/sw/in_progress/button/Makefile index 93edc272b0..bfec52d75c 100644 --- a/sw/in_progress/button/Makefile +++ b/sw/in_progress/button/Makefile @@ -53,9 +53,16 @@ plot : ../../lib/ocaml/lib-pprz.cmxa export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + gtk_export.ml : export.glade @echo GLADE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)grep -v invisible_char $< > $($@_TMP) $(Q)lablgladecc2 -root export -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ $(Q)rm -f $($@_TMP) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index bd8ed60744..b6f9bbca17 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -143,31 +143,37 @@ expr_lexer.cmi : expr_lexer.ml expr_syntax.cmi expr_lexer.cmo : expr_lexer.cmi expr_syntax.cmo : expr_syntax.cmi +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif gtk_papget_editor.ml : widgets.glade @echo GLADE $@ - $(eval $@_TMP := $(shell mktemp)) + $(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)) + $(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)) + $(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)) + $(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) diff --git a/sw/logalizer/Makefile b/sw/logalizer/Makefile index c4e4b38b02..61fbc6e9e6 100644 --- a/sw/logalizer/Makefile +++ b/sw/logalizer/Makefile @@ -78,9 +78,16 @@ openlog2tlm: openlog2tlm.c export.cmo : gtk_export.cmo export.cmx : gtk_export.cmx +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + gtk_export.ml : export.glade @echo GLADE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)grep -v invisible_char $< > $($@_TMP) $(Q)lablgladecc2 -root export -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ $(Q)rm -f $($@_TMP) diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 92f8bbb95b..65cef26fa3 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -31,6 +31,13 @@ XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp +else + MKTEMP = mktemp +endif + all: paparazzicenter paparazzicenter : $(PAPARAZZICENTERCMO) @@ -39,14 +46,14 @@ paparazzicenter : $(PAPARAZZICENTERCMO) gtk_pc.ml : paparazzicenter.glade @echo GLADE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)grep -v invisible_char $< > $($@_TMP) $(Q)lablgladecc2 -hide-default -root window $($@_TMP) > $@ $(Q)rm -f $($@_TMP) gtk_process.ml : paparazzicenter.glade @echo GLADE $@ - $(eval $@_TMP := $(shell mktemp)) + $(eval $@_TMP := $(shell $(MKTEMP))) $(Q)grep -v invisible_char $< > $($@_TMP) $(Q)lablgladecc2 -hide-default -root hbox_program $($@_TMP) | grep -B 1000000 " end" > $@ $(Q)rm -f $($@_TMP) From 95a77c90df8494ded0dfafa281c2ad87168a3e80 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Wed, 27 Mar 2013 10:15:00 +0100 Subject: [PATCH 088/109] [server] fix name for gaz_mode in server_globals to match messages.xml --- sw/ground_segment/tmtc/server_globals.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sw/ground_segment/tmtc/server_globals.ml b/sw/ground_segment/tmtc/server_globals.ml index 0d81357ce9..0343eda05c 100644 --- a/sw/ground_segment/tmtc/server_globals.ml +++ b/sw/ground_segment/tmtc/server_globals.ml @@ -6,7 +6,7 @@ let hostname = ref "localhost" let fixedwing_ap_modes = [|"MANUAL";"AUTO1";"AUTO2";"HOME";"NOGPS";"FAIL"|] let rotorcraft_ap_modes = [|"SAFE";"KILL";"RATE";"ATT";"R_RCC";"A_RCC";"ATT_C";"R_ZH";"A_ZH";"HOVER";"HOV_C";"H_ZH";"NAV";"RC_D";"CF"|] let _AUTO2 = 2 -let gaz_modes = [|"MANUAL";"GAZ";"CLIMB";"ALT"|] +let gaz_modes = [|"MANUAL";"THROTTLE";"CLIMB";"ALT"|] let lat_modes = [|"MANUAL";"ROLL_RATE";"ROLL";"COURSE"|] let gps_modes = [|"NOFIX";"DRO";"2D";"3D";"GPSDRO"|] let state_filter_modes = [|"UNKNOWN";"INIT";"ALIGN";"OK";"GPS_LOST";"IMU_LOST";"COV_ERR";"IR_CONTRAST";"ERROR"|] From cdbfcb47d755515651e30bd3e6bef3b3aae63292 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Wed, 27 Mar 2013 11:06:57 +0100 Subject: [PATCH 089/109] [guidance] split h_ref and v_ref into h and c files --- conf/firmwares/rotorcraft.makefile | 2 + .../booz_stabilization_int.makefile | 2 + .../subsystems/rotorcraft/fdm_jsbsim.makefile | 2 + .../rotorcraft/guidance/guidance_h.c | 12 +- .../rotorcraft/guidance/guidance_h_ref.c | 244 ++++++++++++++++++ .../rotorcraft/guidance/guidance_h_ref.h | 230 +---------------- .../rotorcraft/guidance/guidance_v.c | 1 - .../rotorcraft/guidance/guidance_v_ref.c | 151 +++++++++++ .../rotorcraft/guidance/guidance_v_ref.h | 120 +-------- 9 files changed, 425 insertions(+), 339 deletions(-) create mode 100644 sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.c create mode 100644 sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.c diff --git a/conf/firmwares/rotorcraft.makefile b/conf/firmwares/rotorcraft.makefile index a1d843231e..9dce60427f 100644 --- a/conf/firmwares/rotorcraft.makefile +++ b/conf/firmwares/rotorcraft.makefile @@ -239,7 +239,9 @@ ap.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c ap.CFLAGS += -DUSE_NAVIGATION ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +ap.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c # # INS choice diff --git a/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile b/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile index ece85d0f60..53d7b44202 100644 --- a/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile +++ b/conf/firmwares/subsystems/lisa_passthrough/booz_stabilization_int.makefile @@ -5,7 +5,9 @@ stm_passthrough.srcs += $(SRC_FIRMWARE)/stabilization.c stm_passthrough.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_rate.c stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +stm_passthrough.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c stm_passthrough.CFLAGS += -DUSE_NAVIGATION stm_passthrough.srcs += $(SRC_SUBSYSTEMS)/ins.c diff --git a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile index 0272f455b0..f4b19af9fa 100644 --- a/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile +++ b/conf/firmwares/subsystems/rotorcraft/fdm_jsbsim.makefile @@ -113,7 +113,9 @@ nps.srcs += $(SRC_FIRMWARE)/stabilization/stabilization_none.c nps.CFLAGS += -DUSE_NAVIGATION nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_h.c +nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_h_ref.c nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_v.c +nps.srcs += $(SRC_FIRMWARE)/guidance/guidance_v_ref.c # # INS choice diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c index 8e72a4899f..dc42506ed8 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h.c @@ -24,8 +24,6 @@ * */ -#define GUIDANCE_H_C - #include "firmwares/rotorcraft/guidance/guidance_h.h" #include "firmwares/rotorcraft/stabilization.h" @@ -84,7 +82,7 @@ static inline void guidance_h_hover_enter(void); static inline void guidance_h_nav_enter(void); #define GuidanceHSetRef(_pos, _speed, _accel) { \ - b2_gh_set_ref(_pos, _speed, _accel); \ + gh_set_ref(_pos, _speed, _accel); \ VECT2_COPY(guidance_h_pos_ref, _pos); \ VECT2_COPY(guidance_h_speed_ref, _speed); \ VECT2_COPY(guidance_h_accel_ref, _accel); \ @@ -242,10 +240,10 @@ void guidance_h_run(bool_t in_flight) { static inline void guidance_h_update_reference(bool_t use_ref) { /* convert our reference to generic representation */ if (use_ref) { - b2_gh_update_ref_from_pos_sp(guidance_h_pos_sp); - INT32_VECT2_RSHIFT(guidance_h_pos_ref, b2_gh_pos_ref, (B2_GH_POS_REF_FRAC - INT32_POS_FRAC)); - INT32_VECT2_LSHIFT(guidance_h_speed_ref, b2_gh_speed_ref, (INT32_SPEED_FRAC - B2_GH_SPEED_REF_FRAC)); - INT32_VECT2_LSHIFT(guidance_h_accel_ref, b2_gh_accel_ref, (INT32_ACCEL_FRAC - B2_GH_ACCEL_REF_FRAC)); + gh_update_ref_from_pos_sp(guidance_h_pos_sp); + INT32_VECT2_RSHIFT(guidance_h_pos_ref, gh_pos_ref, (GH_POS_REF_FRAC - INT32_POS_FRAC)); + INT32_VECT2_LSHIFT(guidance_h_speed_ref, gh_speed_ref, (INT32_SPEED_FRAC - GH_SPEED_REF_FRAC)); + INT32_VECT2_LSHIFT(guidance_h_accel_ref, gh_accel_ref, (INT32_ACCEL_FRAC - GH_ACCEL_REF_FRAC)); } else { VECT2_COPY(guidance_h_pos_ref, guidance_h_pos_sp); INT_VECT2_ZERO(guidance_h_speed_ref); diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.c new file mode 100644 index 0000000000..1542f639fc --- /dev/null +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.c @@ -0,0 +1,244 @@ +/* + * Copyright (C) 2008-2013 The Paparazzi Team + * + * 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. + */ + +/** @file firmwares/rotorcraft/guidance/guidance_h_ref.c + * Reference generation for horizontal guidance. + * + */ + +#include "firmwares/rotorcraft/guidance/guidance_h_ref.h" +#include "generated/airframe.h" + +/** Reference model acceleration. + * in meters/sec2 (output) + * fixed point representation: Q23.8 + * accuracy 0.0039, range 8388km/s2 + */ +struct Int32Vect2 gh_accel_ref; + +/** Reference model speed. + * in meters/sec + * with fixedpoint representation: Q14.17 + * accuracy 0.0000076 , range 16384m/s + */ +struct Int32Vect2 gh_speed_ref; + +/* Reference model position. + * in meters + * with fixedpoint representation: Q37.26 + */ +struct Int64Vect2 gh_pos_ref; + +/** Accel saturation. + * tanf(RadOfDeg(30.))*9.81 = 5.66 + */ +#ifndef GUIDANCE_H_REF_MAX_ACCEL +#define GUIDANCE_H_REF_MAX_ACCEL 5.66 +#endif +#define GH_MAX_ACCEL BFP_OF_REAL(GUIDANCE_H_REF_MAX_ACCEL, GH_ACCEL_REF_FRAC) + +/** Speed saturation */ +#ifndef GUIDANCE_H_REF_MAX_SPEED +#define GUIDANCE_H_REF_MAX_SPEED 5. +#endif +/** @todo GH_MAX_SPEED must be limited to 2^14 to avoid overflow */ +#define GH_MAX_SPEED_REF_FRAC 7 +#define GH_MAX_SPEED BFP_OF_REAL(GUIDANCE_H_REF_MAX_SPEED, GH_MAX_SPEED_REF_FRAC) + +/** second order model natural frequency */ +#ifndef GUIDANCE_H_REF_OMEGA +#define GUIDANCE_H_REF_OMEGA RadOfDeg(67.) +#endif +/** second order model damping */ +#ifndef GUIDANCE_H_REF_ZETA +#define GUIDANCE_H_REF_ZETA 0.85 +#endif +#define GH_ZETA_OMEGA_FRAC 10 +#define GH_ZETA_OMEGA BFP_OF_REAL((GUIDANCE_H_REF_ZETA*GUIDANCE_H_REF_OMEGA), GH_ZETA_OMEGA_FRAC) +#define GH_OMEGA_2_FRAC 7 +#define GH_OMEGA_2 BFP_OF_REAL((GUIDANCE_H_REF_OMEGA*GUIDANCE_H_REF_OMEGA), GH_OMEGA_2_FRAC) + +/** first order time constant */ +#define GH_REF_THAU_F 0.5 +#define GH_REF_INV_THAU_FRAC 16 +#define GH_REF_INV_THAU BFP_OF_REAL((1./GH_REF_THAU_F), GH_REF_INV_THAU_FRAC) + +static struct Int32Vect2 gh_max_speed_ref; +static struct Int32Vect2 gh_max_accel_ref; + +static int32_t route_ref; +static int32_t s_route_ref; +static int32_t c_route_ref; + +void gh_set_ref(struct Int32Vect2 pos, struct Int32Vect2 speed, struct Int32Vect2 accel) { + struct Int64Vect2 new_pos; + new_pos.x = ((int64_t)pos.x)<<(GH_POS_REF_FRAC - INT32_POS_FRAC); + new_pos.y = ((int64_t)pos.y)<<(GH_POS_REF_FRAC - INT32_POS_FRAC); + gh_pos_ref = new_pos; + INT32_VECT2_RSHIFT(gh_speed_ref, speed, (INT32_SPEED_FRAC - GH_SPEED_REF_FRAC)); + INT32_VECT2_RSHIFT(gh_accel_ref, accel, (INT32_ACCEL_FRAC - GH_ACCEL_REF_FRAC)); +} + +void gh_update_ref_from_pos_sp(struct Int32Vect2 pos_sp) { + + VECT2_ADD(gh_pos_ref, gh_speed_ref); + VECT2_ADD(gh_speed_ref, gh_accel_ref); + + // compute the "speed part" of accel = -2*zeta*omega*speed -omega^2(pos - pos_sp) + struct Int32Vect2 speed; + INT32_VECT2_RSHIFT(speed, gh_speed_ref, (GH_SPEED_REF_FRAC - GH_ACCEL_REF_FRAC)); + VECT2_SMUL(speed, speed, -2*GH_ZETA_OMEGA); + INT32_VECT2_RSHIFT(speed, speed, GH_ZETA_OMEGA_FRAC); + // compute pos error in pos_sp resolution + struct Int32Vect2 pos_err; + INT32_VECT2_RSHIFT(pos_err, gh_pos_ref, (GH_POS_REF_FRAC - INT32_POS_FRAC)); + VECT2_DIFF(pos_err, pos_err, pos_sp); + // convert to accel resolution + INT32_VECT2_RSHIFT(pos_err, pos_err, (INT32_POS_FRAC - GH_ACCEL_REF_FRAC)); + // compute the "pos part" of accel + struct Int32Vect2 pos; + VECT2_SMUL(pos, pos_err, (-GH_OMEGA_2)); + INT32_VECT2_RSHIFT(pos, pos, GH_OMEGA_2_FRAC); + // sum accel + VECT2_SUM(gh_accel_ref, speed, pos); + + /* Compute route reference before saturation */ + // use metric precision or values are too large + INT32_ATAN2(route_ref, -pos_err.y, -pos_err.x); + route_ref = abs(route_ref); + /* Compute North and East route components */ + PPRZ_ITRIG_SIN(s_route_ref, route_ref); + PPRZ_ITRIG_COS(c_route_ref, route_ref); + /* Compute maximum acceleration*/ + gh_max_accel_ref.x = INT_MULT_RSHIFT((int32_t)GH_MAX_ACCEL, c_route_ref, INT32_TRIG_FRAC); + gh_max_accel_ref.y = INT_MULT_RSHIFT((int32_t)GH_MAX_ACCEL, s_route_ref, INT32_TRIG_FRAC); + /* Compute maximum speed*/ + gh_max_speed_ref.x = INT_MULT_RSHIFT((int32_t)GH_MAX_SPEED, c_route_ref, INT32_TRIG_FRAC); + gh_max_speed_ref.y = INT_MULT_RSHIFT((int32_t)GH_MAX_SPEED, s_route_ref, INT32_TRIG_FRAC); + /* restore gh_speed_ref range (Q14.17) */ + INT32_VECT2_LSHIFT(gh_max_speed_ref, gh_max_speed_ref, (GH_SPEED_REF_FRAC - GH_MAX_SPEED_REF_FRAC)); + + /* Saturate accelerations */ + if (gh_accel_ref.x <= -gh_max_accel_ref.x) { + gh_accel_ref.x = -gh_max_accel_ref.x; + } + else if (gh_accel_ref.x >= gh_max_accel_ref.x) { + gh_accel_ref.x = gh_max_accel_ref.x; + } + if (gh_accel_ref.y <= -gh_max_accel_ref.y) { + gh_accel_ref.y = -gh_max_accel_ref.y; + } + else if (gh_accel_ref.y >= gh_max_accel_ref.y) { + gh_accel_ref.y = gh_max_accel_ref.y; + } + + /* Saturate speed and adjust acceleration accordingly */ + if (gh_speed_ref.x <= -gh_max_speed_ref.x) { + gh_speed_ref.x = -gh_max_speed_ref.x; + if (gh_accel_ref.x < 0) + gh_accel_ref.x = 0; + } + else if (gh_speed_ref.x >= gh_max_speed_ref.x) { + gh_speed_ref.x = gh_max_speed_ref.x; + if (gh_accel_ref.x > 0) + gh_accel_ref.x = 0; + } + if (gh_speed_ref.y <= -gh_max_speed_ref.y) { + gh_speed_ref.y = -gh_max_speed_ref.y; + if (gh_accel_ref.y < 0) + gh_accel_ref.y = 0; + } + else if (gh_speed_ref.y >= gh_max_speed_ref.y) { + gh_speed_ref.y = gh_max_speed_ref.y; + if (gh_accel_ref.y > 0) + gh_accel_ref.y = 0; + } +} + +void gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { +/* WARNING: SPEED SATURATION UNTESTED */ + VECT2_ADD(gh_pos_ref, gh_speed_ref); + VECT2_ADD(gh_speed_ref, gh_accel_ref); + + // compute speed error + struct Int32Vect2 speed_err; + INT32_VECT2_RSHIFT(speed_err, speed_sp, (INT32_SPEED_FRAC - GH_SPEED_REF_FRAC)); + VECT2_DIFF(speed_err, gh_speed_ref, speed_err); + // convert to accel resolution + INT32_VECT2_RSHIFT(speed_err, speed_err, (GH_SPEED_REF_FRAC - GH_ACCEL_REF_FRAC)); + // compute accel from speed_sp + VECT2_SMUL(gh_accel_ref, speed_err, -GH_REF_INV_THAU); + INT32_VECT2_RSHIFT(gh_accel_ref, gh_accel_ref, GH_REF_INV_THAU_FRAC); + + /* Compute route reference before saturation */ + // use metric precision or values are too large + INT32_ATAN2(route_ref, -speed_sp.y, -speed_sp.x); + route_ref = abs(route_ref); + /* Compute North and East route components */ + PPRZ_ITRIG_SIN(s_route_ref, route_ref); + PPRZ_ITRIG_COS(c_route_ref, route_ref); + + /* Compute maximum acceleration*/ + gh_max_accel_ref.x = INT_MULT_RSHIFT((int32_t)GH_MAX_ACCEL, c_route_ref, INT32_TRIG_FRAC); + gh_max_accel_ref.y = INT_MULT_RSHIFT((int32_t)GH_MAX_ACCEL, s_route_ref, INT32_TRIG_FRAC); + /* Compute maximum speed*/ + gh_max_speed_ref.x = INT_MULT_RSHIFT((int32_t)GH_MAX_SPEED, c_route_ref, INT32_TRIG_FRAC); + gh_max_speed_ref.y = INT_MULT_RSHIFT((int32_t)GH_MAX_SPEED, s_route_ref, INT32_TRIG_FRAC); + /* restore gh_speed_ref range (Q14.17) */ + INT32_VECT2_LSHIFT(gh_max_speed_ref, gh_max_speed_ref, (GH_SPEED_REF_FRAC - GH_MAX_SPEED_REF_FRAC)); + + /* Saturate accelerations */ + if (gh_accel_ref.x <= -gh_max_accel_ref.x) { + gh_accel_ref.x = -gh_max_accel_ref.x; + } + else if (gh_accel_ref.x >= gh_max_accel_ref.x) { + gh_accel_ref.x = gh_max_accel_ref.x; + } + if (gh_accel_ref.y <= -gh_max_accel_ref.y) { + gh_accel_ref.y = -gh_max_accel_ref.y; + } + else if (gh_accel_ref.y >= gh_max_accel_ref.y) { + gh_accel_ref.y = gh_max_accel_ref.y; + } + + /* Saturate speed and adjust acceleration accordingly */ + if (gh_speed_ref.x <= -gh_max_speed_ref.x) { + gh_speed_ref.x = -gh_max_speed_ref.x; + if (gh_accel_ref.x < 0) + gh_accel_ref.x = 0; + } + else if (gh_speed_ref.x >= gh_max_speed_ref.x) { + gh_speed_ref.x = gh_max_speed_ref.x; + if (gh_accel_ref.x > 0) + gh_accel_ref.x = 0; + } + if (gh_speed_ref.y <= -gh_max_speed_ref.y) { + gh_speed_ref.y = -gh_max_speed_ref.y; + if (gh_accel_ref.y < 0) + gh_accel_ref.y = 0; + } + else if (gh_speed_ref.y >= gh_max_speed_ref.y) { + gh_speed_ref.y = gh_max_speed_ref.y; + if (gh_accel_ref.y > 0) + gh_accel_ref.y = 0; + } +} + diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h index b70c12d7cf..ab285baa11 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_h_ref.h @@ -27,244 +27,40 @@ #ifndef GUIDANCE_H_REF_H #define GUIDANCE_H_REF_H -#include "generated/airframe.h" #include "inttypes.h" #include "math/pprz_algebra.h" #include "math/pprz_algebra_int.h" -/* update frequency */ -#define B2_GH_FREQ_FRAC 9 -#define B2_GH_FREQ (1<= b2_gh_max_accel_ref.x) { - b2_gh_accel_ref.x = b2_gh_max_accel_ref.x; - } - if (b2_gh_accel_ref.y <= -b2_gh_max_accel_ref.y) { - b2_gh_accel_ref.y = -b2_gh_max_accel_ref.y; - } - else if (b2_gh_accel_ref.y >= b2_gh_max_accel_ref.y) { - b2_gh_accel_ref.y = b2_gh_max_accel_ref.y; - } - - /* Saturate speed and adjust acceleration accordingly */ - if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { - b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; - if (b2_gh_accel_ref.x < 0) - b2_gh_accel_ref.x = 0; - } - else if (b2_gh_speed_ref.x >= b2_gh_max_speed_ref.x) { - b2_gh_speed_ref.x = b2_gh_max_speed_ref.x; - if (b2_gh_accel_ref.x > 0) - b2_gh_accel_ref.x = 0; - } - if (b2_gh_speed_ref.y <= -b2_gh_max_speed_ref.y) { - b2_gh_speed_ref.y = -b2_gh_max_speed_ref.y; - if (b2_gh_accel_ref.y < 0) - b2_gh_accel_ref.y = 0; - } - else if (b2_gh_speed_ref.y >= b2_gh_max_speed_ref.y) { - b2_gh_speed_ref.y = b2_gh_max_speed_ref.y; - if (b2_gh_accel_ref.y > 0) - b2_gh_accel_ref.y = 0; - } -} - -static inline void b2_gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp) { -/* WARNING: SPEED SATURATION UNTESTED */ - VECT2_ADD(b2_gh_pos_ref, b2_gh_speed_ref); - VECT2_ADD(b2_gh_speed_ref, b2_gh_accel_ref); - - // compute speed error - struct Int32Vect2 speed_err; - INT32_VECT2_RSHIFT(speed_err, speed_sp, (INT32_SPEED_FRAC - B2_GH_SPEED_REF_FRAC)); - VECT2_DIFF(speed_err, b2_gh_speed_ref, speed_err); - // convert to accel resolution - INT32_VECT2_RSHIFT(speed_err, speed_err, (B2_GH_SPEED_REF_FRAC - B2_GH_ACCEL_REF_FRAC)); - // compute accel from speed_sp - VECT2_SMUL(b2_gh_accel_ref, speed_err, -B2_GH_REF_INV_THAU); - INT32_VECT2_RSHIFT(b2_gh_accel_ref, b2_gh_accel_ref, B2_GH_REF_INV_THAU_FRAC); - - /* Compute route reference before saturation */ - // use metric precision or values are too large - INT32_ATAN2(route_ref, -speed_sp.y, -speed_sp.x); - /* Compute North and East route components */ - PPRZ_ITRIG_SIN(s_route_ref, route_ref); - PPRZ_ITRIG_COS(c_route_ref, route_ref); - c_route_ref = abs(c_route_ref); - s_route_ref = abs(s_route_ref); - - /* Compute maximum acceleration*/ - b2_gh_max_accel_ref.x = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL, c_route_ref, INT32_TRIG_FRAC); - b2_gh_max_accel_ref.y = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_ACCEL, s_route_ref, INT32_TRIG_FRAC); - /* Compute maximum speed*/ - b2_gh_max_speed_ref.x = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED, c_route_ref, INT32_TRIG_FRAC); - b2_gh_max_speed_ref.y = INT_MULT_RSHIFT((int32_t)B2_GH_MAX_SPEED, s_route_ref, INT32_TRIG_FRAC); - /* restore b2_gh_speed_ref range (Q14.17) */ - INT32_VECT2_LSHIFT(b2_gh_max_speed_ref, b2_gh_max_speed_ref, (B2_GH_SPEED_REF_FRAC - B2_GH_MAX_SPEED_REF_FRAC)); - - /* Saturate accelerations */ - if (b2_gh_accel_ref.x <= -b2_gh_max_accel_ref.x) { - b2_gh_accel_ref.x = -b2_gh_max_accel_ref.x; - } - else if (b2_gh_accel_ref.x >= b2_gh_max_accel_ref.x) { - b2_gh_accel_ref.x = b2_gh_max_accel_ref.x; - } - if (b2_gh_accel_ref.y <= -b2_gh_max_accel_ref.y) { - b2_gh_accel_ref.y = -b2_gh_max_accel_ref.y; - } - else if (b2_gh_accel_ref.y >= b2_gh_max_accel_ref.y) { - b2_gh_accel_ref.y = b2_gh_max_accel_ref.y; - } - - /* Saturate speed and adjust acceleration accordingly */ - if (b2_gh_speed_ref.x <= -b2_gh_max_speed_ref.x) { - b2_gh_speed_ref.x = -b2_gh_max_speed_ref.x; - if (b2_gh_accel_ref.x < 0) - b2_gh_accel_ref.x = 0; - } - else if (b2_gh_speed_ref.x >= b2_gh_max_speed_ref.x) { - b2_gh_speed_ref.x = b2_gh_max_speed_ref.x; - if (b2_gh_accel_ref.x > 0) - b2_gh_accel_ref.x = 0; - } - if (b2_gh_speed_ref.y <= -b2_gh_max_speed_ref.y) { - b2_gh_speed_ref.y = -b2_gh_max_speed_ref.y; - if (b2_gh_accel_ref.y < 0) - b2_gh_accel_ref.y = 0; - } - else if (b2_gh_speed_ref.y >= b2_gh_max_speed_ref.y) { - b2_gh_speed_ref.y = b2_gh_max_speed_ref.y; - if (b2_gh_accel_ref.y > 0) - b2_gh_accel_ref.y = 0; - } -} - -#endif /* GUIDANCE_H_C */ +extern void gh_set_ref(struct Int32Vect2 pos, struct Int32Vect2 speed, struct Int32Vect2 accel); +extern void gh_update_ref_from_pos_sp(struct Int32Vect2 pos_sp); +extern void gh_update_ref_from_speed_sp(struct Int32Vect2 speed_sp); #endif /* GUIDANCE_H_REF_H */ diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_v.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v.c index 901731e060..2287d88252 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_v.c +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v.c @@ -25,7 +25,6 @@ */ #define GUIDANCE_V_C -#define GUIDANCE_V_USE_REF 1 #include "firmwares/rotorcraft/guidance/guidance_v.h" diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.c b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.c new file mode 100644 index 0000000000..281827bb0b --- /dev/null +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.c @@ -0,0 +1,151 @@ +/* + * Copyright (C) 2008-2009 Antoine Drouin + * Copyright (C) 2013 Gautier Hattenberger + * + * 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. + */ + +/** @file firmwares/rotorcraft/guidance/guidance_v_ref.c + * Reference generation for vertical guidance. + * + */ + +#include "firmwares/rotorcraft/guidance/guidance_v_ref.h" +#include "generated/airframe.h" + +/** reference model vertical accel in meters/s^2 (output) + * fixed point representation with #GV_ZDD_REF_FRAC + * Q23.8 : accuracy 0.0039 , range 8388km/s^2 + */ +int32_t gv_zdd_ref; + +/** reference model vertical speed in meters/sec (output) + * fixed point representation with #GV_ZD_REF_FRAC + * Q14.17 : accuracy 0.0000076 , range 16384m/s2 + */ +int32_t gv_zd_ref; + +/** reference model altitude in meters (output) + * fixed point representation with #GV_Z_REF_FRAC + * Q37.26 : + */ +int64_t gv_z_ref; + + +/* Saturations definition */ +#ifndef GUIDANCE_V_REF_MIN_ZDD +#define GUIDANCE_V_REF_MIN_ZDD (-2.0*9.81) +#endif +#define GV_MIN_ZDD BFP_OF_REAL(GUIDANCE_V_REF_MIN_ZDD, GV_ZDD_REF_FRAC) + +#ifndef GUIDANCE_V_REF_MAX_ZDD +#define GUIDANCE_V_REF_MAX_ZDD ( 0.8*9.81) +#endif +#define GV_MAX_ZDD BFP_OF_REAL(GUIDANCE_V_REF_MAX_ZDD, GV_ZDD_REF_FRAC) + +#ifndef GUIDANCE_V_REF_MIN_ZD +#define GUIDANCE_V_REF_MIN_ZD (-3.) +#endif +#define GV_MIN_ZD BFP_OF_REAL(GUIDANCE_V_REF_MIN_ZD , GV_ZD_REF_FRAC) + +#ifndef GUIDANCE_V_REF_MAX_ZD +#define GUIDANCE_V_REF_MAX_ZD ( 3.) +#endif +#define GV_MAX_ZD BFP_OF_REAL(GUIDANCE_V_REF_MAX_ZD , GV_ZD_REF_FRAC) + +/* second order model natural frequency and damping */ +#ifndef GUIDANCE_V_REF_OMEGA +#define GUIDANCE_V_REF_OMEGA RadOfDeg(100.) +#endif +#ifndef GUIDANCE_V_REF_ZETA +#define GUIDANCE_V_REF_ZETA 0.85 +#endif +#define GV_ZETA_OMEGA_FRAC 10 +#define GV_ZETA_OMEGA BFP_OF_REAL((GUIDANCE_V_REF_ZETA*GUIDANCE_V_REF_OMEGA), GV_ZETA_OMEGA_FRAC) +#define GV_OMEGA_2_FRAC 7 +#define GV_OMEGA_2 BFP_OF_REAL((GUIDANCE_V_REF_OMEGA*GUIDANCE_V_REF_OMEGA), GV_OMEGA_2_FRAC) + +/* first order time constant */ +#define GV_REF_THAU_F 0.25 +#define GV_REF_INV_THAU_FRAC 16 +#define GV_REF_INV_THAU BFP_OF_REAL((1./0.25), GV_REF_INV_THAU_FRAC) + +void gv_set_ref(int32_t alt, int32_t speed, int32_t accel) { + int64_t new_z = ((int64_t)alt)<<(GV_Z_REF_FRAC - INT32_POS_FRAC); + gv_z_ref = new_z; + gv_zd_ref = speed>>(INT32_SPEED_FRAC - GV_ZD_REF_FRAC); + gv_zdd_ref = accel>>(INT32_ACCEL_FRAC - GV_ZDD_REF_FRAC); +} + +void gv_update_ref_from_z_sp(int32_t z_sp) { + + gv_z_ref += gv_zd_ref; + gv_zd_ref += gv_zdd_ref; + + // compute the "speed part" of zdd = -2*zeta*omega*zd -omega^2(z_sp - z) + int32_t zd_zdd_res = gv_zd_ref>>(GV_ZD_REF_FRAC - GV_ZDD_REF_FRAC); + int32_t zdd_speed = ((int32_t)(-2*GV_ZETA_OMEGA)*zd_zdd_res)>>(GV_ZETA_OMEGA_FRAC); + // compute z error in z_sp resolution + int32_t z_err_sp = z_sp - (int32_t)(gv_z_ref>>(GV_Z_REF_FRAC-INT32_POS_FRAC)); + // convert to accel resolution + int32_t z_err_accel = z_err_sp>>(INT32_POS_FRAC-GV_ZDD_REF_FRAC); + int32_t zdd_pos = ((int32_t)(GV_OMEGA_2)*z_err_accel)>>GV_OMEGA_2_FRAC; + gv_zdd_ref = zdd_speed + zdd_pos; + + /* Saturate accelerations */ + Bound(gv_zdd_ref, GV_MIN_ZDD, GV_MAX_ZDD); + + /* Saturate speed and adjust acceleration accordingly */ + if (gv_zd_ref <= GV_MIN_ZD) { + gv_zd_ref = GV_MIN_ZD; + if (gv_zdd_ref < 0) + gv_zdd_ref = 0; + } + else if (gv_zd_ref >= GV_MAX_ZD) { + gv_zd_ref = GV_MAX_ZD; + if (gv_zdd_ref > 0) + gv_zdd_ref = 0; + } +} + + +void gv_update_ref_from_zd_sp(int32_t zd_sp) { + + gv_z_ref += gv_zd_ref; + gv_zd_ref += gv_zdd_ref; + + int32_t zd_err = gv_zd_ref - (zd_sp>>(INT32_SPEED_FRAC - GV_ZD_REF_FRAC)); + int32_t zd_err_zdd_res = zd_err>>(GV_ZD_REF_FRAC-GV_ZDD_REF_FRAC); + gv_zdd_ref = (-(int32_t)GV_REF_INV_THAU * zd_err_zdd_res)>>GV_REF_INV_THAU_FRAC; + + /* Saturate accelerations */ + Bound(gv_zdd_ref, GV_MIN_ZDD, GV_MAX_ZDD); + + /* Saturate speed and adjust acceleration accordingly */ + if (gv_zd_ref <= GV_MIN_ZD) { + gv_zd_ref = GV_MIN_ZD; + if (gv_zdd_ref < 0) + gv_zdd_ref = 0; + } + else if (gv_zd_ref >= GV_MAX_ZD) { + gv_zd_ref = GV_MAX_ZD; + if (gv_zdd_ref > 0) + gv_zdd_ref = 0; + } +} + diff --git a/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.h b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.h index 6a19764159..f462a07a2b 100644 --- a/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.h +++ b/sw/airborne/firmwares/rotorcraft/guidance/guidance_v_ref.h @@ -1,5 +1,6 @@ /* * Copyright (C) 2008-2009 Antoine Drouin + * Copyright (C) 2013 Gautier Hattenberger * * This file is part of paparazzi. * @@ -27,12 +28,12 @@ #ifndef GUIDANCE_V_REF_H #define GUIDANCE_V_REF_H -#include "generated/airframe.h" #include "inttypes.h" #include "math/pprz_algebra.h" #include "math/pprz_algebra_int.h" -/* update frequency */ +/** Update frequency + */ #define GV_FREQ_FRAC 9 #define GV_FREQ (1<>(INT32_SPEED_FRAC - GV_ZD_REF_FRAC); - gv_zdd_ref = accel>>(INT32_ACCEL_FRAC - GV_ZDD_REF_FRAC); -} - -__attribute__ ((always_inline)) static inline void gv_update_ref_from_z_sp(int32_t z_sp) { - - gv_z_ref += gv_zd_ref; - gv_zd_ref += gv_zdd_ref; - - // compute the "speed part" of zdd = -2*zeta*omega*zd -omega^2(z_sp - z) - int32_t zd_zdd_res = gv_zd_ref>>(GV_ZD_REF_FRAC - GV_ZDD_REF_FRAC); - int32_t zdd_speed = ((int32_t)(-2*GV_ZETA_OMEGA)*zd_zdd_res)>>(GV_ZETA_OMEGA_FRAC); - // compute z error in z_sp resolution - int32_t z_err_sp = z_sp - (int32_t)(gv_z_ref>>(GV_Z_REF_FRAC-INT32_POS_FRAC)); - // convert to accel resolution - int32_t z_err_accel = z_err_sp>>(INT32_POS_FRAC-GV_ZDD_REF_FRAC); - int32_t zdd_pos = ((int32_t)(GV_OMEGA_2)*z_err_accel)>>GV_OMEGA_2_FRAC; - gv_zdd_ref = zdd_speed + zdd_pos; - - /* Saturate accelerations */ - Bound(gv_zdd_ref, GV_MIN_ZDD, GV_MAX_ZDD); - - /* Saturate speed and adjust acceleration accordingly */ - if (gv_zd_ref <= GV_MIN_ZD) { - gv_zd_ref = GV_MIN_ZD; - if (gv_zdd_ref < 0) - gv_zdd_ref = 0; - } - else if (gv_zd_ref >= GV_MAX_ZD) { - gv_zd_ref = GV_MAX_ZD; - if (gv_zdd_ref > 0) - gv_zdd_ref = 0; - } -} - - -__attribute__ ((always_inline)) static inline void gv_update_ref_from_zd_sp(int32_t zd_sp) { - - gv_z_ref += gv_zd_ref; - gv_zd_ref += gv_zdd_ref; - - int32_t zd_err = gv_zd_ref - (zd_sp>>(INT32_SPEED_FRAC - GV_ZD_REF_FRAC)); - int32_t zd_err_zdd_res = zd_err>>(GV_ZD_REF_FRAC-GV_ZDD_REF_FRAC); - gv_zdd_ref = (-(int32_t)GV_REF_INV_THAU * zd_err_zdd_res)>>GV_REF_INV_THAU_FRAC; - - /* Saturate accelerations */ - Bound(gv_zdd_ref, GV_MIN_ZDD, GV_MAX_ZDD); - - /* Saturate speed and adjust acceleration accordingly */ - if (gv_zd_ref <= GV_MIN_ZD) { - gv_zd_ref = GV_MIN_ZD; - if (gv_zdd_ref < 0) - gv_zdd_ref = 0; - } - else if (gv_zd_ref >= GV_MAX_ZD) { - gv_zd_ref = GV_MAX_ZD; - if (gv_zdd_ref > 0) - gv_zdd_ref = 0; - } -} - -#endif /* GUIDANCE_V_C */ +extern void gv_set_ref(int32_t alt, int32_t speed, int32_t accel); +extern void gv_update_ref_from_z_sp(int32_t z_sp); +extern void gv_update_ref_from_zd_sp(int32_t zd_sp); #endif /* GUIDANCE_V_REF_H */ From 3ee0791efda313a10e7f22be6769f7aaaea04162 Mon Sep 17 00:00:00 2001 From: Stephen Dwyer Date: Wed, 27 Mar 2013 15:57:13 -0600 Subject: [PATCH 090/109] [makefile] deal with difference in naming of lablgtk2 pkgs between debian and os x --- sw/lib/ocaml/{META.pprz => META.pprz.deb} | 0 sw/lib/ocaml/META.pprz.osx | 14 ++++++++++++ sw/lib/ocaml/Makefile | 27 ++++++++++++++--------- sw/supervision/Makefile | 14 +++++++----- 4 files changed, 39 insertions(+), 16 deletions(-) rename sw/lib/ocaml/{META.pprz => META.pprz.deb} (100%) create mode 100644 sw/lib/ocaml/META.pprz.osx diff --git a/sw/lib/ocaml/META.pprz b/sw/lib/ocaml/META.pprz.deb similarity index 100% rename from sw/lib/ocaml/META.pprz rename to sw/lib/ocaml/META.pprz.deb diff --git a/sw/lib/ocaml/META.pprz.osx b/sw/lib/ocaml/META.pprz.osx new file mode 100644 index 0000000000..bd3c7b33ca --- /dev/null +++ b/sw/lib/ocaml/META.pprz.osx @@ -0,0 +1,14 @@ +description = "Paparazzi UAS package" +requires = "unix,str,xml-light,lablgtk2,glibivy,netclient" +version = "1.0" +directory = "" + +archive(byte) = "lib-pprz.cma" +archive(native) = "lib-pprz.cmxa" + +package "xlib" ( + requires = "pprz,lablgtk2.gnomecanvas,lablgtk2.glade" + version = "1.0" + archive(byte) = "xlib-pprz.cma" + archive(native) = "xlib-pprz.cmxa" +) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index b6f9bbca17..5aea3820d0 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -43,10 +43,21 @@ else FPIC = endif +UNAME = $(shell uname -s) +ifeq ("$(UNAME)","Darwin") + MKTEMP = gmktemp + LABLGTK2GNOMECANVAS = lablgtk2.gnomecanvas + METAFILE = META.pprz.osx +else + MKTEMP = mktemp + LABLGTK2GNOMECANVAS = lablgtk2-gnome.gnomecanvas + METAFILE = META.pprz.deb +endif + INCLUDES= PKGCOMMON=xml-light,netclient,glibivy,lablgtk2 XINCLUDES= -XPKGCOMMON=xml-light,glibivy,lablgtk2-gnome.gnomecanvas,lablgtk2.glade +XPKGCOMMON=xml-light,glibivy,$(LABLGTK2GNOMECANVAS),lablgtk2.glade 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 maps_support.ml gm.ml iGN.ml geometry_2d.ml cserial.o convert.o ubx.ml pprz.ml xbee.ml logpprz.ml xmlCom.ml os_calls.ml editAirframe.ml defivybus.ml CMO = $(SRC:.ml=.cmo) @@ -60,7 +71,7 @@ TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt -opt : lib-pprz.cmxa xlib-pprz.cmxa +opt : lib-pprz.cmxa xlib-pprz.cmxa copyMETA lib-pprz.cma liblib-pprz.a: $(CMO) @@ -143,13 +154,6 @@ expr_lexer.cmi : expr_lexer.ml expr_syntax.cmi expr_lexer.cmo : expr_lexer.cmi expr_syntax.cmo : expr_syntax.cmi -UNAME = $(shell uname -s) -ifeq ("$(UNAME)","Darwin") - MKTEMP = gmktemp -else - MKTEMP = mktemp -endif - gtk_papget_editor.ml : widgets.glade @echo GLADE $@ $(eval $@_TMP := $(shell $(MKTEMP))) @@ -178,9 +182,12 @@ gtk_papget_led_editor.ml : widgets.glade $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ $(Q)rm -f $($@_TMP) +copyMETA : $(METAFILE) + @echo COPY $< + $(shell cp $< META.pprz) clean : - $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli + $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli META.pprz .PHONY: all opt clean diff --git a/sw/supervision/Makefile b/sw/supervision/Makefile index 65cef26fa3..68165d050b 100644 --- a/sw/supervision/Makefile +++ b/sw/supervision/Makefile @@ -25,19 +25,21 @@ Q=@ include ../Makefile.ocaml -INCLUDES = -XPKG = -package pprz.xlib,lablgtk2-gnome.gnomeui -XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib - -PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo - UNAME = $(shell uname -s) ifeq ("$(UNAME)","Darwin") MKTEMP = gmktemp + LABLGTK2GNOMEUI = lablgtk2.gnomeui else MKTEMP = mktemp + LABLGTK2GNOMEUI = lablgtk2-gnome.gnomeui endif +INCLUDES = +XPKG = -package pprz.xlib,$(LABLGTK2GNOMEUI) +XLINKPKG = $(XPKG) -linkpkg -dllpath-pkg pprz.xlib + +PAPARAZZICENTERCMO = gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo + all: paparazzicenter paparazzicenter : $(PAPARAZZICENTERCMO) From 250bf7ff52f018cc2a2c6f78ad6120a497db6222 Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Thu, 28 Mar 2013 17:02:32 +0100 Subject: [PATCH 091/109] [map] loading of maps from cache much faster --- sw/lib/ocaml/gm.ml | 38 +++++++++++++++++++++++++++++++++----- sw/lib/ocaml/gm.mli | 6 +++++- sw/lib/ocaml/mapGoogle.ml | 5 ++++- 3 files changed, 42 insertions(+), 7 deletions(-) diff --git a/sw/lib/ocaml/gm.ml b/sw/lib/ocaml/gm.ml index 73fb6b3efd..83e70b125b 100644 --- a/sw/lib/ocaml/gm.ml +++ b/sw/lib/ocaml/gm.ml @@ -151,7 +151,6 @@ let is_prefix = fun a b -> String.length b >= String.length a && a = String.sub b 0 (String.length a) - (** Get the tile or one which contains it from the cache *) let get_from_cache = fun dir f -> let files = Sys.readdir dir in @@ -171,6 +170,19 @@ let get_from_cache = fun dir f -> in loop 0 +(** Get the tile or one which contains it from the a hash table *) +let get_from_hashtbl = fun tbl key -> + let l = String.length key in + let rec loop = fun i -> + if i = 0 then raise Not_found; + try + let subkey = String.sub key 0 i in + let file = Hashtbl.find tbl subkey in + (tile_of_key subkey, file) + with _ -> loop (i-1) + in + loop l + (** Translate the old quadtree naming policy into new (x,y) coordinates if z is the zoom level, 0 <= x, y < 2^z are the coordinates of the tile *) let xyz_of_qsrt = fun s -> @@ -224,7 +236,7 @@ let url_of_tile_key = fun maps_source s -> let get_cache_dir = function -Google -> !cache_path (* Historic ! Should be // Google *) + Google -> !cache_path (* Historic ! Should be // Google *) | OSM -> !cache_path // "OSM" | MQ -> !cache_path // "MapQuest" | MQ_Aerial -> !cache_path // "MapQuestAerial" @@ -235,7 +247,7 @@ exception Not_available type policy = CacheOrHttp | NoHttp | NoCache let string_of_policy = function -CacheOrHttp -> "CacheOrHttp" + CacheOrHttp -> "CacheOrHttp" | NoHttp -> "NoHttp" | NoCache -> "NoCache" let policies = [CacheOrHttp; NoHttp; NoCache] @@ -248,7 +260,20 @@ let get_policy = fun () -> let remove_last_char = fun s -> String.sub s 0 (String.length s - 1) -let get_image = fun key -> +type hashtbl_cache = (string, string) Hashtbl.t + +let get_hashtbl_of_cache = fun () -> + let cache_dir = get_cache_dir !maps_source in + mkdir cache_dir; + let files = Sys.readdir cache_dir in + let tbl = Hashtbl.create (Array.length files) in + Array.iter (fun e -> + let key = try Filename.chop_extension e with _ -> e in + if key <> "" then Hashtbl.add tbl key (cache_dir // e); + ) files; + tbl + +let get_image = fun ?tbl key -> let cache_dir = get_cache_dir !maps_source in mkdir cache_dir; let rec get_from_http = fun k -> @@ -271,7 +296,10 @@ let get_image = fun key -> in try if !policy = NoCache then raise Not_found; - let (t, f) = get_from_cache cache_dir key in + let (t, f) = match tbl with + | None -> get_from_cache cache_dir key + | Some ht -> get_from_hashtbl ht key + in (* if not exact match from cache, try http if CacheOrHttp policy *) if !policy = CacheOrHttp && (String.length t.key < String.length key) then try get_from_http key with _ -> (t, f) diff --git a/sw/lib/ocaml/gm.mli b/sw/lib/ocaml/gm.mli index e550751dff..bba683f0c4 100644 --- a/sw/lib/ocaml/gm.mli +++ b/sw/lib/ocaml/gm.mli @@ -61,7 +61,11 @@ val get_policy : unit -> policy exception Not_available -val get_image : string -> tile_t * string +type hashtbl_cache = (string, string)Hashtbl.t + +val get_hashtbl_of_cache : unit -> hashtbl_cache + +val get_image : ?tbl:hashtbl_cache -> string -> tile_t * string (** [get_image key] Returns the tile description and the image file name. May raise [Not_available] *) diff --git a/sw/lib/ocaml/mapGoogle.ml b/sw/lib/ocaml/mapGoogle.ml index 4d9b7953c0..c48c6b09c7 100644 --- a/sw/lib/ocaml/mapGoogle.ml +++ b/sw/lib/ocaml/mapGoogle.ml @@ -124,6 +124,9 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> 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 *) @@ -134,7 +137,7 @@ let fill_window = fun (geomap:MapCanvas.widget) zoomlevel -> Tile -> () | Empty -> if zoom = 1 then - let tile, image = Gm.get_image key in + 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)) From f33617510c75de18e3c0966e2df678b6e128fa08 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 19:12:46 +0100 Subject: [PATCH 092/109] add META.pprz to gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 65869e83e6..29c5f3133f 100644 --- a/.gitignore +++ b/.gitignore @@ -118,6 +118,7 @@ /sw/lib/ocaml/expr_parser.mli /sw/lib/ocaml/gtk_papget_led_editor.ml /sw/lib/ocaml/expr_lexer.ml +/sw/lib/ocaml/META.pprz # /sw/logalizer/ /sw/logalizer/plot From cbda7ee819f42268dac7e3c5d33858b3161d718b Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 20:07:48 +0100 Subject: [PATCH 093/109] [makefile] minor improvements for lib/ocaml - separate targets for byte and native libs - replace copyMETA target with META.pprz so it doesn't get copied every time --- sw/lib/ocaml/Makefile | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/sw/lib/ocaml/Makefile b/sw/lib/ocaml/Makefile index 5aea3820d0..63bf561117 100644 --- a/sw/lib/ocaml/Makefile +++ b/sw/lib/ocaml/Makefile @@ -70,8 +70,9 @@ XCMX = $(XSRC:.ml=.cmx) TESTS_SRC = test/test_latlong.ml TESTS_CMO = $(TESTS_SRC:.ml=.cmo) -all : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out opt -opt : lib-pprz.cmxa xlib-pprz.cmxa copyMETA +all : byte native +byte : lib-pprz.cma xlib-pprz.cma myGtkInit.cmo xml_get.out META.pprz +native : lib-pprz.cmxa xlib-pprz.cmxa META.pprz lib-pprz.cma liblib-pprz.a: $(CMO) @@ -96,7 +97,7 @@ lib-pprz.cmxa: | liblib-pprz.a dlllib-pprz.so xlib-pprz.cmxa: | libxlib-pprz.a dllxlib-pprz.so -xml_get.out : lib-pprz.cma xml_get.cmo | opt +xml_get.out : lib-pprz.cma xml_get.cmo @echo OL $@ $(Q)$(OCAMLC) $(INCLUDES) -o $@ -package str,xml-light -linkpkg -I . $^ @@ -182,14 +183,14 @@ gtk_papget_led_editor.ml : widgets.glade $(Q)$(Q)lablgladecc2 -root table_led_editor -hide-default $($@_TMP) | grep -B 1000000 " end" > $@ $(Q)rm -f $($@_TMP) -copyMETA : $(METAFILE) +META.pprz : $(METAFILE) @echo COPY $< $(shell cp $< META.pprz) clean : $(Q)rm -f *~ *.cm* *.out *.opt .depend *.a *.o *.so caml_from_c_example tests gtk_papget_*.ml expr_parser.ml expr_parser.mli expr_lexer.ml expr_lexer.mli META.pprz -.PHONY: all opt clean +.PHONY: all byte native clean # # Dependencies From bf7e5df42a2e04238a3a04458b1944bb149ced4a Mon Sep 17 00:00:00 2001 From: Gautier Hattenberger Date: Tue, 5 Mar 2013 13:56:01 +0100 Subject: [PATCH 094/109] [imu] default settings for navgo imu --- conf/airframes/ENAC/quadrotor/hen1.xml | 1 - .../subsystems/shared/imu_navgo.makefile | 7 ++++++ sw/airborne/boards/navgo/imu_navgo.c | 23 +++++++++++++++++-- 3 files changed, 28 insertions(+), 3 deletions(-) diff --git a/conf/airframes/ENAC/quadrotor/hen1.xml b/conf/airframes/ENAC/quadrotor/hen1.xml index fdcc63192f..78b81b8e0b 100644 --- a/conf/airframes/ENAC/quadrotor/hen1.xml +++ b/conf/airframes/ENAC/quadrotor/hen1.xml @@ -118,7 +118,6 @@
- diff --git a/conf/firmwares/subsystems/shared/imu_navgo.makefile b/conf/firmwares/subsystems/shared/imu_navgo.makefile index 3ab4757bfe..15ca4c4b11 100644 --- a/conf/firmwares/subsystems/shared/imu_navgo.makefile +++ b/conf/firmwares/subsystems/shared/imu_navgo.makefile @@ -14,6 +14,13 @@ IMU_NAVGO_SRCS += peripherals/itg3200.c IMU_NAVGO_SRCS += peripherals/adxl345_i2c.c IMU_NAVGO_SRCS += peripherals/hmc58xx.c +# with default NAVGO_GYRO_SMPLRT_DIV (gyro output 500Hz) +# the AHRS_PROPAGATE_FREQUENCY needs to be adjusted accordingly +AHRS_PROPAGATE_FREQUENCY ?= 500 +AHRS_CORRECT_FREQUENCY ?= 500 +ap.CFLAGS += -DAHRS_PROPAGATE_FREQUENCY=$(AHRS_PROPAGATE_FREQUENCY) +ap.CFLAGS += -DAHRS_CORRECT_FREQUENCY=$(AHRS_CORRECT_FREQUENCY) + ap.CFLAGS += $(IMU_NAVGO_CFLAGS) ap.srcs += $(IMU_NAVGO_SRCS) diff --git a/sw/airborne/boards/navgo/imu_navgo.c b/sw/airborne/boards/navgo/imu_navgo.c index 8eba9bd9b3..00582cfb5e 100644 --- a/sw/airborne/boards/navgo/imu_navgo.c +++ b/sw/airborne/boards/navgo/imu_navgo.c @@ -49,8 +49,19 @@ #endif PRINT_CONFIG_VAR(NAVGO_ACCEL_RATE) +/* default gyro internal lowpass frequency and sample rate divider */ +#if !defined NAVGO_GYRO_LOWPASS && !defined NAVGO_GYRO_SMPLRT_DIV +#define NAVGO_GYRO_LOWPASS ITG3200_DLPF_10HZ +#define NAVGO_GYRO_SMPLRT_DIV 1 +PRINT_CONFIG_MSG("Gyro output rate is 500Hz") +#endif +PRINT_CONFIG_VAR(NAVGO_GYRO_LOWPASS) +PRINT_CONFIG_VAR(NAVGO_GYRO_SMPLRT_DIV) + +#if NAVGO_USE_MEDIAN_FILTER #include "filters/median_filter.h" struct MedianFilter3Int median_gyro, median_accel, median_mag; +#endif struct ImuNavgo imu_navgo; @@ -60,8 +71,8 @@ void imu_impl_init(void) // ITG3200 itg3200_init(&imu_navgo.itg, &(IMU_NAVGO_I2C_DEV), ITG3200_ADDR_ALT); // change the default configuration - imu_navgo.itg.config.smplrt_div = 1; // 500Hz sample rate since internal is 1kHz - imu_navgo.itg.config.dlpf_cfg = ITG3200_DLPF_10HZ; + imu_navgo.itg.config.smplrt_div = NAVGO_GYRO_SMPLRT_DIV; // 500Hz sample rate since internal is 1kHz + imu_navgo.itg.config.dlpf_cfg = NAVGO_GYRO_LOWPASS; ///////////////////////////////////////////////////////////////////// // ADXL345 @@ -73,10 +84,12 @@ void imu_impl_init(void) // HMC58XX hmc58xx_init(&imu_navgo.hmc, &(IMU_NAVGO_I2C_DEV), HMC58XX_ADDR); +#if NAVGO_USE_MEDIAN_FILTER // Init median filters InitMedianFilterRatesInt(median_gyro); InitMedianFilterVect3Int(median_accel); InitMedianFilterVect3Int(median_mag); +#endif imu_navgo.gyr_valid = FALSE; imu_navgo.acc_valid = FALSE; @@ -115,7 +128,9 @@ void imu_navgo_event( void ) itg3200_event(&imu_navgo.itg); if (imu_navgo.itg.data_available) { RATES_ASSIGN(imu.gyro_unscaled, -imu_navgo.itg.data.rates.q, imu_navgo.itg.data.rates.p, imu_navgo.itg.data.rates.r); +#if NAVGO_USE_MEDIAN_FILTER UpdateMedianFilterRatesInt(median_gyro, imu.gyro_unscaled); +#endif imu_navgo.itg.data_available = FALSE; imu_navgo.gyr_valid = TRUE; } @@ -124,7 +139,9 @@ void imu_navgo_event( void ) adxl345_i2c_event(&imu_navgo.adxl); if (imu_navgo.adxl.data_available) { VECT3_ASSIGN(imu.accel_unscaled, imu_navgo.adxl.data.vect.y, -imu_navgo.adxl.data.vect.x, imu_navgo.adxl.data.vect.z); +#if NAVGO_USE_MEDIAN_FILTER UpdateMedianFilterVect3Int(median_accel, imu.accel_unscaled); +#endif imu_navgo.adxl.data_available = FALSE; imu_navgo.acc_valid = TRUE; } @@ -133,7 +150,9 @@ void imu_navgo_event( void ) hmc58xx_event(&imu_navgo.hmc); if (imu_navgo.hmc.data_available) { VECT3_COPY(imu.mag_unscaled, imu_navgo.hmc.data.vect); +#if NAVGO_USE_MEDIAN_FILTER UpdateMedianFilterVect3Int(median_mag, imu.mag_unscaled); +#endif imu_navgo.hmc.data_available = FALSE; imu_navgo.mag_valid = TRUE; } From b5983c3c8f09d46700b508dbd04263b46673075f Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 22:49:18 +0100 Subject: [PATCH 095/109] [sim] fix get settings in NPS and other sims since we directly subscribe to the ivy messages from the GCS, need to listen for GET_DL_SETTING instead of DL_GET_SETTING --- sw/simulator/nps/nps_ivy.c | 2 +- sw/simulator/sim_ac_fw.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/sw/simulator/nps/nps_ivy.c b/sw/simulator/nps/nps_ivy.c index f25ce54d0e..dda8020836 100644 --- a/sw/simulator/nps/nps_ivy.c +++ b/sw/simulator/nps/nps_ivy.c @@ -42,7 +42,7 @@ void nps_ivy_init(char* ivy_bus) { IvyInit(agent_name, ready_msg, NULL, NULL, NULL, NULL); IvyBindMsg(on_DL_PING, NULL, "^(\\S*) DL_PING"); IvyBindMsg(on_DL_SETTING, NULL, "^(\\S*) DL_SETTING (\\S*) (\\S*) (\\S*)"); - IvyBindMsg(on_DL_GET_SETTING, NULL, "^(\\S*) DL_GET_SETTING (\\S*) (\\S*)"); + IvyBindMsg(on_DL_GET_SETTING, NULL, "^(\\S*) GET_DL_SETTING (\\S*) (\\S*)"); IvyBindMsg(on_DL_BLOCK, NULL, "^(\\S*) BLOCK (\\S*) (\\S*)"); IvyBindMsg(on_DL_MOVE_WP, NULL, "^(\\S*) MOVE_WP (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); diff --git a/sw/simulator/sim_ac_fw.c b/sw/simulator/sim_ac_fw.c index 40d04c1387..981bf339c2 100644 --- a/sw/simulator/sim_ac_fw.c +++ b/sw/simulator/sim_ac_fw.c @@ -67,7 +67,7 @@ void sim_autopilot_init(void) { IvyBindMsg(on_DL_PING, NULL, "^(\\S*) DL_PING"); IvyBindMsg(on_DL_ACINFO, NULL, "^(\\S*) DL_ACINFO (\\S*) (\\S*) (\\S* (\\S*) (\\S*) (\\S*)) (\\S*) (\\S*)"); IvyBindMsg(on_DL_SETTING, NULL, "^(\\S*) DL_SETTING (\\S*) (\\S*) (\\S*)"); - IvyBindMsg(on_DL_GET_SETTING, NULL, "^(\\S*) DL_GET_SETTING (\\S*) (\\S*)"); + IvyBindMsg(on_DL_GET_SETTING, NULL, "^(\\S*) GET_DL_SETTING (\\S*) (\\S*)"); IvyBindMsg(on_DL_BLOCK, NULL, "^(\\S*) BLOCK (\\S*) (\\S*)"); IvyBindMsg(on_DL_MOVE_WP, NULL, "^(\\S*) MOVE_WP (\\S*) (\\S*) (\\S*) (\\S*) (\\S*)"); From c50058d6a2d10e4b63fce8bfa9116b503e6dcbe5 Mon Sep 17 00:00:00 2001 From: Stephen Dwyer Date: Fri, 29 Mar 2013 16:17:01 -0600 Subject: [PATCH 096/109] [stm32][ms2100] the reset/set gpio state for the ms2100 reset functionality was inverted, hopefully fixes Issue #384 --- sw/airborne/arch/stm32/peripherals/ms2100_arch.h | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/sw/airborne/arch/stm32/peripherals/ms2100_arch.h b/sw/airborne/arch/stm32/peripherals/ms2100_arch.h index 701158e761..9e10edde6f 100644 --- a/sw/airborne/arch/stm32/peripherals/ms2100_arch.h +++ b/sw/airborne/arch/stm32/peripherals/ms2100_arch.h @@ -31,12 +31,20 @@ #include #include "mcu_periph/spi.h" +/** + * Here Reset indicates the Ms2100 is in normal state, i.e. + * the reset line is driven low (i.e. the GPIO is "reset") + */ static inline void Ms2100Reset(void) { - GPIOC_BSRR = GPIO13; + GPIOC_BRR = GPIO13; } +/** + * Here Set indicates the Ms2100 is in reset state, i.e. + * the reset line is driven high (i.e. the GPIO is "set") + */ static inline void Ms2100Set(void) { - GPIOC_BRR = GPIO13; + GPIOC_BSRR = GPIO13; } #define Ms2100HasEOC() (gpio_get(GPIOB, GPIO5) != 0) From adae102007bcd40efad61878c38b39d72823f406 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 23:17:08 +0100 Subject: [PATCH 097/109] remove AVR support and unused AVR ground modem closes #397 --- .gitignore | 1 - conf/Makefile.avr | 190 ------------- sw/airborne/arch/avr/ahrs_asm.S | 65 ----- sw/airborne/arch/avr/ant_h_bridge.c | 51 ---- sw/airborne/arch/avr/ant_h_bridge.h | 11 - sw/airborne/arch/avr/ant_servo.c | 28 -- sw/airborne/arch/avr/ant_servo.h | 13 - sw/airborne/arch/avr/ant_spi.c | 71 ----- sw/airborne/arch/avr/ant_spi.h | 19 -- sw/airborne/arch/avr/ant_tracker.c | 37 --- sw/airborne/arch/avr/ant_tracker.h | 29 -- sw/airborne/arch/avr/ant_v2x.c | 258 ------------------ sw/airborne/arch/avr/ant_v2x.h | 51 ---- sw/airborne/arch/avr/dc_mc_link.c | 103 ------- sw/airborne/arch/avr/dc_mc_link.h | 14 - sw/airborne/arch/avr/dc_mc_power.c | 30 -- sw/airborne/arch/avr/dc_mc_power.h | 10 - sw/airborne/arch/avr/gpio.h | 6 - sw/airborne/arch/avr/interrupt_hw.h | 34 --- sw/airborne/arch/avr/led_hw.h | 23 -- sw/airborne/arch/avr/link_mcu_hw.h | 43 --- sw/airborne/arch/avr/mcu_periph/adc_arch.c | 167 ------------ sw/airborne/arch/avr/mcu_periph/adc_arch.h | 0 sw/airborne/arch/avr/mcu_periph/i2c_arch.c | 165 ----------- sw/airborne/arch/avr/mcu_periph/i2c_arch.h | 61 ----- sw/airborne/arch/avr/mcu_periph/spi_arch.c | 146 ---------- sw/airborne/arch/avr/mcu_periph/spi_arch.h | 84 ------ sw/airborne/arch/avr/mcu_periph/uart_arch.c | 256 ----------------- sw/airborne/arch/avr/mcu_periph/uart_arch.h | 106 ------- sw/airborne/arch/avr/ppm_hw.c | 119 -------- sw/airborne/arch/avr/ppm_hw.h | 86 ------ sw/airborne/arch/avr/servos_4017.c | 138 ---------- sw/airborne/arch/avr/servos_4017.h | 38 --- sw/airborne/arch/avr/servos_direct_hw.c | 25 -- sw/airborne/arch/avr/servos_direct_hw.h | 23 -- sw/airborne/arch/avr/servos_esc_hw.c | 51 ---- sw/airborne/arch/avr/servos_esc_hw.h | 50 ---- .../subsystems/datalink/audio_telemetry_hw.c | 74 ----- .../subsystems/datalink/audio_telemetry_hw.h | 94 ------- sw/airborne/arch/avr/sys_time_hw.c | 22 -- sw/airborne/arch/avr/sys_time_hw.h | 127 --------- sw/airborne/arch/avr/uart_tunnel.c | 61 ----- sw/ground_segment/modem/Makefile | 41 --- sw/ground_segment/modem/README | 28 -- sw/ground_segment/modem/adc.c | 39 --- sw/ground_segment/modem/adc.h | 8 - sw/ground_segment/modem/link_tmtc.h | 92 ------- sw/ground_segment/modem/main.c | 70 ----- sw/ground_segment/modem/soft_uart.c | 80 ------ sw/ground_segment/modem/soft_uart.h | 21 -- sw/ground_segment/modem/timer.h | 91 ------ sw/ground_segment/modem/uart.c | 81 ------ sw/ground_segment/modem/uart.h | 19 -- 53 files changed, 3550 deletions(-) delete mode 100644 conf/Makefile.avr delete mode 100644 sw/airborne/arch/avr/ahrs_asm.S delete mode 100644 sw/airborne/arch/avr/ant_h_bridge.c delete mode 100644 sw/airborne/arch/avr/ant_h_bridge.h delete mode 100644 sw/airborne/arch/avr/ant_servo.c delete mode 100644 sw/airborne/arch/avr/ant_servo.h delete mode 100644 sw/airborne/arch/avr/ant_spi.c delete mode 100644 sw/airborne/arch/avr/ant_spi.h delete mode 100644 sw/airborne/arch/avr/ant_tracker.c delete mode 100644 sw/airborne/arch/avr/ant_tracker.h delete mode 100644 sw/airborne/arch/avr/ant_v2x.c delete mode 100644 sw/airborne/arch/avr/ant_v2x.h delete mode 100644 sw/airborne/arch/avr/dc_mc_link.c delete mode 100644 sw/airborne/arch/avr/dc_mc_link.h delete mode 100644 sw/airborne/arch/avr/dc_mc_power.c delete mode 100644 sw/airborne/arch/avr/dc_mc_power.h delete mode 100644 sw/airborne/arch/avr/gpio.h delete mode 100644 sw/airborne/arch/avr/interrupt_hw.h delete mode 100644 sw/airborne/arch/avr/led_hw.h delete mode 100644 sw/airborne/arch/avr/link_mcu_hw.h delete mode 100644 sw/airborne/arch/avr/mcu_periph/adc_arch.c delete mode 100644 sw/airborne/arch/avr/mcu_periph/adc_arch.h delete mode 100644 sw/airborne/arch/avr/mcu_periph/i2c_arch.c delete mode 100644 sw/airborne/arch/avr/mcu_periph/i2c_arch.h delete mode 100644 sw/airborne/arch/avr/mcu_periph/spi_arch.c delete mode 100644 sw/airborne/arch/avr/mcu_periph/spi_arch.h delete mode 100644 sw/airborne/arch/avr/mcu_periph/uart_arch.c delete mode 100644 sw/airborne/arch/avr/mcu_periph/uart_arch.h delete mode 100644 sw/airborne/arch/avr/ppm_hw.c delete mode 100644 sw/airborne/arch/avr/ppm_hw.h delete mode 100644 sw/airborne/arch/avr/servos_4017.c delete mode 100644 sw/airborne/arch/avr/servos_4017.h delete mode 100644 sw/airborne/arch/avr/servos_direct_hw.c delete mode 100644 sw/airborne/arch/avr/servos_direct_hw.h delete mode 100644 sw/airborne/arch/avr/servos_esc_hw.c delete mode 100644 sw/airborne/arch/avr/servos_esc_hw.h delete mode 100644 sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.c delete mode 100644 sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.h delete mode 100644 sw/airborne/arch/avr/sys_time_hw.c delete mode 100644 sw/airborne/arch/avr/sys_time_hw.h delete mode 100644 sw/airborne/arch/avr/uart_tunnel.c delete mode 100644 sw/ground_segment/modem/Makefile delete mode 100644 sw/ground_segment/modem/README delete mode 100644 sw/ground_segment/modem/adc.c delete mode 100644 sw/ground_segment/modem/adc.h delete mode 100644 sw/ground_segment/modem/link_tmtc.h delete mode 100644 sw/ground_segment/modem/main.c delete mode 100644 sw/ground_segment/modem/soft_uart.c delete mode 100644 sw/ground_segment/modem/soft_uart.h delete mode 100644 sw/ground_segment/modem/timer.h delete mode 100644 sw/ground_segment/modem/uart.c delete mode 100644 sw/ground_segment/modem/uart.h diff --git a/.gitignore b/.gitignore index 29c5f3133f..e33256718f 100644 --- a/.gitignore +++ b/.gitignore @@ -42,7 +42,6 @@ /debian/changelog /debian/files /debian/paparazzi-arm7 -/debian/paparazzi-avr /debian/paparazzi-dev /debian/paparazzi-bin /sw/lib/ocaml/ivy/debian/changelog diff --git a/conf/Makefile.avr b/conf/Makefile.avr deleted file mode 100644 index 621820347d..0000000000 --- a/conf/Makefile.avr +++ /dev/null @@ -1,190 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- -# -# $Id$ -# Copyright (C) 2003-2005 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. -# - - -# -# This is the common Makefile for the avr-target. -# Edit the configuration part to suit your local install -# - -ATMELBIN = /usr/bin -ATMEL_INCLUDES = -I /usr/avr/include -ATMEL_LIBPATH = -B /usr/avr/lib/avr4 -B /usr/avr/lib/avr5 -PROG_PORT = /dev/parport0 - -VERIFY=--verify - -SRC_ARCH = $(PAPARAZZI_SRC)/sw/airborne/arch/avr - -CC = $(ATMELBIN)/avr-gcc -mmcu=$($(TARGET).MCU) -LD = $(CC) $(ATMEL_LIBPATH) -SIZE = $(ATMELBIN)/avr-size -OBJCOPY = $(ATMELBIN)/avr-objcopy - - -SERIAL_FLAGS = \ - -dprog=avr910 \ - -dpart=auto \ - -dserial=/dev/ttyS0 \ - -dspeed=38400 \ - -ISP_FLAGS = \ - -dlpt=$(PROG_PORT) -dprog=stk200 -v=3 \ - -UISP = uisp -UISP_FLAGS = $(ISP_FLAGS) -#UISP_FLAGS = $(SERIAL_FLAGS) - -# Launch with "make Q=''" to get full command display -Q=@ - - -# -# End of configuration part. -# -SRCAVR = $($(TARGET).srcs) - -CFLAGS = \ - -W -Wall -Wundef \ - $(ATMEL_INCLUDES) \ - $(INCLUDES) \ - -Wstrict-prototypes \ - $($(TARGET).CFLAGS) \ - $(LOCAL_CFLAGS) \ - -O3 \ - -LDFLAGS = -lm \ - -# -# General rules -# - -#$(TARGET).srcsnd = $(notdir $($(TARGET).srcs)) -#$(TARGET).objso = $($(TARGET).srcsnd:%.c=$(OBJDIR)/%.o) -#$(TARGET).objs = $($(TARGET).objso:%.S=$(OBJDIR)/%.o) - - -all: build -#all compile: $($(TARGET).objs) $(OBJDIR)/$(TARGET).elf -#all: -# @echo !!!!!!! -# @echo $($(TARGET).objs) -# @echo !!!!!!! - -load upload: $(TARGET).install - - -# -# Fuses -# - -rd_fuses: check_arch - $(UISP) $(ISP_FLAGS) --rd_fuses - -wr_fuses : check_arch - $(UISP) $(ISP_FLAGS) --wr_fuse_h=$($(TARGET).HIGH_FUSE) - $(UISP) $(ISP_FLAGS) --wr_fuse_l=$($(TARGET).LOW_FUSE) - $(UISP) $(ISP_FLAGS) --wr_fuse_e=$($(TARGET).EXT_FUSE) - $(UISP) $(ISP_FLAGS) --wr_lock=$($(TARGET).LOCK_FUSE) - -TMPFILE = '/tmp/check_fuses.tmp' - -check_fuses: check_arch - @echo "##### Check of fuses #####" - @$(UISP) $(ISP_FLAGS) --rd_fuses >$(TMPFILE) - @if (grep -i 'Fuse Low Byte' $(TMPFILE) | cut -c24- | grep -iq $($(TARGET).LOW_FUSE)) && (grep -i 'Fuse High Byte' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).HIGH_FUSE)) && (grep -i 'Fuse Extended Byte' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).EXT_FUSE)) && (grep -i 'Lock Bits' $(TMPFILE) |cut -c24- | grep -iq $($(TARGET).LOCK_FUSE)); then echo "-> Fuses are Ok"; rm $(TMPFILE); else echo "-> Wrong fuses. Type 'make wr_fuses'"; rm $(TMPFILE); exit 1; fi - -# Define all object files. -COBJ = $(SRC:%.c=$(OBJDIR)/%.o) -COBJAVR = $(SRCAVR:%.c=$(OBJDIR)/%.o) - - -build: elf hex - -elf: $(OBJDIR)/$(TARGET).elf -hex: $(OBJDIR)/$(TARGET).hex - - -%.hex: %.elf - @echo OBJC $@ - $(OBJCOPY) -O ihex -R .eeprom $< $@ - -.SECONDARY : $(OBJDIR)/$(TARGET).elf -.PRECIOUS : $(COBJ) $(COBJAVR) - -%.elf: $(COBJ) $(COBJAVR) - @echo LD $@ - $(Q)$(LD) $(LOCAL_LDFLAGS) $^ -o $@ $(LDFLAGS) - @echo SIZE - $(Q)$(SIZE) $@ - - -#%.s: %.c -# $(CC) $(CFLAGS) -S -o $@ $< - -#$(OBJDIR)/%.s: %.c -# $(CC) $(CFLAGS) -S -o $@ $< - -$(OBJDIR)/%.o: %.c $(OBJDIR)/../Makefile.ac - @echo CC $@ - $(Q)test -d $(dir $@) || mkdir -p $(dir $@) - $(Q)$(CC) -c $(CFLAGS) $< -o $@ - -#$(OBJDIR)/%.o: $(SRC_ARCH)/%.S -# $(CC) $(CFLAGS) -c -o $@ $< - - - -%.install: $(OBJDIR)/%.hex check_arch -# stk200 needs to be erased first - $(UISP) $(UISP_FLAGS) --erase - @echo SIZE - $(Q)$(SIZE) $< - $(UISP) $(UISP_FLAGS) --upload $(VERIFY) if=$< - -erase: check_arch - $(UISP) $(ISP_FLAGS) --erase - -check_arch : - @echo "CHECKING link with device $($(TARGET).MCU) on $(PROG_PORT)" - $(Q)$(UISP) $(UISP_FLAGS) - $(Q)if ($(UISP) $(UISP_FLAGS) 2>&1 | tr '[:upper:]' '[:lower:]' | grep $($(TARGET).MCU)); then : ; else echo "Wrong architecture (mcu0 vs mcu1 ?)"; exit 1; fi - -avr_clean: - $(Q)rm -rf $(OBJDIR) - - -# -# Dependencies -# - -$(OBJDIR)/.depend: - @echo DEPEND $@ - @test -d $(OBJDIR) || mkdir -p $(OBJDIR) - $(Q)$(CC) -MM -MG $(CFLAGS) $($(TARGET).srcs) | sed 's|\([^\.]*\.o\)|$(OBJDIR)/\1|' > $@ - -ifneq ($(MAKECMDGOALS),clean) -ifneq ($(MAKECMDGOALS),erase) --include $(OBJDIR)/.depend -endif -endif diff --git a/sw/airborne/arch/avr/ahrs_asm.S b/sw/airborne/arch/avr/ahrs_asm.S deleted file mode 100644 index a081713c6f..0000000000 --- a/sw/airborne/arch/avr/ahrs_asm.S +++ /dev/null @@ -1,65 +0,0 @@ -/* -*- indent-tabs-mode:T; c-basic-offset:8; tab-width:8; -*- vi: set ts=8: - * $Id$ - * - * Assembly file to layout the AHRS data. - * We want to be sure that things are aligned and packed as - * closely as possible, as well as alias several things. This - * is the easiest way to do it. - */ -.section .bss - -.global X -X: -.global quat -quat: -.global q0 -q0: -.space 4 -.global q1 -q1: -.space 4 -.global q2 -q2: -.space 4 -.global q3 -q3: -.space 4 - -.global bias -bias: -.global bias_p -bias_p: -.space 4 -.global bias_q -bias_q: -.space 4 -.global bias_r -bias_r: -.space 4 - - -.global C -C: -.global Qdot -Qdot: -.space 16 - - -.global A -A: -.global PCt -PCt: -.space 7 * 4 -.global K -K: -.space 7 * 4 -.global E -E: -.space 1 * 4 - -/* And the rest of A */ -.space (4*7 - 7 - 7 - 1) * 4 - - -.global end_bss -end_bss: diff --git a/sw/airborne/arch/avr/ant_h_bridge.c b/sw/airborne/arch/avr/ant_h_bridge.c deleted file mode 100644 index 9da1305a08..0000000000 --- a/sw/airborne/arch/avr/ant_h_bridge.c +++ /dev/null @@ -1,51 +0,0 @@ -#include "ant_h_bridge.h" - -#include - -#include CONFIG - -#define HB_DDR DDRE -#define HB_PORT PORTE -/* OC3A */ -#define HB_IN1_PIN 3 -/* OC3C */ -#define HB_IN2_PIN 5 -/* ENABLE */ -#define HB_EN_PIN 7 - -#define HB_REFRESH 500 - - -void ant_h_bridge_init( void ) { - /* set PE1, PE3 and PE5 (OC3A, OC3C and PD0) as output */ - SetBit (HB_DDR,HB_IN1_PIN); /* input 1 */ - SetBit (HB_DDR,HB_IN2_PIN); /* input 2 */ - SetBit (HB_DDR,HB_EN_PIN); /* enable */ - - - /* disable motor */ - // ClearBit(HB_PORT, HB_EN_PIN); - SetBit(HB_PORT, HB_EN_PIN); - - /* set timer3 in fast PWM mode, with TOP defined by ICR3 , prescaled to 8 */ - - TCCR3A = _BV(WGM31) | _BV(COM3A1) | _BV(COM3C1); - TCCR3B = _BV(WGM32) | _BV(WGM33) | _BV(CS31); - ICR3 = HB_REFRESH; - ant_h_bridge_set(0); - // ant_h_bridge_set(HB_REFRESH/5); - // SetBit(HB_PORT, HB_IN1_PIN); - // ClearBit(HB_PORT, HB_IN2_PIN); - -} - -void ant_h_bridge_set ( int16_t value) { - if (value > 0) { - OCR3A = value; - OCR3C = 0; - } - else { - OCR3A = 0; - OCR3C = -value; - } -} diff --git a/sw/airborne/arch/avr/ant_h_bridge.h b/sw/airborne/arch/avr/ant_h_bridge.h deleted file mode 100644 index 043767c553..0000000000 --- a/sw/airborne/arch/avr/ant_h_bridge.h +++ /dev/null @@ -1,11 +0,0 @@ -#ifndef ANT_H_BRIDGE_H -#define ANT_H_BRIDGE_H - -#include "std.h" - -void ant_h_bridge_init( void ); -void ant_h_bridge_set ( int16_t value); - - - -#endif /* ANT_H_BRIDGE_H */ diff --git a/sw/airborne/arch/avr/ant_servo.c b/sw/airborne/arch/avr/ant_servo.c deleted file mode 100644 index 4a1964b64e..0000000000 --- a/sw/airborne/arch/avr/ant_servo.c +++ /dev/null @@ -1,28 +0,0 @@ -#include "ant_servo.h" - -#include - -#include CONFIG - -#define PRESCALER 8 -#define TICKS_OF_US(nb_us) (((nb_us) * (float)(CLOCK / PRESCALER)-1)) -#define SERVO_REFRESH 25000 - -void ant_servo_init( void ) { - /* set PB5 and PB6 (OC1A and OC1B ) as output */ - SetBit (DDRB, 5); - SetBit (DDRB, 6); - /* set timer1 in fast PWM mode, with TOP defined by ICR3 , prescaled to 8 */ - TCCR1A = _BV(WGM11) | _BV(COM1A1) | _BV(COM1B1); - TCCR1B = _BV(WGM12) | _BV(WGM13) | _BV(CS11); - ICR1=TICKS_OF_US(SERVO_REFRESH); - ant_servo_set(NEUTRAL_SERVO, NEUTRAL_SERVO); -} - -void ant_servo_set ( uint16_t value1_us, uint16_t value2_us) { -/* code pour regler la valeur en ms a l'etat haut du signal PWM */ - Bound(value1_us, MIN_SERVO, MAX_SERVO); - OCR1A = TICKS_OF_US(value1_us); - Bound(value2_us, MIN_SERVO, MAX_SERVO); - OCR1B = TICKS_OF_US(value2_us); -} diff --git a/sw/airborne/arch/avr/ant_servo.h b/sw/airborne/arch/avr/ant_servo.h deleted file mode 100644 index 451efa3462..0000000000 --- a/sw/airborne/arch/avr/ant_servo.h +++ /dev/null @@ -1,13 +0,0 @@ -#ifndef ANT_SERVO_H -#define ANT_SERVO_H - -#include "std.h" - -#define MAX_SERVO 2000 -#define NEUTRAL_SERVO 1500 -#define MIN_SERVO 1000 - -void ant_servo_init( void ); -void ant_servo_set ( uint16_t value1_us, uint16_t value2_us); - -#endif /* ANT_SERVO_H */ diff --git a/sw/airborne/arch/avr/ant_spi.c b/sw/airborne/arch/avr/ant_spi.c deleted file mode 100644 index ec835643af..0000000000 --- a/sw/airborne/arch/avr/ant_spi.c +++ /dev/null @@ -1,71 +0,0 @@ -#include "ant_spi.h" - -#include -#include "std.h" - - -/*********************************Flush SPI*****************************************/ - - -void flush_SPI( void ) -{ - if (bit_is_set(SPSR, SPIF)) - { - uint8_t foo __attribute__ ((unused)) = SPDR; - } -} - - -/*****************************Initialisation SPI************************************/ - -#define DDR_SPI DDRB -#define PORT_SPI PORTB -#define PIN_SS 0 -#define PIN_SCK 1 -#define PIN_MOSI 2 -#define PIN_SYNC 4 - -void SPI_select_slave ( void ) -{ - ClearBit(PORT_SPI, PIN_SS); -} - -/***********************************************************************************/ - -void SPI_unselect_slave ( void ) -{ - SetBit(PORT_SPI, PIN_SS); -} - -/***********************************************************************************/ - -void SPI_master_init( void ) -{ - /* Set SS, MOSI and SCK output, all others input */ - DDR_SPI |= _BV(PIN_SS) | _BV(PIN_SCK) | _BV(PIN_MOSI); - /* unselect slave */ - SPI_unselect_slave(); - /* Enable SPI, Master, MSB first, clock idle low, sample on leading edge, clock rate fck/128 */ - SPCR = ( _BV(SPE)| _BV(MSTR) | _BV(SPR1) | _BV(SPR0)); -} - -/***********************************************************************************/ - -void SPI_start( void ) -{ - SPI_select_slave(); - if (bit_is_set(SPSR, SPIF)) { - uint8_t foo __attribute__ ((unused)) = SPDR; - } - /* enable interrupt */ - SetBit(SPCR,SPIE); -} - -/***********************************************************************************/ - -void SPI_stop(void) -{ - SPI_unselect_slave (); - /* disable interrupt */ - ClearBit(SPCR,SPIE); -} diff --git a/sw/airborne/arch/avr/ant_spi.h b/sw/airborne/arch/avr/ant_spi.h deleted file mode 100644 index 076f533d74..0000000000 --- a/sw/airborne/arch/avr/ant_spi.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef ANT_SPI_H -#define ANT_SPI_H - -#include "std.h" - -#include -#include "std.h" - -void flush_SPI( void ); -void SPI_select_slave ( void ); -void SPI_unselect_slave ( void ); -void SPI_master_init( void ); -void SPI_start( void ); -void SPI_stop( void ); - -#define SPI_transmit(c) { SPDR = c; } -#define SPI_read() (SPDR) - -#endif /* ANT_SPI_H */ diff --git a/sw/airborne/arch/avr/ant_tracker.c b/sw/airborne/arch/avr/ant_tracker.c deleted file mode 100644 index 68b172bead..0000000000 --- a/sw/airborne/arch/avr/ant_tracker.c +++ /dev/null @@ -1,37 +0,0 @@ -#include "ant_tracker.h" - -#include "subsystems/navigation/traffic_info.h" - -uint8_t ant_track_mode; -float ant_track_azim; -float ant_track_elev; -uint8_t ant_track_id; - -int32_t nav_utm_east0; -int32_t nav_utm_north0; -uint8_t nav_utm_zone0; -const float ant_track_gnd_alt = 185.; - -void ant_tracker_init( void ) { - // nav_utm_east0 = ; - // nav_utm_north0 = ; - // nav_utm_zone0 = ; - ant_track_id = 5; - ant_track_mode = ANT_TRACK_AUTO; - ant_track_azim = 0.; - ant_track_elev = 0.; -} - -void ant_tracker_periodic( void ) { - if (ant_track_mode == ANT_TRACK_AUTO) { - struct ac_info_ * ac = get_ac_info(ant_track_id); - ant_track_azim = atan2(ac->north, ac->east) * 180. / M_PI; - ant_track_azim = 90. - ant_track_azim; - if (ant_track_azim < 0) - ant_track_azim += 360.; - float dist = sqrt(ac->north*ac->north + ac->east*ac->east); - if ( dist < 1.) dist = 1.; - float height = ac->alt - ant_track_elev; - ant_track_elev = atan2( height, dist) * 180. / M_PI; - } -} diff --git a/sw/airborne/arch/avr/ant_tracker.h b/sw/airborne/arch/avr/ant_tracker.h deleted file mode 100644 index 3ec10aa022..0000000000 --- a/sw/airborne/arch/avr/ant_tracker.h +++ /dev/null @@ -1,29 +0,0 @@ -#ifndef ANT_TRACKER_H -#define ANT_TRACKER_H - -#include "std.h" - -#define ANT_TRACK_MANUAL 0 -#define ANT_TRACK_AUTO 1 - -extern uint8_t ant_track_mode; -extern float ant_track_azim; -extern float ant_track_elev; -extern uint8_t ant_track_id; - -#include "led.h" - -#define ant_tracker_SetId(i) { ant_track_id = i; } -#define ant_tracker_SetMode(i) \ - { \ - ant_track_mode = i; \ - if(ant_track_mode) \ - LED_ON(2); \ - else \ - LED_OFF(2); \ - } - - -extern void ant_tracker_init( void ); -extern void ant_tracker_periodic( void ); -#endif /* ANT_TRACKER_H */ diff --git a/sw/airborne/arch/avr/ant_v2x.c b/sw/airborne/arch/avr/ant_v2x.c deleted file mode 100644 index 83a45e3ebf..0000000000 --- a/sw/airborne/arch/avr/ant_v2x.c +++ /dev/null @@ -1,258 +0,0 @@ -#include "ant_v2x.h" - -#include -#include - -//#include "stdlib.h" -#include "string.h" -#include "std.h" -//#include "systime.h" -//#include "signalisation.h" -//#include "utils.h" - -#include "ant_spi.h" - -//#include "subsystems/datalink/downlink.h" - -volatile bool_t ant_v2x_data_available; -struct Ant_V2xData ant_v2x_data; - - -#define MAG_S_RESET 0 -#define MAG_S_UNINIT 1 -#define MAG_S_READY 2 -#define MAG_S_WAIT_MEAS 3 -volatile uint8_t ant_v2x_status; - -#define MAG_CS_IDLE 0 -#define MAG_CS_READING 1 -#define MAG_CS_WRITING 2 -volatile uint8_t ant_v2x_com_status; - - -uint8_t ant_v2x_req[64]; -uint8_t ant_v2x_req_len; -volatile uint8_t ant_v2x_req_idx; - -uint8_t ant_v2x_res[128]; -uint8_t ant_v2x_res_len; -volatile uint8_t ant_v2x_res_idx; - -volatile uint8_t ant_v2x_periodic_count; - -/******************************Ant_V2x define************************************/ - -#define ANT_V2X_DDR DDRB -#define ANT_V2X_PORT PORTB -#define ANT_V2X_PIN 4 - -#define SYNC_FLAG 0xAA -#define TERMINATOR 0x00 - -#define GET_MODE_INFO 0x01 -#define MOD_INFO_RESP 0x02 -#define SET_DATA_COMPONENTS 0x03 -#define GET_DATA 0x04 -#define DATA_RESP 0x05 -#define SET_CONFIG 0x06 -#define GET_CONFIG 0x07 -#define CONFIG_RESP 0x08 -#define SAVE_CONFIG 0x09 -#define START_CAL 0x0A -#define STOP_CAL 0x0B -#define GET_CAL_DATA 0x0C -#define CAL_DATA_RESP 0x0D -#define SET_CAL_DATA 0x0E - -#define DATA_XRAW 0x01 // Slnt32 counts 32768 to 32767 -#define DATA_YRAW 0x02 // Slnt32 counts 32768 to 32767 -#define DATA_XCAL 0x03 // Float32 scaled to 1.0 -#define DATA_YCAL 0x04 // Float32 scaled to 1.0 -#define DATA_HEADING 0x05 // Float32 degrees 0.0 to 359.9 -#define DATA_MAGNITUDE 0x06 // Float32 scalebreak; -#define DATA_TEMPERATURE 0x07 // Float32 Celsius -#define DATA_DISTORTION 0x08 // Boolean -#define DATA_CAL_STATUS 0x09 // Boolean - - -extern void ant_v2x_periodic_initialise(void); -extern void ant_v2x_send_req ( const uint8_t* req, uint8_t len); -extern void ant_v2x_send_get_data ( void ); - - -/***************************Initialisation ant_v2x*******************************/ - -void ant_v2x_init( void ) -{ - SPI_master_init(); - /* set sync as ouptut */ - SetBit(ANT_V2X_DDR, ANT_V2X_PIN); - /* pull it down */ - SetBit(ANT_V2X_PORT, ANT_V2X_PIN); - - ant_v2x_data_available = FALSE; - ant_v2x_com_status = MAG_CS_IDLE; - - ant_v2x_data.heading = 0.; - - ant_v2x_reset(); -} - - -void ant_v2x_periodic_initialise( void ) { - static uint8_t init_status = 0; - if (ant_v2x_com_status != MAG_CS_IDLE) - return; - switch (init_status) { - case 0 : /* set data response format */ - { - const uint8_t req[] = {SET_DATA_COMPONENTS, 0x08, DATA_XRAW, DATA_YRAW, DATA_XCAL, DATA_YCAL, DATA_HEADING, DATA_MAGNITUDE, DATA_DISTORTION, DATA_CAL_STATUS }; - ant_v2x_send_req(req, sizeof(req)); - } - break; - case 1 : /* set little endian */ - { - const uint8_t req[] = {SET_CONFIG, 0x06, 0x00}; - ant_v2x_send_req(req, sizeof(req)); - } - break; - case 2 : - { /* set period */ - const uint8_t req[] = {SET_CONFIG, 0x05, 0x07}; - ant_v2x_send_req(req, sizeof(req)); - } - break; - default: - ant_v2x_status = MAG_S_READY; - } - init_status++; -} -void ant_v2x_periodic( void ) { /* Run initialisation and communication request */ - switch (ant_v2x_status) { - case MAG_S_RESET: - SetBit(ANT_V2X_PORT, ANT_V2X_PIN); - ant_v2x_status = MAG_S_UNINIT; - break; - case MAG_S_UNINIT: - ant_v2x_periodic_initialise(); - break; - case MAG_S_READY: /* Ready to receive request */ - /*GREEN_LED_ON();*/ - /*YELLOW_LED_OFF();*/ - // if (ant_v2x_data_available) return - ant_v2x_send_get_data(); - ant_v2x_status = MAG_S_WAIT_MEAS; - ant_v2x_periodic_count = 0; - break; - case MAG_S_WAIT_MEAS: { /* Waiting for measures */ - ant_v2x_periodic_count++; - if (ant_v2x_periodic_count > 5) { - ant_v2x_com_status = MAG_CS_READING; - SPI_start(); - ant_v2x_res_idx = 0; - ant_v2x_res_len = 43; - SPI_transmit(0x00); - } - } - break; - } -} - -/*****************************Ant_V2x reset****************************************/ -void ant_v2x_reset (void){ - ClearBit(ANT_V2X_PORT, ANT_V2X_PIN); - ant_v2x_status = MAG_S_RESET; - ant_v2x_com_status = MAG_CS_IDLE; -} - -/**************************Ant_V2x data communication******************************/ -void ant_v2x_send_get_data ( void ) { - const uint8_t req[] = {GET_DATA}; - ant_v2x_send_req(req, sizeof(req)); -} - -/********************************Request procedure***********************************/ -void ant_v2x_send_req(const uint8_t* req, uint8_t len) { - memcpy(ant_v2x_req, req, len); - ant_v2x_req_len = len; - ant_v2x_req_idx = 0; - ant_v2x_com_status = MAG_CS_WRITING; - SPI_start(); - SPI_transmit(SYNC_FLAG);/* transmit SYNC_FLAG first for every beginning of transmition */ -} - -void ant_v2x_read_data( void ) { - ant_v2x_data.xraw = *(int32_t*)&ant_v2x_res[4]; - ant_v2x_data.yraw = *(int32_t*)&ant_v2x_res[9]; - ant_v2x_data.xcal = *(float*)&ant_v2x_res[14]; - ant_v2x_data.ycal = *(float*)&ant_v2x_res[19]; - ant_v2x_data.heading = *(float*)&ant_v2x_res[24]; - ant_v2x_data.magnitude = *(float*)&ant_v2x_res[29]; - ant_v2x_data.temp = *(float*)&ant_v2x_res[34]; - ant_v2x_data.distor = *(int8_t*)&ant_v2x_res[39]; - ant_v2x_data.cal_status = *(int8_t*)&ant_v2x_res[41]; -} - - -#define SPI_SIG_ON_WRITING() { \ - uint8_t c __attribute__ ((unused)) = SPI_read(); \ - if (ant_v2x_req_idx < ant_v2x_req_len) { \ - SPI_transmit(ant_v2x_req[ant_v2x_req_idx]); \ - } \ - else if (ant_v2x_req_idx == ant_v2x_req_len) { \ - SPI_transmit(TERMINATOR); \ - } \ - else { \ - ant_v2x_com_status = MAG_CS_IDLE; \ - SPI_stop(); \ - } \ - ant_v2x_req_idx++; \ - } - - -static uint8_t nb_retry = 0; -#define MAX_RETRY 10 - -#define SPI_SIG_ON_READING() { \ - ant_v2x_res[ant_v2x_res_idx] = SPI_read(); \ - if (ant_v2x_res_idx == 0) { \ - if (nb_retry > MAX_RETRY) { \ - ant_v2x_reset(); \ - nb_retry = 0; \ - /*YELLOW_LED_ON();*/ \ - goto sig_exit; \ - } \ - if (ant_v2x_res[ant_v2x_res_idx] != SYNC_FLAG) { \ - nb_retry++; \ - SPI_transmit(0x00); \ - goto sig_exit; \ - } \ - else { \ - nb_retry = 0; \ - } \ - } \ - ant_v2x_res_idx++; \ - if (ant_v2x_res_idx < ant_v2x_res_len) { \ - SPI_transmit(0x00); \ - } \ - else { \ - ant_v2x_com_status = MAG_CS_IDLE; \ - SPI_stop(); \ - ant_v2x_status = MAG_S_READY; \ - ant_v2x_data_available = TRUE; \ - /*GREEN_LED_OFF();*/ \ - } \ - } \ - -SIGNAL(SIG_SPI) { - switch ( ant_v2x_com_status) { - case MAG_CS_WRITING: - SPI_SIG_ON_WRITING(); - break; - case MAG_CS_READING: - SPI_SIG_ON_READING(); - } - sig_exit: - /*GREEN_LED_OFF();*/ - asm("nop"); -} diff --git a/sw/airborne/arch/avr/ant_v2x.h b/sw/airborne/arch/avr/ant_v2x.h deleted file mode 100644 index 6b696f5eda..0000000000 --- a/sw/airborne/arch/avr/ant_v2x.h +++ /dev/null @@ -1,51 +0,0 @@ -#ifndef ANT_V2X_H -#define ANT_V2X_H - -#include "std.h" - -extern void ant_v2x_init( void ); -extern void ant_v2x_periodic(void); -extern bool_t ant_v2x_is_in_calibration(void); -extern void ant_v2x_reset( void ); -extern void ant_v2x_read_data( void ); - -struct Ant_V2xConfig -{ - float declination; - uint8_t true_north; - uint8_t cal_sample_freq; - uint8_t sample_freq; - uint8_t period; - uint8_t big_idian; - uint8_t damping_size; -}; - -struct Ant_V2xData -{ - int32_t xraw; - int32_t yraw; - float xcal; - float ycal; - float heading; - float magnitude; - float temp; - uint8_t distor; - uint8_t cal_status; -}; - -struct Ant_V2xCal -{ - int8_t byte_count; - int32_t x_offset; - int32_t y_offset; - int32_t x_gain; - int32_t y_gain; - float phi; - float cal_magnitude; -}; - -extern volatile bool_t ant_v2x_data_available; -extern struct Ant_V2xData ant_v2x_data; - -#endif /* ANT_V2X_H */ - diff --git a/sw/airborne/arch/avr/dc_mc_link.c b/sw/airborne/arch/avr/dc_mc_link.c deleted file mode 100644 index 9924ae5200..0000000000 --- a/sw/airborne/arch/avr/dc_mc_link.c +++ /dev/null @@ -1,103 +0,0 @@ -#include "dc_mc_link.h" - -#include -#include - -/* - Slave address - front = 0x52 - back = 0x54 - right = 0x56 - left = 0x58 -*/ -#define DC_MC_LINK_TWI_ADDR 0x52 -#define DC_MC_LINK_TIMEOUT 60 - -volatile uint8_t dc_mc_link_event; -uint16_t dc_mc_link_command; -uint8_t dc_mc_link_timeout; - -#define DC_MC_LINK_TWI_RX_BUF_LEN 16 -uint8_t dc_mc_link_twi_rx_buf[DC_MC_LINK_TWI_RX_BUF_LEN]; -uint8_t dc_mc_link_twi_rx_buf_idx; - - -void dc_mc_link_init(void) { - dc_mc_link_event = FALSE; - dc_mc_link_command = 0; - dc_mc_link_timeout = DC_MC_LINK_TIMEOUT; - - /* setup slave addr */ - TWAR = 0x52; - /* clear and enable interrupt - enable peripheral and ack bit */ - TWCR = (1<= DC_MC_LINK_TIMEOUT) - dc_mc_link_command = 0; - else - dc_mc_link_timeout++; -} - -#define TWI_BUS_ERR_1 0x00 -#define TWI_BUS_ERR_2 0xF8 - -// Status Slave RX Mode -#define SR_SLA_ACK 0x60 -#define SR_LOST_ACK 0x68 -#define SR_GEN_CALL_ACK 0x70 -#define GEN_LOST_ACK 0x78 -#define SR_PREV_ACK 0x80 -#define SR_PREV_NACK 0x88 -#define GEN_PREV_ACK 0x90 -#define GEN_PREV_NACK 0x98 -#define STOP_CONDITION 0xA0 -#define REPEATED_START 0xA0 - -// Status Slave TX mode -#define SW_SLA_ACK 0xA8 -#define SW_LOST_ACK 0xB0 -#define SW_DATA_ACK 0xB8 -#define SW_DATA_NACK 0xC0 -#define SW_LAST_ACK 0xC8 - -#include "led.h" - -ISR (TWI_vect) { - switch (TWSR & 0xF8) { - case SR_SLA_ACK: - // LED_OFF(1); - dc_mc_link_twi_rx_buf_idx = 0; - TWCR |= _BV(TWINT) | _BV(TWEA); - break; - case SR_PREV_ACK: - dc_mc_link_twi_rx_buf[dc_mc_link_twi_rx_buf_idx] = TWDR; - dc_mc_link_twi_rx_buf_idx++; - if (dc_mc_link_twi_rx_buf_idx <= 2) - TWCR |= _BV(TWINT) | _BV(TWEA); - else - TWCR |= _BV(TWINT); - break; - case STOP_CONDITION: - TWCR |= _BV(TWINT); - dc_mc_link_timeout = 0; - // LED_ON(1); - dc_mc_link_event = TRUE; - break; - case SW_SLA_ACK: - case SW_DATA_ACK: - TWCR |= (1< - -// swicthing freq = CLOCK / RESOLUTION -// 13 bits -> 1953 Hz -#define DC_MC_POWER_RESOLUTION 0x1FFF -// 12 bits -> 3906 Hz -//#define DC_MC_POWER_RESOLUTION 0xFFF -// 11 bits -> 7812 Hz -//#define DC_MC_POWER_RESOLUTION 0x7FF -// 10 bits -> 15625 Hz -//#define DC_MC_POWER_RESOLUTION 0x3FF - - -void dc_mc_power_init(void) { - /* OC1A output */ - DDRB |= _BV(1); - - /* fast PWM TOP in ICR1 match in OCR1A */ - ICR1 = DC_MC_POWER_RESOLUTION; - TCCR1A |= _BV(WGM11) | _BV(COM1A1); - TCCR1B |= _BV(WGM12) | _BV(WGM13); -} - - -void dc_mc_power_set( uint16_t val) { - OCR1A = val * ((float)DC_MC_POWER_RESOLUTION / 65535.); - -} diff --git a/sw/airborne/arch/avr/dc_mc_power.h b/sw/airborne/arch/avr/dc_mc_power.h deleted file mode 100644 index b2901f7374..0000000000 --- a/sw/airborne/arch/avr/dc_mc_power.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef DC_MC_POWER_H -#define DC_MC_POWER_H - -#include "std.h" - -extern void dc_mc_power_init(void); -extern void dc_mc_power_set( uint16_t val); - - -#endif /* DC_MC_POWER_H */ diff --git a/sw/airborne/arch/avr/gpio.h b/sw/airborne/arch/avr/gpio.h deleted file mode 100644 index 45924da55d..0000000000 --- a/sw/airborne/arch/avr/gpio.h +++ /dev/null @@ -1,6 +0,0 @@ -#ifndef GPIO_H -#define GPIO_H - - - -#endif /* GPIO_H */ diff --git a/sw/airborne/arch/avr/interrupt_hw.h b/sw/airborne/arch/avr/interrupt_hw.h deleted file mode 100644 index 2fa194e2bc..0000000000 --- a/sw/airborne/arch/avr/interrupt_hw.h +++ /dev/null @@ -1,34 +0,0 @@ -/* - * Copyright (C) 2005 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. - * - */ -/** \file interrupt_hw.h - * \brief AVR Low level interrupt handling - * - */ - -#ifndef INTERRUPT_HW_H -#define INTERRUPT_HW_H - -#include - -#define int_enable() sei() - -#endif /* INTERRUPT_HW_H */ diff --git a/sw/airborne/arch/avr/led_hw.h b/sw/airborne/arch/avr/led_hw.h deleted file mode 100644 index ecb031393e..0000000000 --- a/sw/airborne/arch/avr/led_hw.h +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef LED_HW_H -#define LED_HW_H - -#include CONFIG -#include - -#define __LED_PORT(p) PORT ## p -#define _LED_PORT(p) __LED_PORT(p) -#define __LED_DDR(p) DDR ## p -#define _LED_DDR(p) __LED_DDR(p) - -#define LED_DDR(x) _LED_DDR(LED_ ## x ## _BANK) -#define LED_PORT(x) _LED_PORT(LED_ ## x ## _BANK) -#define LED_PIN(x) LED_ ## x ## _PIN - -/* set pin as output */ -#define LED_INIT(i) LED_DDR(i) |= _BV(LED_PIN(i)) - -#define LED_ON(i) LED_PORT(i) &= ~_BV(LED_PIN(i)) -#define LED_OFF(i) LED_PORT(i) |= _BV(LED_PIN(i)) -#define LED_TOGGLE(i) LED_PORT(i) ^= _BV(LED_PIN(i)) - -#endif /* LED_HW_H */ diff --git a/sw/airborne/arch/avr/link_mcu_hw.h b/sw/airborne/arch/avr/link_mcu_hw.h deleted file mode 100644 index 0f54e8806c..0000000000 --- a/sw/airborne/arch/avr/link_mcu_hw.h +++ /dev/null @@ -1,43 +0,0 @@ -/* $Id$ - * - * Copyright (C) 2003-2005 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. - * - */ - -/** \brief handling of avr inter mcu link - * - */ - - - -#ifndef LINK_MCU_HW_H -#define LINK_MCU_HW_H - -#if (__GNUC__ == 3) -#include -#include -#else -#include -#endif - -#define CRC_INIT 0xffff -#define CrcUpdate(_crc, _data) _crc_ccitt_update(_crc, _data) - -#endif /* LINK_MCU_HW_H */ diff --git a/sw/airborne/arch/avr/mcu_periph/adc_arch.c b/sw/airborne/arch/avr/mcu_periph/adc_arch.c deleted file mode 100644 index 6799d7317f..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/adc_arch.c +++ /dev/null @@ -1,167 +0,0 @@ -/* - * Paparazzi AVR adc functions - * - * Copyright (C) 2006 Pascal Brisset, Antoine Drouin, Michel Gorraz - * - * 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. - * - */ - -//// ADC3 MVSUP -//// ADC6 MVSERVO - - -#if (__GNUC__ == 3) -#include -#endif -#include -#include -#include "mcu_periph/adc.h" -#include "std.h" - - -static struct adc_buf* buffers[NB_ADC]; - -void adc_buf_channel(uint8_t adc_channel, struct adc_buf* s, uint8_t av_nb_sample) { - buffers[adc_channel] = s; - s->av_nb_sample = av_nb_sample; -} - - -/************************************************************************/ -#if defined (__AVR_ATmega8__) - - -#define VOLTAGE_TIME 0x07 -#define ANALOG_PORT PORTC -#define ANALOG_PORT_DIR DDRC - - -#ifdef IMU_ANALOG -#define ANALOG_VREF _BV(REFS0) -#else -#define ANALOG_VREF _BV(REFS0) | _BV(REFS1) -#endif - - - -/** - * Called when the voltage conversion is finished - * - * 8.913kHz on mega128 16MHz 1kHz/channel ?? -*/ -SIGNAL( SIG_ADC ) -{ - uint8_t adc_input = ADMUX & 0x7; - struct adc_buf* buf = buffers[adc_input]; - uint16_t adc_value = ADCW; - - if (buf) { - uint8_t new_head = buf->head + 1; - if (new_head >= buf->av_nb_sample) new_head = 0; - buf->sum -= buf->values[new_head]; - buf->values[new_head] = adc_value; - buf->sum += adc_value; - buf->head = new_head; - } - - /* Find the next input */ - adc_input++; - if (adc_input == 4) - adc_input = 6; // ADC 4 and 5 for i2c - if( adc_input >= 8 ) { - adc_input = 0; -#ifdef CTL_BRD_V1_2 - adc_input = 1; // WARNING ADC0 is for rservo driver reset on v1.2.0 -#endif /* CTL_BRD_V1_2 */ - } - /* Select it */ - ADMUX = adc_input | ANALOG_VREF; - /* Restart the conversion */ - sbi( ADCSR, ADSC ); -} - -#endif /* (__AVR_ATmega8__) */ - - - - -/************************************************************************/ -#if defined (__AVR_ATmega128__) - -#define VOLTAGE_TIME 0x07 -#define ANALOG_PORT PORTF -#define ANALOG_PORT_DIR DDRF - - -#define ANALOG_VREF _BV(REFS0) - - -/** - * Called when the voltage conversion is finished - * - * 8.913kHz on mega128 16MHz 1kHz/channel ?? -*/ -SIGNAL( SIG_ADC ) -{ - uint8_t adc_input = ADMUX & 0x7; - struct adc_buf* buf = buffers[adc_input]; - uint16_t adc_value = ADCW; - - if (buf) { - uint8_t new_head = buf->head + 1; - if (new_head >= buf->av_nb_sample) new_head = 0; - buf->sum -= buf->values[new_head]; - buf->values[new_head] = adc_value; - buf->sum += adc_value; - buf->head = new_head; - } - - /* Find the next input */ - adc_input++; - if( adc_input >= 8 ) - adc_input = 0; - /* Select it */ - ADMUX = adc_input | ANALOG_VREF; - /* Restart the conversion */ - sbi( ADCSR, ADSC ); -} -#endif /* (__AVR_ATmega128__) */ - - - -void adc_init( void ) { - uint8_t i; - /* Ensure that our port is for input with no pull-ups */ - ANALOG_PORT = 0x00; - ANALOG_PORT_DIR = 0x00; - - /* Select our external voltage ref */ - ADMUX = ANALOG_VREF; - - /* Select out clock, turn on the ADC interrupt and start conversion */ - ADCSRA = 0 - | VOLTAGE_TIME - | _BV(ADEN ) - | _BV(ADIE ) - | _BV(ADSC ); - - /* Init to 0 (usefull ?) */ - for(i = 0; i < NB_ADC; i++) - buffers[i] = (struct adc_buf*)0; -} diff --git a/sw/airborne/arch/avr/mcu_periph/adc_arch.h b/sw/airborne/arch/avr/mcu_periph/adc_arch.h deleted file mode 100644 index e69de29bb2..0000000000 diff --git a/sw/airborne/arch/avr/mcu_periph/i2c_arch.c b/sw/airborne/arch/avr/mcu_periph/i2c_arch.c deleted file mode 100644 index 7ce2b36c5d..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/i2c_arch.c +++ /dev/null @@ -1,165 +0,0 @@ -/* - * Copyright (C) 2005 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. - * - */ -/** \file i2c_ap.c - * \brief Basic library for I2C - * - */ - -#include -#include -#include "i2c_ap.h" -#include "std.h" - - -#define TWI_START 0x08 -#define TWI_RESTART 0x10 -#define MT_SLA_ACK 0x18 -#define MT_SLA_NACK 0x20 -#define MR_SLA_ACK 0x40 -#define MR_SLA_NACK 0x48 -#define MT_DATA_ACK 0x28 -#define MR_DATA_ACK 0x50 -#define MR_DATA_NACK 0x58 - -uint8_t twi_sla; -uint8_t i2c_buf[TWI_BUF_LEN]; -uint8_t twi_index, twi_len; -volatile bool_t i2c_idle; -uint8_t i2c_debug; -static bool_t *twi_end; - -#define I2cStart() i2c_idle = FALSE; *twi_end = FALSE; TWCR=_BV(TWINT)|_BV(TWSTA)|_BV(TWEN)|_BV(TWIE); -#define I2cStop() i2c_idle= TRUE; *twi_end = TRUE; TWCR=_BV(TWINT)|_BV(TWSTO)|_BV(TWEN); -#define I2cReceive(_ack) TWCR=_BV(TWINT)|_BV(TWEN)| (_ack ? _BV(TWEA) : 0)|_BV(TWIE); -#define I2cReceiveAck TWCR=_BV(TWINT)|_BV(TWEN)| _BV(TWEA) |_BV(TWIE); -#define I2cReceiveNAck TWCR=_BV(TWINT)|_BV(TWEN)| _BV(TWIE); - -#define I2cSendByte(a) { \ - TWDR= a; \ - TWCR=_BV(TWINT)|_BV(TWEN)|_BV(TWIE); \ -} - -#define I2cSendSlaW(a) I2cSendSla(a | I2C_WRITE) -#define I2cSendSlaR(a) I2cSendSla(a | I2C_READ) - - -SIGNAL(SIG_2WIRE_SERIAL) { - // i2c_debug = TWSR; - switch (TWSR & 0xF8) { - case TWI_START: - case TWI_RESTART: - I2cSendByte(twi_sla); - twi_index = 0; - break; - case MR_DATA_ACK: - i2c_buf[twi_index] = TWDR; - twi_index++; - /* Continue */ - case MR_SLA_ACK: /* At least one char */ - I2cReceive(twi_len>twi_index+1); /* Wait and reply with ACK or NACK */ - break; - case MR_SLA_NACK: - case MT_SLA_NACK: - I2cStart(); - break; - case MT_SLA_ACK: - case MT_DATA_ACK: - if (twi_index < twi_len) { - I2cSendByte(i2c_buf[twi_index]); - twi_index++; - return; - } /* Else Stop */ - case MR_DATA_NACK: - i2c_debug = twi_index; - i2c_buf[twi_index] = TWDR; - /* Then Stop */ - default: - I2cStop(); - } -} - -void i2c_send(uint8_t sla, uint8_t _twi_len, bool_t* finished) { - i2c_debug = 0x32; - twi_len = _twi_len; - twi_sla = I2C_TRANSMIT | sla; - twi_end = finished; - I2cStart(); -} - -void i2c_get(uint8_t sla, uint8_t _twi_len, bool_t* finished) { - twi_len = _twi_len; - twi_sla = I2C_RECEIVE | sla; - twi_end = finished; - I2cStart(); -} - - -uint8_t i2c_start(void) { - TWCR=_BV(TWINT)|_BV(TWSTA)|_BV(TWEN); - while (! (TWCR & (1< -#include -#include "std.h" - -#define I2C_NO_ERROR 0 - -#define I2C_RECEIVE 1 -#define I2C_TRANSMIT 0 - -#define I2C_QUIT 0 -#define I2C_CONTINUE 1 - -#define i2c_stop() TWCR=_BV(TWINT)|_BV(TWSTO)|_BV(TWEN); - -#define TWI_BUF_LEN 16 -extern volatile bool_t i2c_idle; -extern uint8_t i2c_debug; -extern uint8_t i2c_buf[TWI_BUF_LEN]; - -extern void i2c_init(void); -extern uint8_t i2c_start(void); -extern uint8_t i2c_sla(uint8_t x); -extern uint8_t i2c_transmit(uint8_t x); -extern uint8_t i2c_receive(uint8_t); -extern void i2c_send(uint8_t address, uint8_t len, bool_t* finished); -extern void i2c_get(uint8_t address, uint8_t len, bool_t* finished); - -#define I2C_START(ADDRESS) { i2c_start(); i2c_sla(ADDRESS); } -#define I2C_START_TX(ADDRESS) I2C_START(ADDRESS | I2C_TRANSMIT) -#define I2C_START_RX(ADDRESS) I2C_START(ADDRESS | I2C_RECEIVE) - -#endif diff --git a/sw/airborne/arch/avr/mcu_periph/spi_arch.c b/sw/airborne/arch/avr/mcu_periph/spi_arch.c deleted file mode 100644 index 93a37e2b62..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/spi_arch.c +++ /dev/null @@ -1,146 +0,0 @@ -/* - * Copyright (C) 2003-2005 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. - * - */ - -/** \file mcu_periph/spi_arch.c - * \brief handling of hardware dependant SPI on AVR architecture - */ - -#include CONFIG -#include "mcu_periph/spi.h" - -#include -#include - -#if (__GNUC__ == 3) -#include -#endif - -#include - -volatile uint8_t spi_idx_buf; - -#define HandleOneSpiByte() { \ - spi_idx_buf++; \ - if (spi_idx_buf < spi_buffer_length) { \ - SPDR = spi_buffer_output[spi_idx_buf]; \ - spi_buffer_input[spi_idx_buf-1] = SPDR; \ - } else if (spi_idx_buf == spi_buffer_length) { \ - spi_buffer_input[spi_idx_buf-1] = SPDR; \ - spi_message_received = TRUE; \ - SpiStop(); \ - } \ - } - - -#ifdef SPI_SLAVE - -volatile bool_t spi_was_interrupted = FALSE; - -void spi_init(void) { - /* set it pin output */ - // IT_DDR |= _BV(IT_PIN); - - /* set MISO pin output */ - SLAVE_SPI_DDR |= _BV(SLAVE_SPI_MISO_PIN); - /* enable SPI, slave, MSB first, sck idle low */ - SPCR = _BV(SPE); - /* enable interrupt */ - SPCR |= _BV(SPIE); -} - -#define SpiStop() {} - - -SIGNAL(SIG_SPI) { - HandleOneSpiByte(); -} - -#endif /** SPI_SLAVE */ - - -/****************************************************************************/ -#ifdef SPI_MASTER - -#include "autopilot.h" - -#define SpiStop() { \ - ClearBit(SPCR,SPIE); \ - ClearBit(SPCR, SPE); \ - SpiUnselectAllSlaves(); \ -} - -volatile uint8_t spi_cur_slave; -uint8_t spi_nb_ovrn; - -void spi_init( void) { - /* Set MOSI and SCK output, all others input */ - MASTER_SPI_DDR |= _BV(MASTER_SPI_MOSI_PIN)| _BV(MASTER_SPI_SCK_PIN); - - /* enable pull up for miso */ - // SPI_PORT |= _BV(MASTER_SPI_MISO_PIN); - - /* Set SS0 output */ - SetBit( MASTER_SPI_SS0_DDR, MASTER_SPI_SS0_PIN); - /* SS0 idles high (don't select slave yet)*/ - -#if 0 - /* Set SS1 output */ - SetBit( MASTER_SPI_SS1_DDR, MASTER_SPI_SS1_PIN); - /* SS1 idles high (don't select slave yet)*/ - - /* Set SS2 output */ - SetBit( MASTER_SPI_SS2_DDR, MASTER_SPI_SS2_PIN); - /* SS2 idles high (don't select slave yet)*/ -#endif - - SpiUnselectAllSlaves(); - - spi_cur_slave = SPI_NONE; -} - - -/** SPI interrupt: starts a delay */ -SIGNAL(SIG_SPI) { - /* if (spi_cur_slave == SPI_SLAVE0) { */ - /* setup OCR1C to pop in 200 clock cycles */ - /* this leaves time for the slave (fbw) */ - /* to process the byte we've sent and to */ - /* prepare a new one to be sent */ - OCR1C = TCNT1 + (200UL*CLOCK)/16; - /* clear interrupt flag */ - SetBit(ETIFR, OCF1C); - /* enable OC1C interrupt */ - SetBit(ETIMSK, OCIE1C); - /* } else - fatal_error_nb++; - */ -} - -/** Send a byte */ -SIGNAL(SIG_OUTPUT_COMPARE1C) { - /* disable OC1C interrupt */ - ClearBit(ETIMSK, OCIE1C); - - HandleOneSpiByte(); -} - -#endif /* SPI_MASTER */ diff --git a/sw/airborne/arch/avr/mcu_periph/spi_arch.h b/sw/airborne/arch/avr/mcu_periph/spi_arch.h deleted file mode 100644 index ae0ad6fd10..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/spi_arch.h +++ /dev/null @@ -1,84 +0,0 @@ -/* - * Copyright (C) 2005-2006 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. - * - */ - -#ifndef SPI_ARCH_H -#define SPI_ARCH_H - -/** Index in SPI buffers: one is enough for full duplex communication */ -extern volatile uint8_t spi_idx_buf; - -#define SpiInitBuf() { \ - spi_idx_buf = 0; \ - SPDR = spi_buffer_output[0]; \ - spi_message_received = FALSE; \ -} - -#ifdef SPI_SLAVE - -#define SpiStart() SpiInitBuf() - -#endif /* SPI_SLAVE */ - - - - - -#ifdef SPI_MASTER - -/* Enable SPI, Master, clock fck/16, interrupt */ -#define SpiStart() { \ - SPCR = _BV(SPE) | _BV(MSTR) | _BV(SPR0); \ - uint8_t foo; \ - if (bit_is_set(SPSR, SPIF)) \ - foo = SPDR; \ - SPCR |= _BV(SPIE); \ - SpiInitBuf(); \ -} - -#define SpiUnselectAllSlaves() { \ - spi_cur_slave = SPI_NONE; \ - SetBit( MASTER_SPI_SS0_PORT, MASTER_SPI_SS0_PIN );\ - /* \ - SetBit( MASTER_SPI_SS1_PORT, MASTER_SPI_SS1_PIN ); \ - SetBit( MASTER_SPI_SS2_PORT, MASTER_SPI_SS2_PIN );\ - */ \ -} - -#define SpiSelectSlave0() { \ - spi_cur_slave = SPI_SLAVE0; \ - ClearBit( MASTER_SPI_SS0_PORT, MASTER_SPI_SS0_PIN );\ -} - -#define SpiSelectSlave1() { \ - spi_cur_slave = SPI_SLAVE1; \ - ClearBit( MASTER_SPI_SS1_PORT, MASTER_SPI_SS1_PIN );\ -} - -#define SpiSelectSlave2() { \ - spi_cur_slave = SPI_SLAVE2; \ - ClearBit( MASTER_SPI_SS2_PORT, MASTER_SPI_SS2_PIN );\ -} - -#endif /* SPI_MASTER */ - - -#endif /* SPI_ARCH_H */ diff --git a/sw/airborne/arch/avr/mcu_periph/uart_arch.c b/sw/airborne/arch/avr/mcu_periph/uart_arch.c deleted file mode 100644 index a2562e3c17..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/uart_arch.c +++ /dev/null @@ -1,256 +0,0 @@ -/* - * Copyright (C) 2003 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. - * - */ - -/** \file uart_hw.c - * \brief avr uart low level functions - * - */ -#include "mcu_periph/uart.h" -#include "mcu_periph/sys_time.h" - -#define B2400 2400UL -#define B9600 9600UL -#define B38400 38400UL - -#if defined (__AVR_ATmega8__) - -#define TX_BUF_SIZE 256 -static uint8_t tx_head; /* next free in buf */ -static volatile uint8_t tx_tail; /* next char to send */ -static uint8_t tx_buf[ TX_BUF_SIZE ]; - -/* - * UART Baud rate generation settings: - * - * With 16.0 MHz clock,UBRR=25 => 38400 baud - * - */ - -void uart0_init_tx( void ) { - UBRRH = 0; - UBRRL = F_CPU/(16*UART0_BAUD)-1; - - /* single speed */ - UCSRA = 0; - /* Enable transmitter */ - UCSRB = _BV(TXEN); - /* Set frame format: 8data, 1stop bit */ - UCSRC = _BV(URSEL) | _BV(UCSZ1) | _BV(UCSZ0); -} - -void uart0_init_rx( void ) { - /* Enable receiver */ - UCSRB |= _BV(RXEN); - /* Enable uart receive interrupt */ - sbi( UCSRB, RXCIE ); -} - -bool_t uart0_check_free_space( uint8_t len) { - int8_t space; - if ((space = (tx_tail - tx_head)) <= 0) - space += TX_BUF_SIZE; - - return (uint8_t)(space - 1) >= len; -} - -void uart0_transmit( unsigned char data ) { - if (UCSRB & _BV(TXCIE)) { - /* we are waiting for the last char to be sent : buffering */ - if (tx_tail == tx_head + 1) { /* BUF_SIZE = 256 */ - /* Buffer is full (almost, but tx_head = tx_tail means "empty" */ - return; - } - tx_buf[tx_head] = data; - tx_head++; /* BUF_SIZE = 256 */ - } else { /* Channel is free: just send */ - UDR = data; - sbi(UCSRB, TXCIE); - } -} - - -SIGNAL(SIG_UART_TRANS) { - if (tx_head == tx_tail) { - /* Nothing more to send */ - cbi(UCSRB, TXCIE); /* disable interrupt */ - } else { - UDR = tx_buf[tx_tail]; - tx_tail++; /* warning tx_buf_len is 256 */ - } -} - -#endif /* (__AVR_ATmega8__) */ - - -#if defined (__AVR_ATmega128__) - -#define TX_BUF_SIZE 256 - -#ifdef USE_UART0 -static uint8_t tx_head0; /* next free in buf */ -static volatile uint8_t tx_tail0; /* next char to send */ -uint8_t tx_buf0[ TX_BUF_SIZE ]; - -uint16_t uart0_rx_insert_idx, uart0_rx_extract_idx; -uint8_t uart0_rx_buffer[UART0_RX_BUFFER_SIZE]; - -void uart0_init_tx( void ) { - UBRR0H = 0; - UBRR0L = F_CPU/(16*UART0_BAUD)-1; - - /* single speed */ - UCSR0A = 0; - /* Enable transmitter */ - UCSR0B = _BV(TXEN); - /* Set frame format: 8data, 1stop bit */ - UCSR0C = _BV(UCSZ1) | _BV(UCSZ0); - - tx_head0 = 0; - tx_tail0 = 0; -} - -void uart0_init_rx( void ) { - /* Enable receiver */ - UCSR0B |= _BV(RXEN); - - /* Enable uart receive interrupt */ - sbi(UCSR0B, RXCIE ); -} - -bool_t uart0_check_free_space( uint8_t len) { - int8_t space; - if ((space = (tx_tail0 - tx_head0)) <= 0) - space += TX_BUF_SIZE; - - return (uint16_t)(space - 1) >= len; -} - -void uart0_transmit( unsigned char data ) { - if (UCSR0B & _BV(TXCIE)) { - /* we are waiting for the last char to be sent : buffering */ - if (tx_tail0 == tx_head0 + 1) { /* BUF_SIZE = 256 */ - /* Buffer is full (almost, but tx_head = tx_tail means "empty" */ - return; - } - tx_buf0[tx_head0] = data; - tx_head0++; /* BUF_SIZE = 256 */ - } else { /* Channel is free: just send */ - UDR0 = data; - sbi(UCSR0B, TXCIE); - } -} - -SIGNAL(SIG_UART0_TRANS) { - if (tx_head0 == tx_tail0) { - /* Nothing more to send */ - cbi(UCSR0B, TXCIE); /* disable interrupt */ - } else { - UDR0 = tx_buf0[tx_tail0]; - tx_tail0++; /* warning tx_buf_len is 256 */ - } -} - - -SIGNAL( SIG_UART0_RECV ) { - uart0_rx_buffer[uart0_rx_insert_idx] = UDR0; - uart0_rx_insert_idx = Uart0RxBufferNext(uart0_rx_insert_idx); -} - -#endif /** USE_UART0 */ - -#ifdef USE_UART1 - -static uint8_t tx_head1; /* next free in buf */ -static volatile uint8_t tx_tail1; /* next char to send */ -static uint8_t tx_buf1[ TX_BUF_SIZE ]; - -uint16_t uart1_rx_insert_idx, uart1_rx_extract_idx; -uint8_t uart1_rx_buffer[UART1_RX_BUFFER_SIZE]; - -void uart1_init_tx( void ) { - /* set baud rate */ - UBRR1H = 0; - UBRR1L = F_CPU/(16*UART1_BAUD)-1; - - /* single speed */ - UCSR1A = 0; - /* Enable transmitter */ - UCSR1B = _BV(TXEN); - /* Set frame format: 8data, 1stop bit */ - UCSR1C = _BV(UCSZ1) | _BV(UCSZ0); - - tx_head1 = 0; - tx_tail1 = 0; -} - -void uart1_init_rx( void ) { - /* Enable receiver */ - UCSR1B |= _BV(RXEN); - /* Enable uart receive interrupt */ - sbi(UCSR1B, RXCIE ); -} - -bool_t uart1_check_free_space( uint8_t len) { - int8_t space; - if ((space = (tx_tail1 - tx_head1)) <= 0) - space += TX_BUF_SIZE; - - return (uint16_t)(space - 1) >= len; -} - -void uart1_transmit( unsigned char data ) { - if (UCSR1B & _BV(TXCIE)) { - /* we are waiting for the last char to be sent : buffering */ - if (tx_tail1 == tx_head1 + 1) { /* BUF_SIZE = 256 */ - /* Buffer is full (almost, but tx_head = tx_tail means "empty" */ - return; - } - tx_buf1[tx_head1] = data; - tx_head1++; /* BUF_SIZE = 256 */ - } else { /* Channel is free: just send */ - UDR1 = data; - sbi(UCSR1B, TXCIE); - } -} - - -SIGNAL(SIG_UART1_TRANS) { - if (tx_head1 == tx_tail1) { - /* Nothing more to send */ - cbi(UCSR1B, TXCIE); /* disable interrupt */ - } else { - UDR1 = tx_buf1[tx_tail1]; - tx_tail1++; /* warning tx_buf_len is 256 */ - } -} - - -SIGNAL( SIG_UART1_RECV ) { - uart1_rx_buffer[uart1_rx_insert_idx] = UDR1; - uart1_rx_insert_idx = Uart0RxBufferNext(uart1_rx_insert_idx); -} - -#endif /* USE_UART1 */ - -#endif /* (__AVR_ATmega128__) */ - - diff --git a/sw/airborne/arch/avr/mcu_periph/uart_arch.h b/sw/airborne/arch/avr/mcu_periph/uart_arch.h deleted file mode 100644 index 800534df80..0000000000 --- a/sw/airborne/arch/avr/mcu_periph/uart_arch.h +++ /dev/null @@ -1,106 +0,0 @@ -/* - * Copyright (C) 2005 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. - * - */ - -/** \file uart_hw.h - * \brief avr uart low level headers - * - */ - -#ifndef UART_HW_H -#define UART_HW_H - -#include -#if (__GNUC__ == 3) -#include -#endif -#include -#include "std.h" - - -/************************************************************************/ -#if defined (__AVR_ATmega8__) - -#define ReceiveUart(cb) \ - SIGNAL( SIG_UART_RECV ) { \ - uint8_t c = UDR; \ - cb(c); \ -} - -#endif /* (__AVR_ATmega8__) */ - - -/************************************************************************/ -#if defined (__AVR_ATmega128__) - -extern uint8_t tx_buf0[256]; /** For debugging purpose */ - -extern void uart0_init_tx(void); -extern void uart0_init_rx(void); -extern void uart1_init(void); - -extern void uart0_transmit(const uint8_t); -extern void uart1_transmit(const uint8_t); - -#define UART0_RX_BUFFER_SIZE 32 // UART0 receive buffer size -#define UART1_RX_BUFFER_SIZE 32 // UART1 receive buffer size -#define UART0_RX_BUFFER_SIZE_MASK 0x1f -#define UART1_RX_BUFFER_SIZE_MASK 0x1f - -#ifdef UART0_RX_BUFFER_SIZE_MASK -#define Uart0RxBufferNext(_x) ((_x+1)&UART0_RX_BUFFER_SIZE_MASK) -#else -#define Uart0RxBufferNext(_x) ((_x+1)%UART0_RX_BUFFER_SIZE) -#endif - -#ifdef UART1_RX_BUFFER_SIZE_MASK -#define Uart1RxBufferNext(_x) ((_x+1)&UART1_RX_BUFFER_SIZE_MASK) -#else -#define Uart1RxBufferNext(_x) ((_x+1)%UART1_RX_BUFFER_SIZE) -#endif - - -extern uint16_t uart0_rx_insert_idx, uart0_rx_extract_idx; -extern uint8_t uart0_rx_buffer[UART0_RX_BUFFER_SIZE]; - -#define Uart0ChAvailable() (uart0_rx_insert_idx != uart0_rx_extract_idx) - -#define Uart0Getch() ({\ - uint8_t ret = uart0_rx_buffer[uart0_rx_extract_idx]; \ - uart0_rx_extract_idx = Uart0RxBufferNext(uart0_rx_extract_idx); \ - ret; \ -}) - - -extern uint16_t uart1_rx_insert_idx, uart1_rx_extract_idx; -extern uint8_t uart1_rx_buffer[UART1_RX_BUFFER_SIZE]; - -#define Uart1ChAvailable() (uart1_rx_insert_idx != uart1_rx_extract_idx) - -#define Uart1Getch() ({\ - uint8_t ret = uart1_rx_buffer[uart1_rx_extract_idx]; \ - uart1_rx_extract_idx = Uart1RxBufferNext(uart1_rx_extract_idx); \ - ret; \ -}) - -#endif /* (__AVR_ATmega128__) */ - -#endif /* UART_HW_H */ diff --git a/sw/airborne/arch/avr/ppm_hw.c b/sw/airborne/arch/avr/ppm_hw.c deleted file mode 100644 index fa768403f8..0000000000 --- a/sw/airborne/arch/avr/ppm_hw.c +++ /dev/null @@ -1,119 +0,0 @@ -/* $Id$ - * Copied from autopilot (autopilot.sf.net) thanx alot Trammell - * - * (c) 2003 Trammell Hudson - * (c) 2003 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. - * - */ - -#if (__GNUC__ == 3) -#include -#endif - -#include -#include "ppm.h" -#include "mcu_periph/sys_time.h" - -/* - * Pulse width is computed as the difference between now and the - * previous pulse. If no pulse has been received between then and - * now, the time of the last pulse will be equal to the last pulse - * we measured. Unfortunately, the Input Capture Flag (ICF1) will - * not be set since the interrupt routine disables it. - * - * Sync pulses are timed with Timer2, which runs at Clk/1024. This - * is slow enough at both 4 and 8 Mhz to measure the lengthy (10ms - * or longer) pulse. - * - * Otherwise, compute the pulse width with the 16-bit timer1, - * push the pulse width onto the stack and increment the - * pulse counter until we have received eight pulses. - */ - -uint16_t ppm_pulses[ PPM_NB_PULSES ]; -volatile bool_t ppm_valid; - -/* MC3030, Trame PPM7: 25ms, 10.4 au neutre, - sync pulse = 16.2ms with low value on every channels */ - -#if CLOCK == 8 -#define RestartPpmCycle() { state = 0; sync_start = TCNT2 + (tmr2_ov_cnt << 8); return; } -#else -#define RestartPpmCycle() { state = 0; sync_start = TCNT2; return; } -#endif - -#ifdef TIMER1_TOP -static volatile uint16_t tmr1_ov_cnt = 0; -SIGNAL(SIG_OVERFLOW1) { - tmr1_ov_cnt += TIMER1_TOP; - return; -} -#endif - - -SIGNAL( SIG_INPUT_CAPTURE1 ) -{ - static uint16_t last; - uint16_t this; - uint16_t width; - static uint8_t state = 0; - static uint16_t sync_start; - - this = ICR1; -#ifdef TIMER1_TOP - this += tmr1_ov_cnt; -#endif - width = this - last; - last = this; - - if( state == 0 ) { - uint16_t end = TCNT2; -#if CLOCK == 8 - end += tmr2_ov_cnt << 8; - uint16_t diff = (end - sync_start); -#else - uint8_t diff = (end - sync_start); -#endif - sync_start = end; - - /* The frame period of the mc3030 seems to be 25ms. - * One pulse lasts from 1.05ms to 2.150ms. - * Sync pulse is at least 7ms : (7000*CLOCK)/1024 = 109 - */ - if( diff > LONG_CPU_TICKS_OF_USEC(PPM_SYNC_MIN_LEN) && - diff < LONG_CPU_TICKS_OF_USEC(PPM_SYNC_MAX_LEN) ) { - state = 1; - } - } - else { - /* Read a data pulses */ - if( width > CPU_TICKS_OF_USEC(PPM_DATA_MAX_LEN) || - width < CPU_TICKS_OF_USEC(PPM_DATA_MIN_LEN)) - RestartPpmCycle(); - ppm_pulses[state - 1] = width; - - if (state >= PPM_NB_PULSES) { - ppm_valid = TRUE; - RestartPpmCycle(); - } else - state++; - } - return; -} diff --git a/sw/airborne/arch/avr/ppm_hw.h b/sw/airborne/arch/avr/ppm_hw.h deleted file mode 100644 index ee92b41d44..0000000000 --- a/sw/airborne/arch/avr/ppm_hw.h +++ /dev/null @@ -1,86 +0,0 @@ -/* $Id$ - * - * Decoder for the trainer ports or hacked receivers for both - * Futaba and JR formats. The ppm_valid flag is set whenever - * a valid frame is received. - * - * Pulse widths are stored as unscaled 16-bit values in ppm_pulses[]. - * If you require actual microsecond values, divide by CLOCK. - * For an 8 Mhz clock and typical servo values, these will range - * from 0x1F00 to 0x4000. - * - * Copied from autopilot (autopilot.sf.net) thanx alot Trammell - * - * (c) 2002 Trammell Hudson - * (c) 2003 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. - * - */ - -#ifndef PPM_HW_H -#define PPM_HW_H - -#ifdef FBW - -#include -#include - -#include CONFIG - -/* - * PPM pulses are falling edge clocked on the ICP, which records - * the state of the global clock. We do not use any noise - * canceling features. - * - * JR might be rising edge clocked; set that as an option - */ -static inline void -ppm_init( void ) -{ -#if defined RADIO_CONTROL_TYPE && RADIO_CONTROL_TYPE == RC_FUTABA - cbi( TCCR1B, ICES1 ); -#elif defined RADIO_CONTROL_TYPE && RADIO_CONTROL_TYPE == RC_JR - sbi( TCCR1B, ICES1 ); -#else -#error "ppm_hw.h: Unknown RADIO_CONTROL_TYPE" -#endif - /* No noise cancelation */ - sbi( TCCR1B, ICNC1 ); - - /* Set ICP to input, no internal pull up */ - cbi( PPM_DDR, PPM_PIN); - - /* Enable interrupt on input capture */ - sbi( TIMSK, TICIE1 ); - -#ifdef TIMER1_TOP - /* Enable timer1 overflow it. */ - /* needed to increase timer1 count to 16 bits in fast pwm mode (TIMER1_TOP rollover) */ - sbi( TIMSK, TOIE1 ); -#endif - ppm_valid = FALSE; -} - -#endif /* FBW */ - -extern volatile uint16_t ppm_diff; - - - -#endif /* PPM_HW_H */ diff --git a/sw/airborne/arch/avr/servos_4017.c b/sw/airborne/arch/avr/servos_4017.c deleted file mode 100644 index e5a0c90ef8..0000000000 --- a/sw/airborne/arch/avr/servos_4017.c +++ /dev/null @@ -1,138 +0,0 @@ -/* $Id$ - * - * (c) 2003-2006 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. - * - */ - - -/** Implementation of actuators.h */ - -#include -#if (__GNUC__ == 3) -#include -#endif -#include -#include "servos_4017.h" -#include "actuators.h" -#include "mcu_periph/sys_time.h" -#include CONFIG - - -/* holds the servo pulses width in clock ticks */ -uint16_t servo_widths[_4017_NB_CHANNELS]; - -/* - * We use the output compare registers to generate our servo pulses. - * These should be connected to a decade counter that routes the - * pulses to the appropriate servo. - * - * Initialization involves: - * - * - Reseting the decade counters - * - Writing the first pulse width to the counters - * - Setting output compare to set the clock line by calling servo_enable() - * - Bringing down the reset lines - * - * Ideally, you can use two decade counters to drive 20 servos. - */ -void actuators_init( void ) { - uint8_t i; - /* Configure the reset and clock lines as output */ - _4017_RESET_DDR |= _BV(_4017_RESET_PIN); - _4017_CLOCK_DDR |= _BV(_4017_CLOCK_PIN); - /* Reset the decade counter */ - sbi( _4017_RESET_PORT, _4017_RESET_PIN ); - /* Lower the clock line */ - cbi( _4017_CLOCK_PORT, _4017_CLOCK_PIN ); - /* Set all servos at their midpoints */ - for( i=0 ; i < _4017_NB_CHANNELS ; i++ ) - servo_widths[i] = CPU_TICKS_OF_USEC(1500); - /* Set servos to go off some long time from now */ - SERVO_OCR = 32768ul; - /* Set output compare to toggle the output bits */ - TCCR1A |= _BV(SERVO_COM0 ); -#ifdef SERVOS_FALLING_EDGE - /* Starts CLOCK high for the falling edge case */ - TCCR1A |= _BV(SERVO_FORCE); -#endif - /* Clear the interrupt flags in case they are set */ - TIFR = _BV(SERVO_FLAG); - /* Unassert the decade counter reset to start it running */ - cbi( _4017_RESET_PORT, _4017_RESET_PIN ); - /* Enable our output compare interrupts */ - TIMSK |= _BV(SERVO_ENABLE ); -} - - -/* - * Interrupt routine - * - * write the next pulse width to OCR register and - * assert the servo signal. It will be cleared by - * the following compare match. - */ -SIGNAL( SIG_OUTPUT_COMPARE1A ) -{ - static uint8_t servo = 0; - uint16_t width; - -#ifdef SERVOS_FALLING_EDGE -#define RESET_WIDTH CPU_TICKS_OF_USEC(1000) -#define FIRST_PULSE_WIDTH CPU_TICKS_OF_USEC(100) -/** The clock pin has been initialized high and is toggled down by -the timer. - Unfortunately it seems that reset does not work on 4017 in this case if it -occurs after the first falling edge. We add two more states at the end of -the sequence: - - keeping clock low, reset high during 1ms - - clock high (toggled by the timer), reset down, during 100us (looks like - the first pulse of a standard RC */ - if (servo == _4017_NB_CHANNELS) { - sbi( _4017_RESET_PORT, _4017_RESET_PIN ); - /** Start a long 1ms reset, keep clock low */ - SERVO_OCR += RESET_WIDTH; - servo++; - return; - } - if (servo > _4017_NB_CHANNELS) { - /** Clear the reset, the clock has been toggled high */ - cbi( _4017_RESET_PORT, _4017_RESET_PIN ); - /** Starts a short pulse-like period */ - SERVO_OCR += FIRST_PULSE_WIDTH; - servo=0; /** Starts a new sequence next time */ - return; - } -#else - if (servo >= _4017_NB_CHANNELS) { - sbi( _4017_RESET_PORT, _4017_RESET_PIN ); - servo = 0; - // FIXME: 500 ns required by 4017 reset ???? why does it work without! - // asm( "nop; nop; nop; nop;nop; nop; nop; nop;nop; nop; nop; nop;nop; nop; nop; nop;" ); - cbi( _4017_RESET_PORT, _4017_RESET_PIN ); - } -#endif - width = servo_widths[servo]; - - SERVO_OCR += width; - - TCCR1A |= _BV(SERVO_FORCE); - - servo++; -} diff --git a/sw/airborne/arch/avr/servos_4017.h b/sw/airborne/arch/avr/servos_4017.h deleted file mode 100644 index 7ecffaef96..0000000000 --- a/sw/airborne/arch/avr/servos_4017.h +++ /dev/null @@ -1,38 +0,0 @@ -/* $Id$ - * - * (c) 2003-2005 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 extern uint16_t servo_widths[_4017_NB_CHANNELS];(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. - * - */ - -#ifndef SERVO_4017_H -#define SERVO_4017_H - -#define SERVOS_TICS_OF_USEC(_us) CPU_TICKS_OF_USEC(_us) -#define ChopServo(x,a,b) Chop(x, a, b) - -#define _4017_NB_CHANNELS 10 -extern uint16_t servo_widths[_4017_NB_CHANNELS]; -#define Actuator(i) servo_widths[i] - -#define ActuatorsCommit() {} - -#endif /* SERVO_4017_H */ - - diff --git a/sw/airborne/arch/avr/servos_direct_hw.c b/sw/airborne/arch/avr/servos_direct_hw.c deleted file mode 100644 index b29844f12d..0000000000 --- a/sw/airborne/arch/avr/servos_direct_hw.c +++ /dev/null @@ -1,25 +0,0 @@ -/* Implementation of command.h */ - -/* - 3 servos on OC3A OC3B OC3C using Timer3 prescaled at 8 -*/ - -#include "servos_direct_hw.h" -#include "std.h" -#include "actuators.h" -#include "generated/airframe.h" - -void actuators_init ( void ) { - /* OC3A, OC3B, OC3C outputs */ - DDRE |= _BV(3) | _BV(4) | _BV(5); - /* set timer3 in fast PWM mode, with TOP defined by ICR3 , prescaled to 8 */ - TCCR3A = _BV(WGM31) | _BV(COM3A1) | _BV(COM3B1) | _BV(COM3C1); - TCCR3B = _BV(WGM32) | _BV(WGM33) | _BV(CS31); - /* set timer3 rollover */ - ICR3 = TIMER3_TOP; - /* Set all servos at their midpoints */ - Actuator(0) = SERVOS_TICS_OF_USEC(1500); - Actuator(1) = SERVOS_TICS_OF_USEC(1500); - Actuator(2) = SERVOS_TICS_OF_USEC(1500); -} - diff --git a/sw/airborne/arch/avr/servos_direct_hw.h b/sw/airborne/arch/avr/servos_direct_hw.h deleted file mode 100644 index 84ed601619..0000000000 --- a/sw/airborne/arch/avr/servos_direct_hw.h +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef SERVOS_DIRECT_HW_H -#define SERVOS_DIRECT_HW_H - -#include -#include CONFIG - -/* servo refresh rate in HZ */ -#define SERVO_REFRESH_RATE 50 -/* timer3 prescaler */ -#define TIMER3_PRESCALER 8 -#define TIMER3_TOP (CLOCK*1e6/SERVO_REFRESH_RATE/TIMER3_PRESCALER) -#define SERVOS_TICS_OF_USEC(s) ((s)*CLOCK/TIMER3_PRESCALER) -#define ChopServo(x, min, max) Chop(x, min, max) - -#define SERVO_REG_0 OCR3A -#define SERVO_REG_1 OCR3B -#define SERVO_REG_2 OCR3C -#define COMMAND_(i) SERVO_REG_ ## i -#define Actuator(i) COMMAND_(i) - -#define ActuatorsCommit() {} - -#endif /* SERVOS_DIRECT_HW_H */ diff --git a/sw/airborne/arch/avr/servos_esc_hw.c b/sw/airborne/arch/avr/servos_esc_hw.c deleted file mode 100644 index 125bb01eb6..0000000000 --- a/sw/airborne/arch/avr/servos_esc_hw.c +++ /dev/null @@ -1,51 +0,0 @@ -/* $Id$ - * - * (c) 2006 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. - * - */ - - - - -/** Implementation of actuators.h */ - -/* - - 4 DC motor controller with mosfets on OCR1A OCR3A OCR3B OCR3C - -*/ - -#include -#include "servos_esc_hw.h" -#include CONFIG - - -void actuators_init ( void ) { - /* OC1A output */ - DDRB |= _BV(5); - /* fast PWM, 10 bits */ - TCCR1A |= _BV(WGM10) | _BV(WGM11) | _BV(COM1A1); - TCCR1B |= _BV(WGM12); - /* OC3A, OC3B, OC3C outputs */ - DDRE |= _BV(3) | _BV(4) | _BV(5); - /* fast PWM : 10 bits */ - TCCR3A |= _BV(WGM30) | _BV(WGM31) | _BV(COM3A1) | _BV(COM3B1) | _BV(COM3C1); - TCCR3B |= _BV(WGM32); -} diff --git a/sw/airborne/arch/avr/servos_esc_hw.h b/sw/airborne/arch/avr/servos_esc_hw.h deleted file mode 100644 index d5424b6e7a..0000000000 --- a/sw/airborne/arch/avr/servos_esc_hw.h +++ /dev/null @@ -1,50 +0,0 @@ -/* $Id$ - * - * Copied from autopilot (autopilot.sf.net) thanx alot Trammell - * (c) 2003-2005 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. - * - */ - -#ifndef SERVOS_ESC_HW_H -#define SERVOS_ESC_HW_H - - -/** Implementation of actuators.h */ - -/* - 4 DC motor controller with mosfets on OCR1A OCR3A OCR3B OCR3C -*/ - -#include - -#define MAX_TICK 0x3FF -#define MOT_CTL_0 OCR3C -#define MOT_CTL_1 OCR1A -#define MOT_CTL_2 OCR3B -#define MOT_CTL_3 OCR3A - -#define COMMAND_(i) MOT_CTL_ ## i -#define Actuator(i) COMMAND_(i) -#define ChopServo(x,_a,b) (x > b ? b : x) -#define SERVOS_TICS_OF_USEC(s) (s) - -#define ActuatorsCommit() {} - -#endif /* SERVOS_ESC_HW_H */ diff --git a/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.c b/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.c deleted file mode 100644 index cbb337f618..0000000000 --- a/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * Copyright (C) 2003 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. - * - */ - -/** \file audio_telemetry_hw.c - * \brief Handling of a CMX 469 on avr mega128 architecture - */ - -#include - -#if (__GNUC__ == 3) -#include -#endif - -#include -#include "audio_telemetry.h" - -uint8_t audio_telemetry_nb_ovrn; - -uint8_t tx_head; -volatile uint8_t tx_tail; -uint8_t tx_buf[ TX_BUF_SIZE ]; - -uint8_t tx_byte; -uint8_t tx_byte_idx; - - -SIGNAL( AUDIO_TELEMETRY_CLK_INT_SIG ) { - /* start bit */ - if (tx_byte_idx == 0) - cbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_DATA); - /* 8 data bits */ - else if (tx_byte_idx < 9) { - if (tx_byte & 0x01) - sbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_DATA); - else - cbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_DATA); - tx_byte >>= 1; - } - /* stop_bit */ - else { - sbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_DATA); - } - tx_byte_idx++; - /* next byte */ - if (tx_byte_idx >= 10) { - /* if we have nothing left to transmit */ - if( tx_head == tx_tail ) { - /* disable clock interrupt */ - cbi( EIMSK, AUDIO_TELEMETRY_CLK_INT ); - } else { - /* else load next byte */ - AUDIO_TELEMETRY_LOAD_NEXT_BYTE(); - } - } -} diff --git a/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.h b/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.h deleted file mode 100644 index f7e2e1d582..0000000000 --- a/sw/airborne/arch/avr/subsystems/datalink/audio_telemetry_hw.h +++ /dev/null @@ -1,94 +0,0 @@ -/* - * Copyright (C) 2003 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. - * - */ - -/** \file audio_telemetry_hw.h - * \brief AVR CMX469 low level functions - * - */ - - -#ifndef AUDIO_TELEMETRY_HW_H -#define AUDIO_TELEMETRY_HW_H - -#include -#include "std.h" - -#define AUDIO_TELEMETRY_CHECK_RUNNING() { \ - if (!(EIMSK & _BV(AUDIO_TELEMETRY_CLK_INT))) { \ - AUDIO_TELEMETRY_LOAD_NEXT_BYTE() \ - sbi(EIFR, INTF0); \ - sbi(EIMSK, AUDIO_TELEMETRY_CLK_INT); \ - } \ -} - - -#define AUDIO_TELEMETRY_TX_PORT PORTD -#define AUDIO_TELEMETRY_TX_DDR DDRD -#define AUDIO_TELEMETRY_TX_EN 7 -#define AUDIO_TELEMETRY_TX_DATA 6 - -#ifdef CTL_BRD_V1_2 -#define AUDIO_TELEMETRY_CLK_DDR DDRD -#define AUDIO_TELEMETRY_CLK_PORT PORTD -#define AUDIO_TELEMETRY_CLK 0 -#define AUDIO_TELEMETRY_CLK_INT INT0 -#define AUDIO_TELEMETRY_CLK_INT_REG EICRA -#define AUDIO_TELEMETRY_CLK_INT_CFG _BV(ISC01) -#define AUDIO_TELEMETRY_CLK_INT_SIG SIG_INTERRUPT0 - -#define AUDIO_TELEMETRY_OSC_DDR DDRB -#define AUDIO_TELEMETRY_OSC_PORT PORTB -#define AUDIO_TELEMETRY_OSC 4 -#endif /* CTL_BRD_V1_2 */ - -#ifdef CTL_BRD_V1_2_1 -#define AUDIO_TELEMETRY_CLK_DDR DDRE -#define AUDIO_TELEMETRY_CLK_PORT PORTE -#define AUDIO_TELEMETRY_CLK 4 -#define AUDIO_TELEMETRY_CLK_INT INT4 -#define AUDIO_TELEMETRY_CLK_INT_REG EICRB -#define AUDIO_TELEMETRY_CLK_INT_CFG _BV(ISC41) -#define AUDIO_TELEMETRY_CLK_INT_SIG SIG_INTERRUPT4 -#define AUDIO_TELEMETRY_OSC_DDR DDRB -#define AUDIO_TELEMETRY_OSC_PORT PORTB -#define AUDIO_TELEMETRY_OSC 4 -#endif /* CTL_BRD_V1_2_1 */ - -static inline void audio_telemetry_init ( void ) { - /* setup TIMER0 to generate a 4MHz clock */ - AUDIO_TELEMETRY_OSC_DDR |= _BV(AUDIO_TELEMETRY_OSC); - OCR0 = 1; /* 4MhZ */ - TCCR0 = _BV(WGM01) | _BV(COM00) | _BV(CS00); - - /* setup TX_EN and TX_DATA pin as output */ - AUDIO_TELEMETRY_TX_DDR |= _BV(AUDIO_TELEMETRY_TX_EN) | _BV(AUDIO_TELEMETRY_TX_DATA); - /* data idles hight */ - sbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_DATA); - /* enable transmitter */ - cbi(AUDIO_TELEMETRY_TX_PORT, AUDIO_TELEMETRY_TX_EN); - /* set interrupt on failing edge of clock */ - AUDIO_TELEMETRY_CLK_INT_REG |= AUDIO_TELEMETRY_CLK_INT_CFG; -} - - - -#endif diff --git a/sw/airborne/arch/avr/sys_time_hw.c b/sw/airborne/arch/avr/sys_time_hw.c deleted file mode 100644 index 30db5fae5f..0000000000 --- a/sw/airborne/arch/avr/sys_time_hw.c +++ /dev/null @@ -1,22 +0,0 @@ -#include -#if (__GNUC__ == 3) -#include -#endif -#include - -#include CONFIG -#include "std.h" - -uint16_t cpu_time_ticks; - -#if CLOCK == 8 -volatile uint8_t tmr2_ov_cnt; -volatile bool_t tmr2_overflow; - -SIGNAL(SIG_OVERFLOW2) { - tmr2_ov_cnt++; - tmr2_overflow = TRUE; - return; -} - -#endif diff --git a/sw/airborne/arch/avr/sys_time_hw.h b/sw/airborne/arch/avr/sys_time_hw.h deleted file mode 100644 index bbe2388934..0000000000 --- a/sw/airborne/arch/avr/sys_time_hw.h +++ /dev/null @@ -1,127 +0,0 @@ -/* - * Copyright (C) 2005 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. - * - */ - -/* - *\brief AVR timer functions - * - */ - -#ifndef SYS_TIME_HW_H -#define SYS_TIME_HW_H - -#include "std.h" -#include - -extern uint16_t cpu_time_ticks; - -#define F_CPU (CLOCK*1000000UL) - -/* - * Enable Timer1 (16-bit) running at Clk/1 for the global system - * clock. - * - * Low frequency periodic tasks will be signaled by timer 2 - * running at Clk/1024. For 16 Mhz clock, this will be every - * 16384 microseconds, or 61.03515625 Hz. - */ -static inline void sys_time_init( void ) { - - /* Timer0: Modem clock is started in modem.h in ctc mode*/ - - /* Timer1 @ Clk/1: System clock */ - TCCR1A = 0x00; - TCCR1B = _BV(CS10); - - /* Timer2 @ Clk/1024: Periodic clock */ -#if defined (__AVR_ATmega8__) - TCCR2 = _BV(CS20) | _BV(CS21) | _BV(CS22); -#elif defined (__AVR_ATmega128__) -#if CLOCK == 16 - TCCR2 = _BV(CS20) | _BV(CS22); -#elif CLOCK == 8 - TCCR2 = _BV(CS22); - sbi( TIMSK, TOIE2 ); -#else -#error "Unknwon CLOCK" -#endif -#else -#warning "Unknown arch" -#endif - -#ifdef TIMER3 - /* Timer3 @ Clk/1: motor controller */ - TCCR3A = 0x00; - TCCR3B = _BV(CS10); -#endif - - cpu_time_sec = 0; - cpu_time_ticks = 0; -} - - -#define CPU_TICKS_OF_USEC(us) (uint16_t)((us)*CLOCK) -#define SIGNED_CPU_TICKS_OF_USEC(us) (int16_t)((us)*CLOCK) - -#if CLOCK == 8 -#define LONG_CPU_TICKS_OF_USEC(us) (uint16_t)(((uint32_t)(us)*CLOCK)/256ul) -#else -#define LONG_CPU_TICKS_OF_USEC(us) (uint8_t)(((uint32_t)(us)*CLOCK)/1024ul) -#endif - -/* - * Periodic tasks occur when Timer2 overflows. Check and unset - * the overflow bit. Occurs at 61.03515625 Hz with CLOCK = 16 - * Occurs at 122Hz with CLOCK = 8 - * - */ - -#if CLOCK == 8 -extern volatile uint8_t tmr2_ov_cnt; -extern volatile bool_t tmr2_overflow; -#endif - -#define TICKS_PER_SEC (CLOCK * 1e6 / 1024) - -#if CLOCK == 8 -static inline bool_t sys_time_periodic( void ) { - if( !tmr2_overflow ) - return FALSE; - tmr2_overflow = FALSE; - - return (tmr2_ov_cnt & 0x1); -} -#else -//#define TMR2_PER_SEC 7812 -static inline bool_t sys_time_periodic( void ) { - if( !bit_is_set( TIFR, TOV2 ) ) - return FALSE; - TIFR = _BV(TOV2); - cpu_time_ticks += 256; - if (cpu_time_ticks > TICKS_PER_SEC) { - cpu_time_ticks -= TICKS_PER_SEC; - cpu_time_sec++; - } - return TRUE; -} -#endif - -#endif /* SYS_TIME_HW_H */ diff --git a/sw/airborne/arch/avr/uart_tunnel.c b/sw/airborne/arch/avr/uart_tunnel.c deleted file mode 100644 index bf7563d5a1..0000000000 --- a/sw/airborne/arch/avr/uart_tunnel.c +++ /dev/null @@ -1,61 +0,0 @@ -#include -#include -#if (__GNUC__ == 3) -#include -#endif -#include - -#define UART_PC_PORT PORTE -#define UART_PC_DDR DDRE -#define UART_PC_PIN PINE -#define UART_PC_TX 1 -#define UART_PC_RX 0 - -#define UART_PERPH_PORT PORTD -#define UART_PERPH_DDR DDRD -#define UART_PERPH_PIN PIND -#define UART_PERPH_TX 3 -#define UART_PERPH_RX 2 - -#ifndef cbi -#define cbi(sfr, bit) (_SFR_BYTE(sfr) &= ~_BV(bit)) -#endif -#ifndef sbi -#define sbi(sfr, bit) (_SFR_BYTE(sfr) |= _BV(bit)) -#endif - - -int main( void ) { - - /* setup PC_TX as output */ - UART_PC_DDR |= _BV(UART_PC_TX); - - /* setup PC_RX as input, no pullup */ - UART_PC_DDR &= ~_BV(UART_PC_RX); - UART_PC_PORT &= ~_BV(UART_PC_RX); - - /* setup PERPH_TX as output */ - UART_PERPH_DDR |= _BV(UART_PERPH_TX); - - /* setup PERPH_RX as input, no pullup */ - UART_PERPH_DDR &= ~_BV(UART_PERPH_RX); - UART_PERPH_PORT &= ~_BV(UART_PERPH_RX); - - while(1) - { - if (bit_is_set(UART_PERPH_PIN, UART_PERPH_RX)) { - sbi(UART_PC_PORT, UART_PC_TX); - } else { - cbi(UART_PC_PORT, UART_PC_TX); - } - if (bit_is_set(UART_PC_PIN, UART_PC_RX)) { - sbi(UART_PERPH_PORT, UART_PERPH_TX); - } else { - cbi(UART_PERPH_PORT, UART_PERPH_TX); - } - - } - - return 0; - -} diff --git a/sw/ground_segment/modem/Makefile b/sw/ground_segment/modem/Makefile deleted file mode 100644 index 275b1b3050..0000000000 --- a/sw/ground_segment/modem/Makefile +++ /dev/null @@ -1,41 +0,0 @@ -# -# modem $Id$ -# Copyright (C) 2003 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. -# - -ARCH = atmega8 -TARGET = modem_gnd -TARGETDIR = modem_gnd -LOW_FUSE = 3f -HIGH_FUSE = cb -EXT_FUSE= ff -LOCK_FUSE= ff -INCLUDES= -I../../include - -$(TARGET).srcs = \ - main.c \ - uart.c \ - soft_uart.c \ - adc.c \ - -include ../../../conf/Makefile.local -include ../../../conf/Makefile.avr - -clean : avr_clean diff --git a/sw/ground_segment/modem/README b/sw/ground_segment/modem/README deleted file mode 100644 index f7f32367e2..0000000000 --- a/sw/ground_segment/modem/README +++ /dev/null @@ -1,28 +0,0 @@ -# -# $Id$ -# Copyright (C) 2004 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. -# - -This directory contains code for the mega8 MCU in the -ground modem. -The mega8 drives the CMX469 modem. This is necessary because -the crystal in the transmitting CMX469 is 4Mhz instead of -specified 4.032 . -This leads to incompatibility with the laptop baud generator. diff --git a/sw/ground_segment/modem/adc.c b/sw/ground_segment/modem/adc.c deleted file mode 100644 index 0584677469..0000000000 --- a/sw/ground_segment/modem/adc.c +++ /dev/null @@ -1,39 +0,0 @@ - -#include -#include -#include -#include - -#include "avr/std.h" -#include "adc.h" - -#define ANALOG_PORT PORTC -#define ANALOG_PORT_DIR DDRC -#define VALIM 7 - -uint16_t adc_alim; -volatile uint8_t adc_got_val; - -void adc_init( void ) -{ - /* Ensure that our port is for input with no pull-ups */ - ANALOG_PORT &= ~_BV(VALIM); - ANALOG_PORT_DIR &= ~_BV(VALIM); - - /* Select our external voltage ref, which is tied to Vcc and channel VALIM*/ - ADMUX = VALIM; - - /* Turn off the analog comparator */ - sbi( ACSR, ACD ); - - /* turn on the ADC, clock/128, interrupts, free running mode and starts conversion */ - ADCSRA = _BV(ADEN) | _BV(ADPS0) | _BV(ADPS1) | _BV(ADPS2) | _BV(ADIE) | _BV(ADFR) | _BV(ADSC); -} - - -SIGNAL( SIG_ADC ) -{ - /* Store result */ - adc_alim = ADCW; - adc_got_val = TRUE; -} diff --git a/sw/ground_segment/modem/adc.h b/sw/ground_segment/modem/adc.h deleted file mode 100644 index c5e0d77bf4..0000000000 --- a/sw/ground_segment/modem/adc.h +++ /dev/null @@ -1,8 +0,0 @@ -#ifndef ADC_H -#define ADC_H - -void adc_init( void ); -extern uint16_t adc_alim; -extern volatile uint8_t adc_got_val; - -#endif diff --git a/sw/ground_segment/modem/link_tmtc.h b/sw/ground_segment/modem/link_tmtc.h deleted file mode 100644 index e58b75063b..0000000000 --- a/sw/ground_segment/modem/link_tmtc.h +++ /dev/null @@ -1,92 +0,0 @@ -#ifndef LINK_TMTC_H -#define LINK_TMTC_H - -#define STX 0x02 -#define ETX 0x03 - -#define MSG_DATA 0 -#define MSG_ERROR 1 -#define MSG_CD 2 -#define MSG_DEBUG 3 -#define MSG_VALIM 4 - - - -#define LINK_TMTC_SEND_DATA(data, _len) { \ - uint8_t checksum = 0; \ - const uint8_t real_len = 2+_len; \ - uint8_t i; \ - uart_putc(STX); \ - uart_putc(real_len); \ - checksum^=real_len; \ - uart_putc(MSG_DATA); \ - checksum^=MSG_DATA; \ - for (i=0; i<_len; i++) { \ - uart_putc(data[i]); \ - checksum^=data[i]; \ - } \ - uart_putc(checksum); \ - uart_putc(ETX); \ -} - -#define LINK_TMTC_SEND_ERROR(error) { \ - uint8_t checksum = 0; \ - const uint8_t real_len = 2+1; \ - uart_putc(STX); \ - uart_putc(real_len); \ - checksum^=real_len; \ - uart_putc(MSG_ERROR); \ - checksum^=MSG_ERROR; \ - uart_putc(error); \ - checksum^=error; \ - uart_putc(checksum); \ - uart_putc(ETX); \ -} - - -#define LINK_TMTC_SEND_CD(cd) { \ - uint8_t checksum = 0; \ - const uint8_t real_len = 2+1; \ - uart_putc(STX); \ - uart_putc(real_len); \ - checksum^=real_len; \ - uart_putc(MSG_CD); \ - checksum^=MSG_CD; \ - uart_putc(cd); \ - checksum^=cd; \ - uart_putc(checksum); \ - uart_putc(ETX); \ -} - -#define LINK_TMTC_SEND_DEBUG() { \ - uint8_t checksum = 0; \ - const uint8_t real_len = 2+1; \ - uart_putc(STX); \ - uart_putc(real_len); \ - checksum^=real_len; \ - uart_putc(MSG_DEBUG); \ - checksum^=MSG_DEBUG; \ - uart_putc(uart_nb_ovrrun); \ - checksum^=uart_nb_ovrrun; \ - uart_putc(checksum); \ - uart_putc(ETX); \ -} - -#define LINK_TMTC_SEND_VALIM(_valim) { \ - uint8_t checksum = 0; \ - const uint8_t real_len = 2+2; \ - uart_putc(STX); \ - uart_putc(real_len); \ - checksum^=real_len; \ - uart_putc(MSG_VALIM); \ - checksum^=MSG_VALIM; \ - uart_putc(*(uint8_t*)(_valim)); \ - checksum^= *(uint8_t*)(_valim); \ - uart_putc(* ((uint8_t*)(_valim) + 1)); \ - checksum^= *((uint8_t*)(_valim) + 1); \ - uart_putc(checksum); \ - uart_putc(ETX); \ -} - - -#endif diff --git a/sw/ground_segment/modem/main.c b/sw/ground_segment/modem/main.c deleted file mode 100644 index b2367824ad..0000000000 --- a/sw/ground_segment/modem/main.c +++ /dev/null @@ -1,70 +0,0 @@ -#include -#include -#include -#include -#include - - -#include "timer.h" -#include "soft_uart.h" -#include "adc.h" -#include "uart.h" -#include "link_tmtc.h" - -#define FALSE 0 -#define TRUE (!FALSE) - -static uint16_t cputime = 0; // seconds - -#define INPUT_BUF_LEN 10 -static uint8_t input_buf[INPUT_BUF_LEN]; -static uint8_t input_buf_idx = 0; - -static uint16_t saved_valim; - -inline void periodic_task( void ) { // 15 Hz - static uint8_t _1Hz = 0; - _1Hz++; - if (_1Hz>=15) _1Hz=0; - - if (!_1Hz) { - uint8_t cd_status = bit_is_set(SOFT_UART_CD_PIN, SOFT_UART_CD); - cputime++; - LINK_TMTC_SEND_CD(cd_status); - LINK_TMTC_SEND_VALIM(&saved_valim); - LINK_TMTC_SEND_DEBUG(); - } -} - -int main( void ) { - /* init peripherals */ - timer_init(); - uart_init(); - soft_uart_init(); - adc_init(); - sei(); - - /* enter mainloop */ - while( 1 ) { - if(timer_periodic()) - periodic_task(); - if (soft_uart_error) { - LINK_TMTC_SEND_ERROR(soft_uart_error); - soft_uart_error = 0; - } - if (soft_uart_got_byte) { - input_buf[input_buf_idx] = soft_uart_byte; - input_buf_idx++; - if (input_buf_idx >= INPUT_BUF_LEN) { - LINK_TMTC_SEND_DATA(input_buf, input_buf_idx); - input_buf_idx = 0; - } - soft_uart_got_byte = FALSE; - } - if (adc_got_val) { - saved_valim = adc_alim; - adc_got_val = FALSE; - } - } - return 0; -} diff --git a/sw/ground_segment/modem/soft_uart.c b/sw/ground_segment/modem/soft_uart.c deleted file mode 100644 index 9700f16198..0000000000 --- a/sw/ground_segment/modem/soft_uart.c +++ /dev/null @@ -1,80 +0,0 @@ -#include "soft_uart.h" - -#include -#include -#include - -#define FALSE 0 -#define TRUE (!FALSE) - - -volatile uint8_t soft_uart_got_byte = FALSE; -uint8_t soft_uart_byte; -volatile uint8_t soft_uart_error = 0; - -#define RX_CLOCKED_DATA_PORT PORTB -#define RX_CLOCKED_DATA_DDR DDRB -#define RX_CLOCKED_DATA_PIN PINB -#define RX_CLOCKED_DATA 0 - - -void soft_uart_init(void) { - - /* set CD pin as input, no pullup */ - SOFT_UART_CD_DDR &= ~_BV(SOFT_UART_CD); - SOFT_UART_CD_PORT &= ~_BV(SOFT_UART_CD); - - /* set DATA pin as input no pullup*/ - RX_CLOCKED_DATA_DDR &= ~_BV(RX_CLOCKED_DATA); - RX_CLOCKED_DATA_PORT &= ~_BV(RX_CLOCKED_DATA); - - /* setup rx interrupt on failing edge of clock */ - MCUCR = _BV(ISC11); - /* clear interrupt flag */ - sbi(GIFR, INTF1); - /* enable interrupt */ - sbi(GICR, INT1); -} - - -SIGNAL(SIG_INTERRUPT1) { - static uint8_t rx_buf_idx = 0; - static uint8_t rx_buf; - - if (bit_is_clear(SOFT_UART_CD_PIN, SOFT_UART_CD)) { - rx_buf_idx = 0; - } - else { - if (rx_buf_idx==0) { - // start bit - if (bit_is_clear(RX_CLOCKED_DATA_PIN, RX_CLOCKED_DATA)) { - rx_buf = 0; - rx_buf_idx++; - } - } - else if (rx_buf_idx < 9) { - // data bits - rx_buf >>= 1; - if (bit_is_set(RX_CLOCKED_DATA_PIN, RX_CLOCKED_DATA)) - rx_buf |= 0x80; - rx_buf_idx++; - } - else { - // stop bit - if (bit_is_set(RX_CLOCKED_DATA_PIN, RX_CLOCKED_DATA)) { - if (soft_uart_got_byte) { - soft_uart_error = RX_ERROR_OVERRUN; - } - else { - soft_uart_byte = rx_buf; - soft_uart_got_byte = TRUE; - } - } - else { - // framing error - soft_uart_error = RX_ERROR_FRAMING; - } - rx_buf_idx = 0; - } - } -} diff --git a/sw/ground_segment/modem/soft_uart.h b/sw/ground_segment/modem/soft_uart.h deleted file mode 100644 index b1194951a1..0000000000 --- a/sw/ground_segment/modem/soft_uart.h +++ /dev/null @@ -1,21 +0,0 @@ -#ifndef SOFT_UART_H -#define SOFT_UART_H - -#include - -extern volatile uint8_t soft_uart_got_byte; -extern uint8_t soft_uart_byte; - -#define RX_ERROR_FRAMING 1 -#define RX_ERROR_OVERRUN 2 -extern volatile uint8_t soft_uart_error; - -#define SOFT_UART_CD_PORT PORTD -#define SOFT_UART_CD_DDR DDRD -#define SOFT_UART_CD_PIN PIND -#define SOFT_UART_CD 6 - -void soft_uart_init(void); - - -#endif diff --git a/sw/ground_segment/modem/timer.h b/sw/ground_segment/modem/timer.h deleted file mode 100644 index 5a33c3ba6f..0000000000 --- a/sw/ground_segment/modem/timer.h +++ /dev/null @@ -1,91 +0,0 @@ -/* - * Paparazzi mcu0 timer functions - * - * Copied from autopilot (autopilot.sf.net) thanx alot Trammell - * - * Copyright (C) 2002 Trammell Hudson - * Copyright (C) 2003 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. - * - */ - -#ifndef TIMER_H -#define TIMER_H - -#include -#include -#include - - -/* - * Enable Timer1 (16-bit) running at Clk/1 for the global system - * clock. This will be used for computing the servo pulse widths, - * PPM decoding, etc. - * - * Low frequency periodic tasks will be signaled by timer 0 - * running at Clk/1024. For 4 Mhz clock, this will be every - * 65536 microseconds, or 15 Hz. - */ -static inline void timer_init( void ) { - /* Timer0 @ Clk/64: Software UART */ -/* TCCR0 = 0x03; */ - - /* Timer1 @ Clk/1: System clock, ppm and servos */ - // TCCR1A = 0x00; - // TCCR1B = 0x01; - - /* Timer2 @ Clk/1024: Periodic clock*/ - TCCR2 = 0x07; -} - - -/* - * Retrieve the current time from the global clock in Timer1, - * disabling interrupts to avoid stomping on the TEMP register. - * If interrupts are already off, the non_atomic form can be used. - */ -static inline uint16_t -timer_now( void ) -{ - return TCNT1; -} - -static inline uint16_t -timer_now_non_atomic( void ) -{ - return TCNT1L; -} - - -/* - * Periodic tasks occur when Timer2 overflows. Check and unset - * the overflow bit. We cycle through four possible periodic states, - * so each state occurs every 30 Hz. - */ -static inline uint8_t -timer_periodic( void ) -{ - if( !bit_is_set( TIFR, TOV2 ) ) - return 0; - - TIFR = 1 << TOV2; - return 1; -} - -#endif diff --git a/sw/ground_segment/modem/uart.c b/sw/ground_segment/modem/uart.c deleted file mode 100644 index 964a37e8b5..0000000000 --- a/sw/ground_segment/modem/uart.c +++ /dev/null @@ -1,81 +0,0 @@ -#include -#include -#include -#include "uart.h" - - -uint8_t uart_nb_ovrrun = 0; - -#define TX_BUF_SIZE 100 - -static volatile uint8_t tx_head = TX_BUF_SIZE - 1; -static volatile uint8_t tx_tail = TX_BUF_SIZE - 1; -static uint8_t tx_buf[ TX_BUF_SIZE ]; - - -/* - * UART Baud rate generation settings: - * - * With 16.0 MHz clock,UBRR=25 => 38400 baud - * With 8.0 Mhz clock, UBRR=12 => 38400 baud - * - * With 4.0 MHz UBRR=12 + ub2X=1 -> 38400 baud - */ - -void uart_init( void ) { - /* Baudrate is 38.4k */ - UBRRH = 0; - UBRRL = 12; - /* double speed */ - UCSRA = _BV(U2X); - /* Enable transmitter */ - UCSRB = _BV(TXEN); - /* Set frame format: 8data, 1stop bit */ - UCSRC = _BV(URSEL) | _BV(UCSZ1) | _BV(UCSZ0); -} - - -static inline void load_next_byte( void ) { - uint8_t tmp_tail; - /* load a new byte */ - tmp_tail = tx_tail + 1; - if( tmp_tail >= TX_BUF_SIZE ) - tmp_tail = 0; - tx_tail = tmp_tail; - UDR = tx_buf[tx_tail]; -} - -void uart_putc( unsigned char c ) { - uint8_t tmp_head; - - tmp_head = tx_head + 1; - if( tmp_head >= TX_BUF_SIZE ) - tmp_head = 0; - /* if buffer is full do nothing */ - if( tmp_head == tx_tail ) { - uart_nb_ovrrun++; - return; - } - - /* copy data to buffer */ - tx_buf[ tmp_head ] = c; - /* update head */ - tx_head = tmp_head; - - /* if we were not allready transmitting */ - if (bit_is_clear(UCSRB, TXCIE)) { - /* load a byte */ - load_next_byte(); - /* enable interrupt */ - sbi(UCSRB, TXCIE); - } -} - -SIGNAL( SIG_UART_TRANS ) { - /* if we have nothing left to transmit */ - if( tx_head == tx_tail ) - /* disable data register empty interrupt */ - cbi(UCSRB, TXCIE); - else - load_next_byte(); -} diff --git a/sw/ground_segment/modem/uart.h b/sw/ground_segment/modem/uart.h deleted file mode 100644 index be7f03d11b..0000000000 --- a/sw/ground_segment/modem/uart.h +++ /dev/null @@ -1,19 +0,0 @@ -#ifndef _UART_H_ -#define _UART_H_ - -#include -#include -#include -#include - - - -/************************************************************************* - * - * UART code. - */ - -void uart_init( void ); -void uart_putc( unsigned char c ); -extern uint8_t uart_nb_ovrrun; -#endif From 90a76e819587bf80261cb5a4e9e2da8e9c70a89f Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 23:26:24 +0100 Subject: [PATCH 098/109] remove unmaintained debian and install files/rules --- .gitignore | 16 ---- Makefile | 11 +-- Makefile.install | 159 ---------------------------------- debian/changelog.etch | 42 --------- debian/changelog.hardy | 17 ---- debian/changelog.lenny | 72 --------------- debian/changelog.sarge | 20 ----- debian/changelog.sid | 41 --------- debian/changelog.squeeze | 41 --------- debian/compat | 1 - debian/control.etch | 33 ------- debian/control.hardy | 31 ------- debian/control.lenny | 32 ------- debian/control.sarge | 33 ------- debian/control.sid | 31 ------- debian/control.squeeze | 32 ------- debian/paparazzi-bin.postinst | 34 -------- debian/paparazzi-bin.prerm | 23 ----- debian/paparazzi.desktop | 10 --- debian/rules | 98 --------------------- debian/shlibs.local | 1 - 21 files changed, 2 insertions(+), 776 deletions(-) delete mode 100644 Makefile.install delete mode 100644 debian/changelog.etch delete mode 100644 debian/changelog.hardy delete mode 100644 debian/changelog.lenny delete mode 100644 debian/changelog.sarge delete mode 100644 debian/changelog.sid delete mode 100644 debian/changelog.squeeze delete mode 100644 debian/compat delete mode 100644 debian/control.etch delete mode 100644 debian/control.hardy delete mode 100644 debian/control.lenny delete mode 100644 debian/control.sarge delete mode 100644 debian/control.sid delete mode 100644 debian/control.squeeze delete mode 100755 debian/paparazzi-bin.postinst delete mode 100755 debian/paparazzi-bin.prerm delete mode 100644 debian/paparazzi.desktop delete mode 100755 debian/rules delete mode 100644 debian/shlibs.local diff --git a/.gitignore b/.gitignore index e33256718f..d5bba5a95a 100644 --- a/.gitignore +++ b/.gitignore @@ -31,22 +31,6 @@ /build.properties /META-INF -# Debian related files -*.deb -*.dsc -*.changes -*.substvars -*.debhelper.log -*-stamp -/debian/control -/debian/changelog -/debian/files -/debian/paparazzi-arm7 -/debian/paparazzi-dev -/debian/paparazzi-bin -/sw/lib/ocaml/ivy/debian/changelog -/sw/lib/ocaml/ivy/debian/files -/sw/lib/ocaml/ivy/debian/ivy-ocaml /var /dox diff --git a/Makefile b/Makefile index b59009f452..398ae45943 100644 --- a/Makefile +++ b/Makefile @@ -241,19 +241,12 @@ paparazzi: chmod a+x $@ -install: all - $(MAKE) -f Makefile.install PREFIX=$(PREFIX) - -uninstall: - $(MAKE) -f Makefile.install PREFIX=$(PREFIX) uninstall - - # # Cleaning # clean: - $(Q)rm -fr dox build-stamp configure-stamp conf/%gconf.xml debian/files debian/paparazzi-base debian/paparazzi-bin paparazzi + $(Q)rm -fr dox build-stamp configure-stamp conf/%gconf.xml $(Q)rm -f $(GEN_HEADERS) $(Q)find . -mindepth 2 -name Makefile -a ! -path "./sw/ext/*" -exec sh -c 'echo "Cleaning {}"; $(MAKE) -C `dirname {}` $@' \; $(Q)$(MAKE) -C $(EXT) clean @@ -298,6 +291,6 @@ test: all replace_current_conf_xml run_tests restore_conf_xml .PHONY: all print_build_version update_google_version ground_segment \ subdirs $(SUBDIRS) conf ext libpprz multimon cockpit tmtc tools\ -static sim_static lpctools commands install uninstall \ +static sim_static lpctools commands \ clean cleanspaces ab_clean dist_clean distclean dist_clean_irreversible \ test replace_current_conf_xml run_tests restore_conf_xml diff --git a/Makefile.install b/Makefile.install deleted file mode 100644 index 9cea7867ac..0000000000 --- a/Makefile.install +++ /dev/null @@ -1,159 +0,0 @@ -# Hey Emacs, this is a -*- makefile -*- - -# Installation of the files in the system tree - -PREFIX=/ -DESTDIR=$(PREFIX)/usr/share/paparazzi -INSTALL=install -o root -INSTALLDATA=install -o root -m 644 - -install : install_files -# post_install - -install_files: install_data install_conf install_bin install_libs install_tools install_airborne_sources - -post_install : - debian/paparazzi-bin.postinst - -install_data: - $(INSTALL) -d $(DESTDIR)/data/maps - $(INSTALLDATA) data/maps/muret_UTM.xml data/maps/muret_UTM.gif $(DESTDIR)/data/maps - $(INSTALL) -d $(DESTDIR)/data/pictures/gcs_icons - $(INSTALLDATA) data/pictures/*.gif data/pictures/*.svg data/pictures/*.jpg data/pictures/*.png $(DESTDIR)/data/pictures - $(INSTALLDATA) data/pictures/gcs_icons/*.png $(DESTDIR)/data/pictures/gcs_icons - $(INSTALL) -d $(PREFIX)/usr/share/pixmaps - $(INSTALLDATA) data/pictures/penguin_icon.png $(PREFIX)/usr/share/pixmaps/paparazzi.png - $(INSTALL) -d $(DESTDIR)/data/srtm - - -install_conf: - $(INSTALL) -d $(DESTDIR)/conf - $(INSTALLDATA) conf/conf.xml.example $(DESTDIR)/conf/conf.xml - $(INSTALLDATA) conf/control_panel.xml.example $(DESTDIR)/conf/control_panel.xml - $(INSTALLDATA) conf/messages.xml $(DESTDIR)/conf/ - $(INSTALLDATA) conf/messages.dtd $(DESTDIR)/conf/ - $(INSTALLDATA) conf/gui.xml $(DESTDIR)/conf/ - $(INSTALL) -d $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/airframe.dtd $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/microjet_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/twinstar_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/twinjet_example.xml $(DESTDIR)/conf/airframes - $(INSTALLDATA) conf/airframes/example_twog_analogimu.xml $(DESTDIR)/conf/airframes - $(INSTALL) -d $(DESTDIR)/conf/autopilot - $(INSTALLDATA) conf/autopilot/*.makefile $(DESTDIR)/conf/autopilot - $(INSTALLDATA) conf/autopilot/*.h $(DESTDIR)/conf/autopilot - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems - $(INSTALLDATA) conf/autopilot/subsystems/*.makefile $(DESTDIR)/conf/autopilot/subsystems - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/fixedwing - $(INSTALLDATA) conf/autopilot/subsystems/fixedwing/*.makefile $(DESTDIR)/conf/autopilot/subsystems/fixedwing - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/rotorcraft - $(INSTALLDATA) conf/autopilot/subsystems/rotorcraft/*.makefile $(DESTDIR)/conf/autopilot/subsystems/rotorcraft - $(INSTALL) -d $(DESTDIR)/conf/autopilot/subsystems/shared - $(INSTALLDATA) conf/autopilot/subsystems/shared/*.makefile $(DESTDIR)/conf/autopilot/subsystems/shared - $(INSTALL) -d $(DESTDIR)/conf/flight_plans - $(INSTALLDATA) conf/flight_plans/*.dtd $(DESTDIR)/conf/flight_plans - $(INSTALLDATA) conf/flight_plans/*.xml $(DESTDIR)/conf/flight_plans - $(INSTALL) -d $(DESTDIR)/conf/modules - $(INSTALLDATA) conf/modules/*.dtd $(DESTDIR)/conf/modules - $(INSTALLDATA) conf/modules/*.xml $(DESTDIR)/conf/modules - $(INSTALL) -d $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/Makefile $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/ublox_conf.c $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/README $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/*.inf $(DESTDIR)/conf/gps - $(INSTALLDATA) conf/gps/*.txt $(DESTDIR)/conf/gps - $(INSTALL) -d $(DESTDIR)/conf/radios - $(INSTALLDATA) conf/radios/radio.dtd $(DESTDIR)/conf/radios - $(INSTALLDATA) conf/radios/*.xml $(DESTDIR)/conf/radios - $(INSTALL) -d $(DESTDIR)/conf/telemetry - $(INSTALLDATA) conf/telemetry/telemetry.dtd $(DESTDIR)/conf/telemetry - $(INSTALLDATA) conf/telemetry/*.xml $(DESTDIR)/conf/telemetry - $(INSTALL) -d $(DESTDIR)/conf/settings - $(INSTALLDATA) conf/settings/settings.dtd $(DESTDIR)/conf/settings - $(INSTALLDATA) conf/settings/*.xml $(DESTDIR)/conf/settings - $(INSTALL) -d $(DESTDIR)/conf/gcs - $(INSTALLDATA) conf/gcs/layout.dtd $(DESTDIR)/conf/gcs - $(INSTALLDATA) conf/gcs/*.xml $(DESTDIR)/conf/gcs - $(INSTALL) -d $(PREFIX)/etc/udev/rules.d - $(INSTALLDATA) conf/system/udev/rules/*.rules $(PREFIX)/etc/udev/rules.d - $(INSTALL) -d $(PREFIX)/etc/modprobe.d - $(INSTALLDATA) conf/system/modprobe.d/paparazzi $(PREFIX)/etc/modprobe.d - $(INSTALL) -d $(PREFIX)/usr/share/applications - $(INSTALLDATA) debian/paparazzi.desktop $(PREFIX)/usr/share/applications - - -install_bin: - $(INSTALL) -d $(PREFIX)/usr/bin/ - $(INSTALL) -d $(DESTDIR)/sw/supervision - $(INSTALL) sw/supervision/paparazzicenter.glade $(DESTDIR)/sw/supervision - $(INSTALL) sw/supervision/*.cmo $(DESTDIR)/sw/supervision - $(INSTALL) paparazzi-make $(PREFIX)/usr/bin/ - $(INSTALLDATA) -d $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/*.cmo $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/pprzsim-launch $(DESTDIR)/sw/simulator - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/cockpit/*.cmo $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALLDATA) sw/ground_segment/cockpit/gcs.glade $(DESTDIR)/sw/ground_segment/cockpit - $(INSTALLDATA) sw/ground_segment/tmtc/*.cmo $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALL) sw/ground_segment/tmtc/boa $(DESTDIR)/sw/ground_segment/tmtc - $(INSTALLDATA) sw/ground_segment/multimon/multimon.cma $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/multimon/libmultimon.a $(DESTDIR)/sw/ground_segment/multimon - $(INSTALLDATA) sw/ground_segment/multimon/dllmultimon.so $(DESTDIR)/sw/ground_segment/multimon - $(INSTALL) -d $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/*.cm[ox] $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/*.o $(DESTDIR)/sw/logalizer - $(INSTALLDATA) sw/logalizer/export.glade $(DESTDIR)/sw/logalizer - ln -sf ../share/paparazzi/sw/supervision/paparazzicenter $(PREFIX)/usr/bin/paparazzi - -install_libs: - $(INSTALL) -d $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cma $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cmxa $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.so $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.a $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/*.cmi $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/myGtkInit.cmo $(DESTDIR)/sw/lib/ocaml - $(INSTALLDATA) sw/lib/ocaml/widgets.glade $(DESTDIR)/sw/lib/ocaml - -install_tools: - $(INSTALLDATA) Makefile.ac $(DESTDIR) - $(INSTALLDATA) conf/Makefile* $(DESTDIR)/conf - $(INSTALL) -d $(DESTDIR)/sw/tools/ - $(INSTALL) sw/tools/*.out $(DESTDIR)/sw/tools/ - rm -f $(DESTDIR)/sw/tools/gen_flight_plan.out - $(INSTALLDATA) sw/tools/fp_proc.cmo $(DESTDIR)/sw/tools - $(INSTALLDATA) sw/tools/gen_flight_plan.cmo $(DESTDIR)/sw/tools - $(INSTALLDATA) sw/tools/gen_aircraft.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_airframe.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_messages.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_periodic.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_radio.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_settings.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_ubx.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_mtk.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_xsens.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_modules.ml $(DESTDIR)/sw/tools/ - $(INSTALLDATA) sw/tools/gen_common.cmo $(DESTDIR)/sw/tools/ - $(INSTALL) -d $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibrate.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibrate_gyro.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/calibration_utils.py $(DESTDIR)/sw/tools/calibration - $(INSTALLDATA) sw/tools/calibration/README $(DESTDIR)/sw/tools/calibration - $(INSTALL) -d $(DESTDIR)/sw/ground_segment/lpc21iap - $(INSTALL) sw/ground_segment/lpc21iap/lpc21iap $(DESTDIR)/sw/ground_segment/lpc21iap/ - $(INSTALL) -d $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sitl.cma $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/simsitl.ml $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sim.cmi $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/sitl.cmi $(DESTDIR)/sw/simulator - $(INSTALLDATA) sw/simulator/libsitl.a $(DESTDIR)/sw/simulator - $(INSTALL) sw/simulator/simhitl $(DESTDIR)/sw/simulator - -install_airborne_sources: - $(INSTALL) -d $(DESTDIR)/sw/ - tar -cf - sw/airborne/ | tar -C $(DESTDIR) -xf - - $(INSTALL) -d $(DESTDIR)/sw/include - $(INSTALLDATA) sw/include/std.h $(DESTDIR)/sw/include - $(INSTALLDATA) var/include/*.h $(DESTDIR)/sw/include diff --git a/debian/changelog.etch b/debian/changelog.etch deleted file mode 100644 index 223f6db07d..0000000000 --- a/debian/changelog.etch +++ /dev/null @@ -1,42 +0,0 @@ -paparazzi (3.2-5) unstable; urgency=low - - * Dependency over meschach-dev OR libmeschach-dev (for Gutsy). Boa moved from - Depends to Suggests - - -- Pascal Brisset Tue, 21 Oct 2008 14:20:57 +0200 - -paparazzi (3.2-4) unstable; urgency=low - - * New dependency over meschach-dev - - -- Pascal Brisset Wed, 17 Sep 2008 19:49:08 +0200 - -paparazzi (3.2-3) unstable; urgency=low - - * New dependency over ocamlnet - - -- Pascal Brisset Thu, 28 Aug 2008 16:04:13 +0200 - -paparazzi (3.2-2) unstable; urgency=low - - * New strip and other details. - - -- Pascal Brisset Thu, 03 Jan 2008 15:18:48 +0100 - -paparazzi (3.2-1) unstable; urgency=low - - * Dependencies over Perl libraries removed. - - -- Pascal Brisset Sat, 08 Sep 2007 22:28:35 +0200 - -paparazzi (3.1-2) unstable; urgency=low - - * Introduction of binary package. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 - -paparazzi (2.99-1) unstable; urgency=low - - * Initial Release. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 diff --git a/debian/changelog.hardy b/debian/changelog.hardy deleted file mode 100644 index 6e0f6d8eaf..0000000000 --- a/debian/changelog.hardy +++ /dev/null @@ -1,17 +0,0 @@ -paparazzi (3.10.0-3) unstable; urgency=low - - * Dependency over subversion added - - -- Pascal Brisset Sat, 18 Apr 2009 12:35:47 +0200 - -paparazzi (3.10.0-2) unstable; urgency=low - - * Recommends -> Suggests dependencies - - -- Pascal Brisset Sun, 08 Jun 2008 23:33:40 +0200 - -paparazzi (3.10.0-1) unstable; urgency=low - - * First Release for Ubuntu Hardy - - -- Pascal Brisset Sat, 05 Apr 2008 23:13:30 +0200 diff --git a/debian/changelog.lenny b/debian/changelog.lenny deleted file mode 100644 index 55d3e0cb12..0000000000 --- a/debian/changelog.lenny +++ /dev/null @@ -1,72 +0,0 @@ -paparazzi (3.3-1) unstable; urgency=low - - * New build system with modules and subsystems - * Change dependency from subversion to git - - -- Gautier Hattenberger Wed, 29 Dec 2010 12:49:00 +0100 - -paparazzi (3.2-10) unstable; urgency=low - - * Dependencie over gpsd, libgps-dev, python-lxml, python-wxgtk2.8 added - - -- Pascal Brisset Fri, 24 Jul 2009 18:22:12 +0200 - -paparazzi (3.2-9) unstable; urgency=low - - * Dependency over ivy-python added - - -- Pascal Brisset Fri, 24 Jul 2009 18:22:12 +0200 - -paparazzi (3.2-8) unstable; urgency=low - - * Dependency over libcamlimages-ocaml-dev removed - - -- Pascal Brisset Thu, 02 Jul 2009 23:47:08 +0200 - -paparazzi (3.2-7) unstable; urgency=low - - * Dependency over subversion added - - -- Pascal Brisset Sat, 18 Apr 2009 12:32:38 +0200 - -paparazzi (3.2-6) unstable; urgency=low - - * Papgets, CSV export, ..., Xmas 2008 - - -- Pascal Brisset Mon, 15 Dec 2008 06:20:07 +0100 - -paparazzi (3.2-5) unstable; urgency=low - - * New dependency over meschach-dev - - -- Pascal Brisset Wed, 17 Sep 2008 19:49:08 +0200 - -paparazzi (3.2-4) unstable; urgency=low - - * New dependency over ocamlnet - - -- Pascal Brisset Thu, 28 Aug 2008 16:04:13 +0200 - -paparazzi (3.2-3) unstable; urgency=low - - * Recommends -> Suggests dependencies - - -- Pascal Brisset Sun, 08 Jun 2008 23:33:40 +0200 - -paparazzi (3.2-2) unstable; urgency=low - - * New strip and other details. - - -- Pascal Brisset Thu, 03 Jan 2008 15:18:48 +0100 - -paparazzi (3.1-3) unstable; urgency=low - - * Introduction of binary package. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 - -paparazzi (2.99-1) unstable; urgency=low - - * Initial Release. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 diff --git a/debian/changelog.sarge b/debian/changelog.sarge deleted file mode 100644 index 713778a4dd..0000000000 --- a/debian/changelog.sarge +++ /dev/null @@ -1,20 +0,0 @@ -paparazzi (3.1-1) unstable; urgency=low - - * Initial Release. - - -- Pascal Brisset Sat, 26 Aug 2006 22:28:35 +0200 - - -paparazzi (1.0-3) unstable; urgency=low - - * Initial Release. - - -- Pascal Brisset Fri, 19 Feb 2005 12:21:28 +0100 - - - -paparazzi (1.0-1) unstable; urgency=low - - * Initial Release. - - -- Pascal Brisset Fri, 19 Feb 2005 12:21:28 +0100 diff --git a/debian/changelog.sid b/debian/changelog.sid deleted file mode 100644 index 7ba9332419..0000000000 --- a/debian/changelog.sid +++ /dev/null @@ -1,41 +0,0 @@ -paparazzi (3.2-6) unstable; urgency=low - - * New dependency over subversion - - -- Pascal Brisset Sat, 18 Apr 2009 15:01:21 +0200 - -paparazzi (3.2-5) unstable; urgency=low - - * New dependency over meschach-dev - - -- Pascal Brisset Wed, 17 Sep 2008 19:49:08 +0200 - -paparazzi (3.2-4) unstable; urgency=low - - * New dependency over ocamlnet - - -- Pascal Brisset Thu, 28 Aug 2008 16:04:13 +0200 - -paparazzi (3.2-3) unstable; urgency=low - - * Recommends -> Suggests dependencies - - -- Pascal Brisset Sun, 08 Jun 2008 23:33:40 +0200 - -paparazzi (3.2-2) unstable; urgency=low - - * New strip and other details. - - -- Pascal Brisset Thu, 03 Jan 2008 15:18:48 +0100 - -paparazzi (3.1-3) unstable; urgency=low - - * Introduction of binary package. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 - -paparazzi (2.99-1) unstable; urgency=low - - * Initial Release. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 diff --git a/debian/changelog.squeeze b/debian/changelog.squeeze deleted file mode 100644 index 7ba9332419..0000000000 --- a/debian/changelog.squeeze +++ /dev/null @@ -1,41 +0,0 @@ -paparazzi (3.2-6) unstable; urgency=low - - * New dependency over subversion - - -- Pascal Brisset Sat, 18 Apr 2009 15:01:21 +0200 - -paparazzi (3.2-5) unstable; urgency=low - - * New dependency over meschach-dev - - -- Pascal Brisset Wed, 17 Sep 2008 19:49:08 +0200 - -paparazzi (3.2-4) unstable; urgency=low - - * New dependency over ocamlnet - - -- Pascal Brisset Thu, 28 Aug 2008 16:04:13 +0200 - -paparazzi (3.2-3) unstable; urgency=low - - * Recommends -> Suggests dependencies - - -- Pascal Brisset Sun, 08 Jun 2008 23:33:40 +0200 - -paparazzi (3.2-2) unstable; urgency=low - - * New strip and other details. - - -- Pascal Brisset Thu, 03 Jan 2008 15:18:48 +0100 - -paparazzi (3.1-3) unstable; urgency=low - - * Introduction of binary package. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 - -paparazzi (2.99-1) unstable; urgency=low - - * Initial Release. - - -- Antoine Drouin Fri, 04 Aug 2006 12:21:28 +0100 diff --git a/debian/compat b/debian/compat deleted file mode 100644 index b8626c4cff..0000000000 --- a/debian/compat +++ /dev/null @@ -1 +0,0 @@ -4 diff --git a/debian/control.etch b/debian/control.etch deleted file mode 100644 index 1435c596bf..0000000000 --- a/debian/control.etch +++ /dev/null @@ -1,33 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Pascal Brisset -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: paparazzi-avr, paparazzi-arm7, eagle, gs-common, tetex-extra, dia-gnome, boa -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, gnuplot, libgnomecanvas2-dev, bzip2, cvs, liblablgtk2-gnome-ocaml-dev, libcamlimages-ocaml-dev, libusb-dev, speech-dispatcher, glade, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev, meschach-dev | libmeschach-dev -Conflicts: xml-light-ocaml -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, libusb-dev, newlib-arm -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, bzip2, liblablgtk2-gnome-ocaml-dev, speech-dispatcher, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Conflicts: xml-light-ocaml -Description: Paparazzi main package diff --git a/debian/control.hardy b/debian/control.hardy deleted file mode 100644 index 5682918733..0000000000 --- a/debian/control.hardy +++ /dev/null @@ -1,31 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Pascal Brisset -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: eagle, paparazzi-avr, paparazzi-arm7, gs-common, dia-gnome -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, libgnomecanvas2-dev, bzip2, cvs, subversion, liblablgtk2-gnome-ocaml-dev, libcamlimages-ocaml-dev, libusb-dev, speech-dispatcher, glade, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr, -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, libusb-dev, newlib-arm -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, bzip2, liblablgtk2-gnome-ocaml-dev, speech-dispatcher, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Description: Paparazzi main package diff --git a/debian/control.lenny b/debian/control.lenny deleted file mode 100644 index 6587b5a8e3..0000000000 --- a/debian/control.lenny +++ /dev/null @@ -1,32 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Gautier Hattenberger -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: paparazzi-avr, paparazzi-arm7, eagle, gs-common, tetex-extra, dia-gnome, boa, gitk -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, gnuplot, libgnomecanvas2-dev, bzip2, git-core, liblablgtk2-gnome-ocaml-dev, libusb-dev, speech-dispatcher, glade, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev, meschach-dev | libmeschach-dev, ivy-python, gpsd, libgps-dev, python-lxml, python-wxgtk2.8 -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr, -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, libusb-dev, newlib-arm -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Suggests: boa -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, gnuplot, bzip2, liblablgtk2-gnome-ocaml-dev, speech-dispatcher, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Description: Paparazzi main package diff --git a/debian/control.sarge b/debian/control.sarge deleted file mode 100644 index 1ce9bfda35..0000000000 --- a/debian/control.sarge +++ /dev/null @@ -1,33 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Pascal Brisset -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: paparazzi-arm7, paparazzi-avr -Recommends: eagle, gs-common, tetex-extra, dia-gnome -Depends: ivy-c-dev, ivy-c, ivy-perl, ivy-ocaml, xml-light-ocaml, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, libgnomecanvas2-dev, libxml-dom-perl, libsubject-perl, libfile-ncopy-perl, libpcre3-dev, bzip2, libexpect-perl, cvs, libcamlimages-ocaml-dev, libusb-dev -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr, -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, newlib-arm, libusb-dev -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Depends: ivy-c-dev, ivy-c, ivy-perl, ivy-ocaml, xml-light-ocaml, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, libxml-dom-perl, libsubject-perl, libfile-ncopy-perl, libpcre3-dev, bzip2, libexpect-perl -Description: Paparazzi main package - diff --git a/debian/control.sid b/debian/control.sid deleted file mode 100644 index 4f89d0a916..0000000000 --- a/debian/control.sid +++ /dev/null @@ -1,31 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Pascal Brisset -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: paparazzi-avr, paparazzi-arm7, eagle, gs-common, tetex-extra, dia-gnome -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, libgnomecanvas2-dev, bzip2, cvs, liblablgtk2-gnome-ocaml-dev, libcamlimages-ocaml-dev, libusb-dev, speech-dispatcher, glade, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev, meschach-dev, subversion -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr, -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, libusb-dev, newlib-arm -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, boa, gnuplot, bzip2, liblablgtk2-gnome-ocaml-dev, speech-dispatcher, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Description: Paparazzi main package diff --git a/debian/control.squeeze b/debian/control.squeeze deleted file mode 100644 index 262015de79..0000000000 --- a/debian/control.squeeze +++ /dev/null @@ -1,32 +0,0 @@ -Source: paparazzi -Section: extra -Priority: optional -Maintainer: Pascal Brisset -Build-Depends: debhelper (>= 4.0.0) -Standards-Version: 3.6.1 - - -Package: paparazzi-dev -Architecture: any -Suggests: paparazzi-avr, paparazzi-arm7, eagle, gs-common, tetex-extra, boa, dia-gnome -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, gnuplot, libgnomecanvas2-dev, bzip2, cvs, liblablgtk2-gnome-ocaml-dev, libcamlimages-ocaml-dev, libusb-dev, speech-dispatcher, glade, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev, meschach-dev, subversion -Description: Paparazzi Meta Package : common support - - -Package: paparazzi-avr -Architecture: any -Depends: uisp, gcc-avr, avr-libc, binutils-avr, -Description: Paparazzi Meta Package. Atmel AVR support - - -Package: paparazzi-arm7 -Architecture: any -Depends: lpc21isp, gcc-arm, binutils-arm, libusb-dev, newlib-arm -Description: Paparazzi Meta Package. Philips ARM7 support - - -Package: paparazzi-bin -Architecture: i386 -Suggests: boa -Depends: ivy-c-dev, ivy-c, ivy-ocaml, libxml-light-ocaml-dev, liblablgtk2-ocaml-dev, make, gcc, gnuplot, bzip2, liblablgtk2-gnome-ocaml-dev, speech-dispatcher, gedit, imagemagick, libpcre3-dev, libocamlnet-ocaml-dev -Description: Paparazzi main package diff --git a/debian/paparazzi-bin.postinst b/debian/paparazzi-bin.postinst deleted file mode 100755 index 83cbee528d..0000000000 --- a/debian/paparazzi-bin.postinst +++ /dev/null @@ -1,34 +0,0 @@ -#!/bin/sh - -# Link of the Ocaml applications - -set -e - -OCAMLC=ocamlc -OCAMLOPT=ocamlopt -DESTDIR=/usr/share/paparazzi -OCAMLNETINCLUDES=`ocamlfind query -r -i-format netstring` -OCAMLNETCMA=`ocamlfind query -r -a-format -predicates byte netstring` - -cd ${DESTDIR}/sw/ground_segment/tmtc -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma aircraft.cmo wind.cmo airprox.cmo aircraft.cmo wind.cmo airprox.cmo kml.cmo server.cmo -o server -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml -I ../multimon unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma multimon.cma link.cmo -o link -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma gtkInit.cmo messages.cmo -o messages -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml -I ../cockpit ${OCAMLNETINCLUDES} unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma ${OCAMLNETCMA} glibivy-ocaml.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma gtkInit.cmo gtk_save_settings.cmo saveSettings.cmo pages.cmo settings.cmo -o settings - -cd ${DESTDIR}/sw/ground_segment/cockpit -${OCAMLC} -thread -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml ${OCAMLNETINCLUDES} unix.cma str.cma xml-light.cma lablgtk.cma lablglade.cma ${OCAMLNETCMA} glibivy-ocaml.cma lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma threads.cma gtkThread.cmo gtkInit.cmo gtk_setting_time.cmo gtk_strip.cmo horizon.cmo strip.cmo gtk_save_settings.cmo saveSettings.cmo pages.cmo speech.cmo plugin.cmo sectors.cmo map2d.cmo editFP.cmo live.cmo particules.cmo papgets.cmo gcs.cmo -o gcs - -cd ${DESTDIR}/sw/logalizer -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma gtkInit.cmo log_file.cmo play.cmo -o play -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml -o plotter unix.cma str.cma xml-light.cma glibivy-ocaml.cma -I +lablgtk2 -I ../lib/ocaml lablgtk.cma lib-pprz.cma gtkInit.cmo plotter.cmo -${OCAMLOPT} -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml -o plot unix.cmxa str.cmxa xml-light.cmxa glibivy-ocaml.cmxa -I +lablgtk2 -I ../lib/ocaml lablgtk.cmxa lib-pprz.cmxa lablglade.cmxa gtkInit.cmx log_file.cmx gtk_export.cmx export.cmx plot.cmx - -cd ${DESTDIR}/sw/simulator -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma gtkInit.cmo gaia.cmo -o gaia - -cd ${DESTDIR}/sw/supervision -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma lablgtk.cma glibivy-ocaml.cma lib-pprz.cma lablglade.cma lablgnomeui.cma gtkInit.cmo gtk_pc.cmo gtk_process.cmo pc_common.cmo pc_aircraft.cmo pc_control_panel.cmo paparazzicenter.cmo -o paparazzicenter - -cd ${DESTDIR}/sw/tools -${OCAMLC} -custom -I +xml-light -I +lablgtk2 -I ${DESTDIR}/sw/lib/ocaml unix.cma str.cma xml-light.cma ivy-ocaml.cma lib-pprz.cma fp_proc.cmo gen_flight_plan.cmo -o gen_flight_plan.out diff --git a/debian/paparazzi-bin.prerm b/debian/paparazzi-bin.prerm deleted file mode 100755 index ff63a591b7..0000000000 --- a/debian/paparazzi-bin.prerm +++ /dev/null @@ -1,23 +0,0 @@ -#!/bin/sh - -set -e - -OCAMLC=ocamlc -DESTDIR=/usr/share/paparazzi - -rm -f ${DESTDIR}/sw/ground_segment/tmtc/server -rm -f ${DESTDIR}/sw/ground_segment/tmtc/messages -rm -f ${DESTDIR}/sw/ground_segment/tmtc/link -rm -f ${DESTDIR}/sw/ground_segment/tmtc/settings - -rm -f ${DESTDIR}/sw/ground_segment/cockpit/gcs - -rm -f ${DESTDIR}/sw/logalizer/play -rm -f ${DESTDIR}/sw/logalizer/plot -rm -f ${DESTDIR}/sw/logalizer/plotter - -rm -f ${DESTDIR}/sw/simulator/gaia - -rm -f ${DESTDIR}/sw/tools/gen_flight_plan.out - -rm -f ${DESTDIR}/sw/supervision/paparazzicenter diff --git a/debian/paparazzi.desktop b/debian/paparazzi.desktop deleted file mode 100644 index 65efbdeec3..0000000000 --- a/debian/paparazzi.desktop +++ /dev/null @@ -1,10 +0,0 @@ -[Desktop Entry] -Encoding=UTF-8 -Name=Paparazzi -GenericName=Paparazzi Center -Comment=Configure and run the Paparazzi system -Exec=paparazzi -Icon=paparazzi.png -Terminal=false -Type=Application -Categories=Application diff --git a/debian/rules b/debian/rules deleted file mode 100755 index 22a1818397..0000000000 --- a/debian/rules +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/make -f -# -*- makefile -*- -# Sample debian/rules that uses debhelper. -# This file was originally written by Joey Hess and Craig Small. -# As a special exception, when this file is copied by dh-make into a -# dh-make output file, you may use that output file without restriction. -# This special exception was added by Craig Small in version 0.37 of dh-make. - -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 - - - - -CFLAGS = -Wall -g - -ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) - CFLAGS += -O0 -else - CFLAGS += -O2 -endif - -configure: configure-stamp -configure-stamp: - dh_testdir - # Add here commands to configure the package. - - touch configure-stamp - - -build: build-stamp - -build-stamp: configure-stamp - dh_testdir - - # Add here commands to compile the package. - $(MAKE) - $(MAKE) bl - #docbook-to-man debian/ivy-ocaml.sgml > ivy-ocaml.1 - - touch build-stamp - -clean: - dh_testdir - dh_testroot - rm -f build-stamp configure-stamp - - # Add here commands to clean up after the build process. - -$(MAKE) clean - - dh_clean - -install: build - dh_testdir - dh_testroot - dh_clean -k - dh_installdirs - $(MAKE) install PREFIX=$(CURDIR)/debian/paparazzi-bin - - -# Build architecture-independent files here. -binary-indep: build install -# We have nothing to do by default. - -# Build architecture-dependent files here. -binary-arch: build install - dh_testdir - dh_testroot - dh_installchangelogs - dh_installdocs - dh_installexamples -# dh_install - dh_installmenu - dh_desktop -# dh_installdebconf -# dh_installlogrotate -# dh_installemacsen -# dh_installpam -# dh_installmime -# dh_installinit -# dh_installcron -# dh_installinfo - dh_installman - dh_link -# dh_strip - dh_compress - dh_fixperms -# dh_perl -# dh_python -# dh_makeshlibs - dh_installdeb - dh_shlibdeps - dh_gencontrol - dh_md5sums - dh_builddeb - -binary: binary-indep binary-arch -.PHONY: build clean binary-indep binary-arch binary install configure diff --git a/debian/shlibs.local b/debian/shlibs.local deleted file mode 100644 index 85b0b9942a..0000000000 --- a/debian/shlibs.local +++ /dev/null @@ -1 +0,0 @@ -libivy 3 ivy-c From e38464f902e8537003145029a0614d1d1b1ea698 Mon Sep 17 00:00:00 2001 From: Felix Ruess Date: Fri, 29 Mar 2013 23:35:10 +0100 Subject: [PATCH 099/109] clean trailing whitespaces --- .../esden/gain_scheduling_example.xml | 24 +++++++++---------- conf/airframes/esden/lisa2_hex.xml | 4 ++-- conf/modules/airspeed_otf.xml | 6 ++--- conf/radios/Corona_24_DIY.xml | 4 ++-- sw/airborne/modules/config/config_mkk_v2.h | 2 +- sw/airborne/peripherals/ms5611.h | 2 +- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/conf/airframes/esden/gain_scheduling_example.xml b/conf/airframes/esden/gain_scheduling_example.xml index 2fa27fd010..a6e726365b 100644 --- a/conf/airframes/esden/gain_scheduling_example.xml +++ b/conf/airframes/esden/gain_scheduling_example.xml @@ -25,13 +25,13 @@ - + - + - + @@ -63,7 +63,7 @@ - + @@ -83,24 +83,24 @@
- +
- + - + - + @@ -134,7 +134,7 @@ - + @@ -146,7 +146,7 @@ - + @@ -163,7 +163,7 @@ - + @@ -198,7 +198,7 @@ - + diff --git a/conf/airframes/esden/lisa2_hex.xml b/conf/airframes/esden/lisa2_hex.xml index 6b1a8d334a..41d1d67104 100644 --- a/conf/airframes/esden/lisa2_hex.xml +++ b/conf/airframes/esden/lisa2_hex.xml @@ -112,7 +112,7 @@ - + @@ -184,7 +184,7 @@ - + diff --git a/conf/modules/airspeed_otf.xml b/conf/modules/airspeed_otf.xml index b9dcb05e31..6935d2f3a4 100644 --- a/conf/modules/airspeed_otf.xml +++ b/conf/modules/airspeed_otf.xml @@ -3,14 +3,14 @@ - OTF! airspeed/flow angle sensor + OTF! airspeed/flow angle sensor Driver for the Aeroprobe On-The-Fly! air data computer. - The Aeroprobe On-The-Fly! air data computer measures + The Aeroprobe On-The-Fly! air data computer measures air pressure from a 5-hole pitot tube and can write resulting data to an SD card or transmit it through an UART. It outputs speed, angle of attack, angle of - sideslip and altitude. + sideslip and altitude. diff --git a/conf/radios/Corona_24_DIY.xml b/conf/radios/Corona_24_DIY.xml index 2872e3f530..e2431114d1 100644 --- a/conf/radios/Corona_24_DIY.xml +++ b/conf/radios/Corona_24_DIY.xml @@ -17,7 +17,7 @@ -- 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. +-- Boston, MA 02111-1307, USA. --> -