1/*  Part of SWI-Prolog
    2
    3    Author:        Willem Robert van Hage
    4    E-mail:        W.R.van.Hage@vu.nl
    5    WWW:           http://www.few.vu.nl/~wrvhage
    6    Copyright (c)  2009-2013, Vrije Universiteit Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(kml,
   36          [
   37            kml_shape/2,
   38            kml_shape/4,
   39            kml_uri_shape/3,
   40            kml_file_shape/2,
   41            kml_file_shape/4,
   42            kml_file_uri_shape/3,
   43            kml_save_header/2,
   44            kml_save_shape/3,
   45            kml_save_footer/1,
   46            kml_file_to_georss/1,
   47            kml_file_to_georss/2,
   48            georss_to_kml_file/1,
   49            georss_to_kml_file/2
   50          ]).   51
   52:- use_module(library(http/html_write)).   53:- use_module(library(dcg/basics)).   54:- use_module(library(option)).   55:- use_module(library(lists)).   56:- use_module(library(xpath)).   57:- use_module(library(semweb/rdf_db)).   58:- use_module(library(space/georss)).   59
   60:- rdf_register_ns(kml,'http://www.opengis.net/kml/2.2#').   61:- rdf_meta store_element(r,r,?,t).
 kml_file_to_georss(+KMLfile) is det
 kml_file_to_georss(+KMLfile, +RDFfile) is det
Converts the contents of an KML file into GeoRSS RDF in the RDF database of Prolog. The Geometries are converted to GeoRSS properties and values. Documents, Folders, etc. are ignored. MultiGeometry objects are expanded into separate simple Geometries. Geometries with an XML ID are assigned that ID as URI, other Geometries are assigned a RDF blank node. The kml:name and kml:description are translated to RDF properties.
   77kml_file_to_georss(KMLfile) :-
   78    findall(uri_shape(U,S), kml_file_uri_shape(KMLfile,U,S), US),
   79    forall(member(uri_shape(U,S), US),
   80           (   georss_uri_shape_triple(U,S,Sub,Pred,Obj),
   81               rdf_assert(Sub,Pred,Obj,KMLfile)
   82           )).
   83kml_file_to_georss(KMLfile,RDFfile) :-
   84    kml_file_to_georss(KMLfile),
   85    rdf_save(RDFfile,[graph(KMLfile)]).
 georss_to_kml_file(+KMLfile) is det
 georss_to_kml_file(+KMLfile, +Options) is det
Converts the contents of the RDF database of Prolog into a KML file without style information and without Folders. kml:name and kml:description properties in the RDF database are converted to their KML counterparts. Options can be used to pass Document level options, for example, the name of the dataset. Options can also include a graph(Graph) option to specify which RDF named graph should be converted to KML.
  101georss_to_kml_file(KMLfile) :-
  102    georss_to_kml_file(KMLfile, []).
  103georss_to_kml_file(KMLfile, Options) :-
  104    option(graph(Graph),Options,-),
  105    open(KMLfile, write, Stream, Options),
  106    kml_save_header(Stream, Options),
  107    forall((   Graph \= -
  108           ->  georss:georss_candidate(U,S,Graph)
  109           ;   georss:georss_candidate(U,S)
  110           ),
  111           (   (   (   Graph \= -
  112                   ->  rdf(U,kml:name,literal(N),Graph)
  113                   ;   rdf(U,kml:name,literal(N))
  114                   )
  115               ->  Name = [name(N)]
  116               ;   Name = []
  117               ),
  118               (   (   Graph \= -
  119                   ->  (   rdf(U,kml:description,literal(type(rdf:'XMLLiteral',D)),Graph)
  120                       ->  true
  121                       ;   rdf(U,kml:description,literal(D),Graph)
  122                       )
  123                   ;   (   rdf(U,kml:description,literal(type(rdf:'XMLLiteral',D)))
  124                       ->  true
  125                       ;   rdf(U,kml:description,literal(D))
  126                       )
  127                   )
  128               ->  Desc = [description(D)]
  129               ;   Desc = []
  130               ),
  131               append([Name,Desc],Cont),
  132               (   rdf_is_bnode(U)
  133               ->  kml_save_shape(Stream,
  134                                  placemark(S,[],Cont),
  135                                  Options)
  136               ;   kml_save_shape(Stream,
  137                                  placemark(S,[geom_attributes([id(U)])],Cont),
  138                                  Options)
  139               )
  140          )),
  141    kml_save_footer(Stream),
  142    close(Stream).
 kml_shape(?Stream, ?Shape) is semidet
 kml_shape(?Stream, ?Shape, ?Attributes, ?Content) is semidet
Converts between the KML serialization of a shape and its internal Prolog term representation. Attributes and Content can hold additional attributes and XML content elements of the KML, like ID, name, or styleUrl.
  153kml_shape(KML, Geom) :- kml_shape(KML, Geom, _A, _C).
  154kml_shape(KML, Geom, Attributes, Content) :-
  155    (   nonvar(KML)
  156    ->  atom_to_memory_file(KML, Memfile),
  157        open_memory_file(Memfile, read, Stream),
  158        call_cleanup(load_structure(Stream, XML,
  159                                    [ dialect(xmlns),
  160                                      xmlns('http://www.opengis.net/kml/2.2'),
  161                                      xmlns(kml, 'http://www.opengis.net/kml/2.2')
  162                                    ]),
  163                     free_data(Stream, Memfile)), !,
  164        transform_kml(XML, Geom, Attributes, Content)
  165    ;   construct_kml(KML, Geom, Attributes, Content)
  166    ).
 kml_uri_shape(?KML, ?URI, ?Shape) is semidet
Converts between the KML serialization of a URI-shape pair and its internal Prolog term representation. It is assumed the KML Geometry element has a ID attribute specifying the URI of the shape. e.g.
<PointID="http://example.org/point1"><coordinates>52.37,4.89</coordinates></Point>
  179kml_uri_shape(KML, URI, Shape) :-
  180    (   nonvar(KML)
  181    ->  (   (   kml_shape(KML, Shape, Attr, _),
  182                (   Shape = placemark(Shape, _, _)
  183                ->  get_uri_shape(Shape, URI, _)
  184                ;   memberchk(id=URI, Attr)
  185                )
  186            )
  187        )
  188    ;   kml_shape(KML, Shape, [id=URI], [])
  189    ).
 kml_file_shape(+File, ?Shape) is semidet
 kml_file_shape(+File, ?Shape, ?Attributes, ?Content) is semidet
Reads shapes from a KML file using kml_shape/2. kml_file_shape/4 also reads extra attributes and elements of the KML Geometry. e.g. <Point targetId="NCName"><extrude>0</extrude>...</Point> will, besides parsing the Point, also instantiate Content with [extrude(0)] and Attributes with [targetId('NCName')].
  201kml_file_shape(File, Geom) :- kml_file_shape(File, Geom, _A, _C).
  202kml_file_shape(File, Geom, Attributes, Content) :-
  203    load_structure(File, XML,
  204                   [ dialect(xmlns),
  205%                        xmlns('http://www.opengis.net/kml/2.2'),
  206                     xmlns(kml, 'http://www.opengis.net/kml/2.2')
  207                   ]), !,
  208    transform_kml(XML, Geom, Attributes, Content).
 kml_file_uri_shape(+File, ?URI, ?Shape) is semidet
Reads URI-shape pairs from File using kml_uri_shape/2.
  215kml_file_uri_shape(File, URI, Shape) :-
  216    kml_file_shape(File, Geom, _Attributes, _Content),
  217    get_uri_shape(Geom, URI, Shape, File).
  218
  219% work-around hack to avoid implementing geometry collections in C++
  220non_geometrycollection_member(Shape, Geoms) :-
  221    member(Member,Geoms),
  222    (   Member = geometrycollection(Content)
  223    ->  non_geometrycollection_member(Shape,Content)
  224    ;   Shape = Member
  225    ).
  226get_shape(Shape,Shape2) :-
  227    (   Shape = geometrycollection(Content)
  228    ->  non_geometrycollection_member(Shape2,Content)
  229    ;   Shape2 = Shape
  230    ).
  231
  232get_uri_shape(E,U,S) :-
  233    get_uri_shape(E,U,S,_).
  234get_uri_shape(geometrycollection(Content), URI, Shape, File) :-
  235    non_geometrycollection_member(Member, Content),
  236    get_uri_shape(Member, URI, Shape, File).
  237get_uri_shape(document([H|T]), URI, Shape, File) :-
  238    get_uri_shape(H, URI, Shape, File) ;
  239    get_uri_shape(document(T), URI, Shape, File).
  240get_uri_shape(folder([H|T]), URI, Shape, File) :-
  241    get_uri_shape(H, URI, Shape, File) ;
  242    get_uri_shape(folder(T), URI, Shape, File).
  243get_uri_shape(folder([H|T],_,_), URI, Shape, File) :-
  244    get_uri_shape(H, URI, Shape, File) ;
  245    get_uri_shape(folder(T), URI, Shape, File).
  246get_uri_shape(placemark(Shape,Attributes,_),URI,Shape2, _File) :-
  247    member(geom_attributes(GA),Attributes),
  248    (   memberchk(id=URI, GA) ;
  249        memberchk('ID'=URI, GA)
  250    ), !,
  251    get_shape(Shape,Shape2).
  252get_uri_shape(placemark(Shape,_,E), URI, Shape2, File) :-
  253    (   member(description([D]), E)
  254    ->  (   atom(D),
  255            once(atom_codes(D, DC)),
  256            phrase(uri(URIcodes),DC,_)
  257        ->  atom_codes(URI,URIcodes)
  258        ;   rdf_bnode(URI)
  259        ), store_element(URI, kml:description, E, File)
  260    ;   rdf_bnode(URI)
  261    ), store_element(URI, kml:name, E, File),
  262    get_shape(Shape,Shape2).
  263
  264store_element(URI, Prop, Element, Graph) :-
  265    (   E =.. [Prop,[D]]
  266    ;   rdf_global_id(_NS:ID,Prop),
  267        E =.. [ID,[D]]
  268    ),
  269    member(E, Element),
  270    atom(D),
  271    (   atom_to_memory_file(D, Memfile),
  272        open_memory_file(Memfile, read, Stream),
  273        call_cleanup(load_structure(Stream, XML,
  274                                    [ dialect(xmlns),
  275                                      syntax_errors(quiet) ]),
  276                     free_data(Stream, Memfile)),
  277        memberchk(element(_,_,_),XML)
  278    ->  rdf_equal(rdf:'XMLLiteral', XMLType),
  279        Literal = type(XMLType, XML)
  280    ;   Literal = D
  281    ),
  282    (   nonvar(Graph)
  283    ->  rdf_assert(URI, Prop, literal(Literal), Graph)
  284    ;   rdf_assert(URI, Prop, literal(Literal))
  285    ).
  286
  287uri(URI) -->
  288    string(_), "http://", nonuri(Rest),
  289    { string_codes("http://", Prefix),
  290      append(Prefix, Rest, URI)
  291    }.
  292
  293nonuri([H|T]) -->
  294    [H],
  295    { code_type(H, graph),
  296      H \== 0'<,
  297      H \== 0')                     % FIXME: make this a bit more subtle
  298    }, !,
  299    nonuri(T).
  300nonuri([]) -->
  301    [].
  302
  303
  304free_data(Stream, Memfile) :-
  305    close(Stream),
  306    free_memory_file(Memfile).
  307
  308coordinates(point(X,Y),PosList) :-
  309    atomic_list_concat([Y,X], ',', PosList).
  310coordinates(point(X,Y,Z),PosList) :-
  311    atomic_list_concat([Y,X,Z], ',', PosList).
  312
  313coordinates_list(Points, PosList) :-
  314    coordinates_list_aux(Points, PosLists),
  315    atomic_list_concat(PosLists, ' ', PosList).
  316coordinates_list_aux([],[]).
  317coordinates_list_aux([H|T],[Coord|Coords]) :-
  318    coordinates(H, Coord),
  319    coordinates_list_aux(T,Coords).
  320
  321linearring(Points, Ring) :-
  322    (   nth0(0, Points, First1),
  323        last(Points, First1)
  324    ->  Ring = Points
  325    ;   nth0(0, Points, First2),
  326        append(Points, [First2], Ring)
  327    ).
  328
  329interior_tags([],[]).
  330interior_tags([PosList|PosLists],
  331              ['LinearRing'('coordinates'(PosList))|ILRS]) :-
  332    interior_tags(PosLists, ILRS).
  333
  334expand_nl([],[]).
  335expand_nl([nl|T],['\n'|T2]) :-
  336    expand_nl(T,T2).
  337expand_nl([nl(0)|T],[''|T2]) :-
  338    expand_nl(T,T2).
  339expand_nl([nl(N)|T],['\n'|T2]) :-
  340    M is N - 1,
  341    expand_nl([nl(M)|T],T2).
  342expand_nl([H|T],[H|T2]) :-
  343    expand_nl(T,T2).
  344
  345construct_kml(KML, Geom) :- construct_kml(KML, Geom, [], []).
  346
  347construct_kml(KML, Geom, Attributes, Content) :-
  348    construct_term(Geom, Attributes, Content, T),
  349    phrase(html(T), Atoms),
  350    expand_nl(Atoms,Atoms2),
  351    atomic_list_concat(Atoms2, KML).
  352
  353construct_term(Geom, Attributes, Content, T) :-
  354    (   folder_term(Geom, Attributes, Content, T)
  355    ;   placemark_term(Geom, Attributes, Content, T)
  356    ;   point_term(Geom, Attributes, Content, T)
  357    ;   linestring_term(Geom, Attributes, Content, T)
  358    ;   linearring_term(Geom, Attributes, Content, T)
  359    ;   polygon_term(Geom, Attributes, Content, T)
  360    ;   multigeometry_term(Geom, Attributes, Content, T)
  361    ).
  362
  363point_term(Point, Attributes, Content, P) :-
  364    coordinates(Point, PosList),
  365    P = 'Point'(Attributes,[ 'coordinates'(PosList)|Content]).
  366
  367linestring_term(linestring(Points), Attributes, Content, LR) :-
  368    coordinates_list(Points, PosList),
  369    LR = 'LineString'(Attributes, [ 'coordinates'(PosList) | Content ]).
  370
  371linearring_term(linestring(Points), Attributes, Content, LR) :-
  372    linearring(Points, Ring),
  373    coordinates_list(Ring, PosList),
  374    LR = 'LinearRing'(Attributes, [ 'coordinates'(PosList) | Content ]).
  375
  376polygon_term(polygon([ExternalRing|InternalRings]),
  377             Attributes, Content, PT) :-
  378    linearring(ExternalRing, ER),
  379    coordinates_list(ER, ExtPosList),
  380    maplist(coordinates_list, InternalRings, IntPosLists),
  381    interior_tags(IntPosLists, ILRS),
  382    (   ILRS = []
  383    ->  Rest = Content
  384    ;   append(['innerBoundaryIs'(ILRS)], Content, Rest)
  385    ),
  386    PT = 'Polygon'(Attributes, [ 'outerBoundaryIs'('LinearRing'('coordinates'(ExtPosList))) | Rest ]).
  387
  388multigeometry_term(geometrycollection(GCS),
  389                   Attributes, Content, GCT) :-
  390    multigeometry_term_aux(GCS, GCTS),
  391    append(GCTS, Content, GCTS_and_Content),
  392    GCT = 'MultiGeometry'(Attributes, GCTS_and_Content).
  393
  394multigeometry_term_aux([], []).
  395multigeometry_term_aux([Geom|Geoms], [T|Ts]) :-
  396    construct_term(Geom, [], [], T),
  397    multigeometry_term_aux(Geoms, Ts).
  398
  399% FIXME: prehaps switch around [],[] and A,C?
  400placemark_term(placemark(Geom), A, C, T) :-
  401    placemark_term(placemark(Geom, [], []), A, C, T).
  402
  403placemark_term(placemark(Geom, Attributes, Content), _A, _C, T) :-
  404    (   member(geom_attributes(_), Attributes)
  405    ->  select(geom_attributes(GeomAttr), Attributes, PMAttr)
  406    ;   GeomAttr = [],
  407        PMAttr = Attributes
  408    ),
  409    (   member(geom_content(_), Content)
  410    ->  select(geom_content(GeomCont), Content, PMCont)
  411    ;   GeomCont = [],
  412        PMCont = Content
  413    ),
  414    construct_term(Geom, GeomAttr, GeomCont, GT),
  415    T = 'Placemark'(PMAttr, [ GT | PMCont ]), !.
  416
  417folder_term(folder(PMs), A, C, T) :-
  418    folder_term(folder(PMs,[],[]), A, C, T).
  419
  420folder_term(folder(PMs, Attributes, Content), _A, _C, T) :-
  421    construct_term_list(PMs, PMTs),
  422    append(PMTs,Content,PMTsContent),
  423    T = 'Folder'(Attributes, PMTsContent).
  424
  425construct_term_list([],[]).
  426construct_term_list([H|T],[HT|TT]) :-
  427    construct_term(H,[],[],HT),
  428    construct_term_list(T,TT).
  429
  430% -----
  431
  432transform_kml(Elts, P, Attributes, Content) :-
  433    member(element(_:'Point',A,PointElts), Elts),
  434    get_point(PointElts, P),
  435    get_extras([element(_,A,PointElts)], Attributes, Content).
  436
  437transform_kml(Elts, linestring(P), Attributes, Content) :-
  438    (   member(element(_:'LineString',A,LSE), Elts)
  439    ;   member(element(_:'LinearRing',A,LSE), Elts)
  440    ),
  441    get_linestring(LSE, P),
  442    get_extras([element(_,A,LSE)], Attributes, Content).
  443
  444transform_kml(Elts, polygon([Ext|Int]), Attributes, Content) :-
  445    member(element(_:'Polygon',A,PolygonElts), Elts),
  446    get_polygon_exterior(PolygonElts, Ext),
  447    get_polygon_interiors(PolygonElts, Int),
  448    get_extras([element(_,A,PolygonElts)], Attributes, Content).
  449
  450transform_kml(Elts, geometrycollection(Geoms), Attributes, Content) :-
  451    member(element(_:'MultiGeometry',_,GeomElts), Elts),
  452    get_geometry(GeomElts, Geoms),
  453    get_extras(Elts, Attributes, Content).
  454/*
  455transform_kml(Elts, Geom, Attributes, Content) :-
  456        member(element(_:'MultiGeometry',_,GeomElts), Elts),
  457        get_geometry(GeomElts, Geoms),
  458        member(Geom, Geoms),
  459        get_extras(Elts, Attributes, Content).
  460*/
  461transform_kml(Elts, placemark(Geom, Attributes, Content), _A, _C) :-
  462    member(element(_:'Placemark',_,GeomElts), Elts),
  463    transform_kml(GeomElts, Geom, GeomAttr, GeomCont),
  464    get_extras(Elts, PMAttributes, PMContent),
  465    (   GeomAttr \= []
  466    ->  append(PMAttributes,[geom_attributes(GeomAttr)],Attributes)
  467    ;   Attributes = PMAttributes
  468    ),
  469    (   GeomCont \= []
  470    ->  append(PMContent,[geom_content(GeomCont)],Content)
  471    ;   Content = PMContent
  472    ), !.
  473
  474transform_kml(Elts, folder(PMs, Attributes, Content), _, _) :-
  475    member(element(_:'Folder', _, PMElts), Elts),
  476    get_geometry(PMElts, PMs),
  477    get_extras(Elts, Attributes, Content), !.
  478
  479transform_kml(Elts, PM, Attributes, Content) :-
  480    member(element(_:'Folder', _, PMElts), Elts),
  481    get_geometry(PMElts, PMs),
  482    get_extras(Elts, Attributes, Content),
  483    member(PM,PMs).
  484
  485transform_kml(Elts, PM, Attributes, Content) :-
  486    member(element(_:'Document',_,PMElts), Elts),
  487    get_geometry(PMElts, PMs),
  488    get_extras(Elts, Attributes, Content),
  489    member(PM,PMs).
  490
  491transform_kml(Elts, Doc, Attributes, Content) :-
  492    member(element(_:'kml',_,PMElts), Elts),
  493    transform_kml(PMElts, Doc, _, _),
  494    get_extras(Elts, Attributes, Content).
  495
  496get_geometry([],[]).
  497
  498get_geometry([Elt|Elts], [Geom|Geoms]) :-
  499    transform_kml([Elt], Geom, _A, _C),
  500    get_geometry(Elts, Geoms), !.
  501get_geometry([_|Elts], Geoms) :-
  502    get_geometry(Elts, Geoms).
  503
  504get_point(Elts, P) :-
  505    xpath(Elts, //(_:'coordinates'), element(_,_,[A])),
  506    atom_codes(A, C),
  507    phrase(pos(P), C).
  508
  509get_linestring(Elts, P) :-
  510    xpath(Elts, //(_:'coordinates'), element(_,_,[A])),
  511    atom_codes(A, C),
  512    phrase(poslist(P), C).
  513
  514get_polygon_exterior(Elts, Ext) :-
  515    xpath(Elts, //(_:'outerBoundaryIs')//(_:'coordinates'), element(_,_,[A])),
  516    atom_codes(A, C),
  517    phrase(poslist(Ext), C).
  518
  519get_polygon_interiors(Elts, Int) :-
  520    findall(I,
  521            (   xpath(Elts, //(_:'innerBoundaryIs')//(_:'coordinates'), element(_,_,[A])),
  522                atom_codes(A, C),
  523                phrase(poslist(I), C)
  524            ),
  525            Int).
  526
  527controlled_kml_term('Point').
  528controlled_kml_term('LineString').
  529controlled_kml_term('LinearRing').
  530controlled_kml_term('Polygon').
  531controlled_kml_term('innerBoundaryIs').
  532controlled_kml_term('outerBoundaryIs').
  533controlled_kml_term('MultiGeometry').
  534controlled_kml_term('coordinates').
  535controlled_kml_term('Placemark').
  536controlled_kml_term('Folder').
  537
  538
  539get_extras(Elts, Attributes, Cont) :-
  540    get_extras(Elts, IDs, Rests, Cont),
  541    append(IDs, Rests, Attributes), !.
  542get_extras(Elts, IDAttr, RestAttr, Content) :-
  543    member(element(_,_,C), Elts),
  544    filter_controlled(C, Content),
  545    member(element(_,A,_), Elts),
  546    filter_id(A, IDAttr, RestAttr), !.
  547
  548filter_controlled([],[]).
  549filter_controlled([element(_:H,_A,C)|T], List) :-
  550    (   controlled_kml_term(H)
  551    ->  filter_controlled(T,List)
  552    ;   (   Tag =.. [H,C],
  553            List = [Tag|U],
  554            filter_controlled(T,U)
  555        )
  556    ), !.
  557filter_controlled([_|T],U) :-
  558    filter_controlled(T,U).
  559
  560filter_id([],[],[]).
  561filter_id([ID=I|T],[ID=I|U],V) :-
  562    (   ID = 'id'
  563    ;   ID = 'ID'
  564    ),
  565    filter_id(T,U,V), !.
  566filter_id([H|T],U,[H|V]) :-
  567    filter_id(T,U,V).
  568
  569
  570poslist(T) --> blank_star, poslist_aux(T), blank_star, !.
  571poslist_aux(L) --> poslist_plus(L).
  572poslist_plus([H|T]) --> pos(H), poslist_star(T).
  573poslist_star(T) --> blank_plus, poslist_aux(T).
  574poslist_star([]) --> [], !.
  575
  576pos(point(X,Y)) --> c(Y), ",", blank_star, c(X), ",", blank_star, "0".
  577pos(point(X,Y)) --> c(Y), ",", blank_star, c(X).
  578pos(point(X,Y,Z)) --> c(Y), ",", blank_star, c(X), ",", blank_star, c(Z).
  579pos(point(X,Y,Z,M)) --> c(Y), ",", blank_star, c(X), ",", blank_star, c(Z), ",", blank_star, c(M).
  580c(X) --> float(X).
  581
  582blank_plus --> blank, blank_star, !.
  583blank_plus --> " ", !.
  584blank_star --> blanks, !.
  585blank_star --> [], !.
 kml_save_header(+Stream, +Options) is semidet
Outputs a KML header to Stream. This can be followed by calls to kml_save_shape/3 and kml_save_footer/1.

Options is an option list that can contain the option name(Name) specifying the Name of the document.

To be done
- options to configure optional entities, like styles
  600kml_save_header(Stream,Options) :-
  601    format(Stream,"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n",[]),
  602    format(Stream,"<kml xmlns=\"http://www.opengis.net/kml/2.2\">\n",[]),
  603    format(Stream,"<Document>\n",[]),
  604    (   stream_property(Stream,file_name(FName)),
  605        option(name(Name),Options,FName)
  606    ->  format(Stream,"<name>~w</name>\n",[Name])
  607    ;   option(name(Name),Options),
  608        atom(Name)
  609    ->  format(Stream,"<name>~w</name>\n",[Name])
  610    ;   true
  611    ).
 kml_save_shape(+Stream, +Shape, +Options) is semidet
Outputs a KML serialization of Shape to Stream. This can be preceded by a call to kml_save_header/2 and followed by more calls to kml_save_shape/3 and a call to kml_save_footer/1.

Options is an option list that can contain the option attr(+List) or content(+List) that can be used to add additional attributes or xml element content to a shape. This can be used to specify things like the ID or name.

Layout elements, like Placemark and Folder, have their own separate extra attributes to supply additional attributes and content. These can contain the special terms geom_attributes and geom_content that pass their content to the shape contained by the Placemark. For example, rendering a Placemark with the ID "placemark12" of an extruded Point shape with its URI as name of the Placemark and as ID of the shape and an additional styleUrl works as follows:

kml_save_shape(Stream,
               placemark(point(53.0,3.9),
                         [ id(placemark12),
                           geom_attributes([ id(URI) ])
                         ],
                         [ name(URI),styleUrl(URI),
                           geom_content([ extrude(1) ])
                         ]),
               []).
  649kml_save_shape(Stream,Shape,Options) :-
  650    option(attr(Attributes),Options,[]),
  651    option(content(Content),Options,[]),
  652    kml_shape(KML,Shape,Attributes,Content),
  653    format(Stream,"~w\n",[KML]).
 kml_save_footer(+Stream) is det
Outputs a KML footer to stream Stream. This can be preceded by calls to kml_save_header/2 and kml_save_shape/3.
  661kml_save_footer(Stream) :-
  662    format(Stream,"\n</Document>\n</kml>\n\n",[])