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-2012, 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(gml,
   36          [ gml_shape/2
   37          ]).   38
   39:- use_module(library(http/html_write)).   40:- use_module(library(dcg/basics)).   41:- use_module(library(memfile)).   42:- use_module(library(xpath)).   43:- use_module(library(sgml)).   44:- use_module(library(lists)).

 gml_shape(?GML, ?Shape) is semidet

Converts between the GML serialization of a shape and its internal Prolog term representation.

   51gml_shape(GML, Geom) :-
   52    (   var(Geom)
   53    ->  atom_to_memory_file(GML, Memfile),
   54        open_memory_file(Memfile, read, Stream),
   55        call_cleanup(load_structure(Stream, XML,
   56                                    [ dialect(xmlns),
   57                                      xmlns('http://www.opengis.net/gml'),
   58                                      xmlns(gml, 'http://www.opengis.net/gml')
   59                                    ]),
   60                     free_data(Stream, Memfile)),
   61        transform_gml(XML, Geom)
   62    ;   construct_gml(GML, Geom)
   63    ).
   64
   65free_data(Stream, Memfile) :-
   66    close(Stream),
   67    free_memory_file(Memfile).
   68
   69linearring('gml:LinearRing'('gml:posList'(LSC)),LR) :-
   70    phrase(poslist(LR),LinearRing),
   71    atom_codes(LSC,LinearRing).
   72
   73interior([],[]).
   74interior(['gml:interior'(LR1)|T1],[LR2|T2]) :-
   75    linearring(LR1,LR2),
   76    interior(T1,T2).
   77
   78construct_gml(GML,point(X,Y)) :-
   79    atomic_list_concat([X,Y],' ',PosList),
   80    phrase(html('gml:Point'('gml:pos'(PosList))),Atoms),
   81    atomic_list_concat(Atoms,GML).
   82construct_gml(GML,point(X,Y,Z)) :-
   83    atomic_list_concat([X,Y,Z],' ',PosList),
   84    phrase(html('gml:Point'('gml:pos'(PosList))),Atoms),
   85    atomic_list_concat(Atoms,GML).
   86construct_gml(GML,point(X,Y,Z,M)) :-
   87    atomic_list_concat([X,Y,Z,M],' ',PosList),
   88    phrase(html('gml:Point'('gml:pos'(PosList))),Atoms),
   89    atomic_list_concat(Atoms,GML).
   90
   91construct_gml(GML,linestring(LS)) :-
   92    phrase(poslist(LS),LineString),
   93    atom_codes(LSC,LineString),
   94    phrase(html('gml:LineString'('gml:posList'(LSC))),Atoms),
   95    atomic_list_concat(Atoms,GML).
   96
   97construct_gml(GML,polygon([Ext|Int])) :-
   98    linearring(ExtT,Ext),
   99    interior(InteriorTerms,Int),
  100    phrase(html('gml:Polygon'(['gml:exterior'(ExtT)|InteriorTerms])),Atoms),
  101    atomic_list_concat(Atoms,GML).
  102
  103construct_gml(GML,box(point(X1,Y1),point(X2,Y2))) :-
  104    atomic_list_concat([X1,Y1],' ',PosList1),
  105    atomic_list_concat([X2,Y2],' ',PosList2),
  106    phrase(html('gml:Envelope'(['gml:lowerCorner'(PosList1),
  107                                'gml:upperCorner'(PosList2)])),Atoms),
  108    atomic_list_concat(Atoms,GML).
  109
  110transform_gml(Elts,P) :-
  111    member(element(_:'Point',_,PointElts),Elts),
  112    get_point(PointElts,P).
  113
  114transform_gml(Elts,linestring(LS)) :-
  115    member(element(_:'LineString',_,LineStringElts),Elts),
  116    get_linestring(LineStringElts,LS).
  117
  118transform_gml(Elts,polygon([Ext|Int])) :-
  119    member(element(_:'Polygon',_,PolygonElts),Elts),
  120    get_polygon_exterior(PolygonElts,Ext),
  121    get_polygon_interiors(PolygonElts,Int).
  122
  123transform_gml(Elts,box(Lower,Upper)) :-
  124    member(element(_:'Envelope',_,BoxElts),Elts),
  125    get_box(BoxElts,Lower,Upper).
  126
  127get_point(Elts,P) :-
  128    xpath(Elts, //(_:'pos'), element(_,_,[A])),
  129    atom_codes(A,C),
  130    phrase(pos(P),C).
  131
  132get_linestring(Elts,LS) :-
  133    xpath(Elts, //(_:'posList'), element(_,_,[A])),
  134    atom_codes(A,C),
  135    phrase(poslist(LS),C).
  136
  137get_polygon_exterior(Polygon,Ext) :-
  138    xpath(Polygon, //(_:'exterior')/(_:'LinearRing')/(_:'posList'), element(_,_,[A])),
  139    atom_codes(A,C),
  140    phrase(poslist(Ext),C).
  141get_polygon_interiors(Polygon,Int) :-
  142    findall(I,get_polygon_interior(Polygon,I),Int).
  143get_polygon_interior(Polygon,Int) :-
  144    xpath(Polygon, //(_:'interior')/(_:'LinearRing')/(_:'posList'), element(_,_,[A])),
  145    atom_codes(A,C),
  146    phrase(poslist(Int),C).
  147
  148get_box(Elts,LBC,UBC) :-
  149    xpath(Elts, //(_:'lowerCorner'), element(_,_,[LA])),
  150    xpath(Elts, //(_:'lowerCorner'), element(_,_,[UA])),
  151    atom_codes(LA,LC),
  152    atom_codes(UA,UC),
  153    phrase(pos(LBC),LC),
  154    phrase(pos(UBC),UC).
  155
  156
  157poslist(T) --> blank_star, poslist_plus(T), blank_star, !.
  158poslist_plus([H|T]) --> pos(H), poslist_star(T).
  159poslist_star(T) --> blank_plus, poslist(T).
  160poslist_star([]) --> [], !.
  161
  162pos(point(X,Y)) --> c(X), blank_plus, c(Y).
  163pos(point(X,Y,Z)) --> c(X), blank_plus, c(Y), blank_plus, c(Z).
  164pos(point(X,Y,Z,M)) --> c(X), blank_plus, c(Y), blank_plus, c(Z), blank_plus, c(M).
  165c(X) --> float(X).
  166
  167blank_plus --> blank, blank_star, !.
  168blank_plus --> " ", !.
  169blank_star --> blanks, !.
  170blank_star --> [], !