readosm.F90

!    Copyright 2011 Davide Cesari <dcesari69 at gmail dot com>
!
!    This file is part of FortranGIS.
!
!    FortranGIS is free software: you can redistribute it and/or modify
!    it under the terms of the GNU Lesser General Public License as
!    published by the Free Software Foundation, either version 3 of the
!    License, or (at your option) any later version.
!
!    FortranGIS 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
!    Lesser General Public License for more details.
!
!    You should have received a copy of the GNU Lesser General Public
!    License along with FortranGIS.  If not, see
!    <http://www.gnu.org/licenses/>.

MODULE readosm
use,INTRINSIC :: iso_c_binding
USE fortranc
IMPLICIT NONE


INTEGER,PARAMETER :: readosm_undefined = -1234567890
INTEGER,PARAMETER :: readosm_member_node = 7361
INTEGER,PARAMETER :: readosm_member_way = 6731
INTEGER,PARAMETER :: readosm_member_relation = 3671
INTEGER,PARAMETER :: readosm_ok = 0
INTEGER,PARAMETER :: readosm_invalid_suffix = -1
INTEGER,PARAMETER :: readosm_file_not_found = -2
INTEGER,PARAMETER :: readosm_null_handle = -3
INTEGER,PARAMETER :: readosm_invalid_handle = -4
INTEGER,PARAMETER :: readosm_insufficient_memory = -5
INTEGER,PARAMETER :: readosm_create_xml_parser_error = -6
INTEGER,PARAMETER :: readosm_read_error = -7
INTEGER,PARAMETER :: readosm_xml_error = -8
INTEGER,PARAMETER :: readosm_invalid_pbf_header = -9
INTEGER,PARAMETER :: readosm_unzip_error = -10
INTEGER,PARAMETER :: readosm_abort = -11

TYPE,bind(c) :: readosm_tag
  TYPE(c_ptr) :: key
  TYPE(c_ptr) :: value
END TYPE readosm_tag

TYPE :: readosm_tag_f
  CHARACTER(kind=c_char,len=1),ALLOCATABLE :: key(:)
  CHARACTER(kind=c_char,len=1),ALLOCATABLE :: value(:)
END TYPE readosm_tag_f


TYPE,bind(c) :: readosm_node
  INTEGER(kind=c_long_long) :: id
  REAL(kind=c_double) :: latitude
  REAL(kind=c_double) :: longitude
  INTEGER(kind=c_int) :: version
  INTEGER(kind=c_long_long) :: changeset
  TYPE(c_ptr) :: user
  INTEGER(kind=c_int) :: uid
  TYPE(c_ptr) :: timestamp
  INTEGER(kind=c_int) :: tag_count
  TYPE(c_ptr) :: tags
END TYPE readosm_node

TYPE :: readosm_node_f
  INTEGER(kind=c_long_long) :: id=0
  REAL(kind=c_double) :: latitude
  REAL(kind=c_double) :: longitude
  INTEGER(kind=c_int) :: version
  INTEGER(kind=c_long_long) :: changeset
!  TYPE(c_ptr) :: user !< name of the User defining this NODE
  INTEGER(kind=c_int) :: uid
!  TYPE(c_ptr) :: timestamp !< when this NODE was defined
  TYPE(readosm_tag_f),ALLOCATABLE :: tags(:)
END TYPE readosm_node_f


TYPE,bind(c) :: readosm_way
  INTEGER(kind=c_long_long) :: id
  INTEGER(kind=c_int) :: version;
  INTEGER(kind=c_long_long) :: changeset
  TYPE(c_ptr) :: user
  INTEGER(kind=c_int) :: uid
  TYPE(c_ptr) :: timestamp;
  INTEGER(kind=c_int) :: node_ref_count
  TYPE(c_ptr) :: node_refs
  INTEGER(kind=c_int) :: tag_count
  TYPE(c_ptr) :: tags
END TYPE readosm_way

TYPE :: readosm_way_f
  INTEGER(kind=c_long_long) :: id=0
  INTEGER(kind=c_int) :: version;
  INTEGER(kind=c_long_long) :: changeset;
!  TYPE(c_ptr) :: user !< name of the User defining this WAY
  INTEGER(kind=c_int) :: uid
!  TYPE(c_ptr) :: timestamp; !< when this WAY was defined
  INTEGER(kind=c_long_long),ALLOCATABLE :: node_refs(:)
  TYPE(readosm_tag_f),ALLOCATABLE :: tags(:)
END TYPE readosm_way_f


TYPE,bind(c) :: readosm_member
  INTEGER(kind=c_int) :: member_type
  INTEGER(kind=c_long_long) :: id
  TYPE(c_ptr) :: role
END TYPE readosm_member

TYPE :: readosm_member_f
  INTEGER(kind=c_int) :: member_type=readosm_undefined 
  INTEGER(kind=c_long_long) :: id
  CHARACTER(kind=c_char,len=1),ALLOCATABLE :: role(:)
END TYPE readosm_member_f


TYPE,bind(c) :: readosm_relation
  INTEGER(kind=c_long_long) :: id
  INTEGER(kind=c_int) :: version;
  INTEGER(kind=c_long_long) :: changeset;
  TYPE(c_ptr) :: user
  INTEGER(kind=c_int) :: uid
  TYPE(c_ptr) :: timestamp;
  INTEGER(kind=c_int) :: member_count
  TYPE(c_ptr) :: members
  INTEGER(kind=c_int) :: tag_count;
  TYPE(c_ptr) :: tags
END TYPE readosm_relation

TYPE :: readosm_relation_f
  INTEGER(kind=c_long_long) :: id
  INTEGER(kind=c_int) :: version;
  INTEGER(kind=c_long_long) :: changeset;
!  TYPE(c_ptr) :: user !< name of the User defining this RELATION
  INTEGER(kind=c_int) :: uid
!  TYPE(c_ptr) :: timestamp; !< when this RELATION was defined
  TYPE(readosm_member_f),ALLOCATABLE :: members(:)
  TYPE(readosm_tag_f),ALLOCATABLE :: tags(:)
END TYPE readosm_relation_f

! define dynamically extensible arrays of the _f types, first part
#undef ARRAYOF_ORIGEQ

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_node_f)
#define ARRAYOF_TYPE arrayof_readosm_node_f
#include "arrayof_pre.F90"

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_way_f)
#define ARRAYOF_TYPE arrayof_readosm_way_f
#include "arrayof_pre.F90"

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_relation_f)
#define ARRAYOF_TYPE arrayof_readosm_relation_f
#include "arrayof_pre.F90"


TYPE readosm_full_f
  TYPE(arrayof_readosm_node_f) :: nodes
  TYPE(arrayof_readosm_way_f) :: ways
  TYPE(arrayof_readosm_relation_f) :: relations
END TYPE readosm_full_f


INTERFACE
  FUNCTION readosm_open(path, osm_handle) BIND(C,name='readosm_open')
  import
  CHARACTER(kind=c_char),INTENT(in) :: path(*)
  TYPE(c_ptr),INTENT(out) :: osm_handle
  INTEGER(kind=c_int) :: readosm_open
  END FUNCTION readosm_open
END INTERFACE


INTERFACE
  FUNCTION readosm_close(osm_handle) BIND(C,name='readosm_close')
  import
  TYPE(c_ptr),VALUE :: osm_handle
  INTEGER(kind=c_int) :: readosm_close
  END FUNCTION readosm_close
END INTERFACE


INTERFACE readosm_parse
  FUNCTION readosm_parse(osm_handle, user_data, node_fnct, way_fnct, &
   relation_fnct) bind(c,name='readosm_parse')
  import
  TYPE(c_ptr),VALUE :: osm_handle
  TYPE(c_ptr),VALUE :: user_data
  TYPE(c_funptr),VALUE :: node_fnct
  TYPE(c_funptr),VALUE :: way_fnct
  TYPE(c_funptr),VALUE :: relation_fnct
  INTEGER(kind=c_int) :: readosm_parse
  END FUNCTION readosm_parse

  MODULE PROCEDURE readosm_parse_f
END INTERFACE readosm_parse


INTERFACE readosm_object_f
  MODULE PROCEDURE readosm_object_f_node, readosm_object_f_way, &
   readosm_object_f_relation
END INTERFACE readosm_object_f


INTERFACE readosm_parse
END INTERFACE readosm_parse

PRIVATE readosm_object_f_node, readosm_object_f_way, &
 readosm_object_f_relation

CONTAINS

FUNCTION readosm_parse_f(osm_handle, user_data, node_fnct, way_fnct, &
 relation_fnct)
TYPE(c_ptr),VALUE :: osm_handle
TYPE(c_ptr),VALUE :: user_data
INTERFACE !< callback function intended to consume node objects (may be NULL if processing NODEs is not an interesting option)
  FUNCTION node_fnct(user_data, node) BIND(C)
  import
  TYPE(c_ptr),VALUE :: user_data
  TYPE(readosm_node) :: node
  INTEGER(kind=c_int) :: node_fnct
  END FUNCTION node_fnct
END INTERFACE

INTERFACE
  FUNCTION way_fnct(user_data, way) BIND(C)
  import
  TYPE(c_ptr),VALUE :: user_data
  TYPE(readosm_way) :: way
  INTEGER(kind=c_int) :: way_fnct
  END FUNCTION way_fnct
END INTERFACE

INTERFACE
  FUNCTION relation_fnct(user_data, relation) BIND(C)
  import
  TYPE(c_ptr),VALUE :: user_data
  TYPE(readosm_relation) :: relation
  INTEGER(kind=c_int) :: relation_fnct
  END FUNCTION relation_fnct
END INTERFACE

OPTIONAL :: node_fnct
OPTIONAL :: way_fnct
OPTIONAL :: relation_fnct 
INTEGER(kind=c_int) :: readosm_parse_f

TYPE(c_funptr) :: nf, wf, rf

IF (present(node_fnct)) THEN
  nf = c_funloc(node_fnct)
ELSE
  nf = c_null_funptr
ENDIF
IF (present(way_fnct)) THEN
  wf = c_funloc(way_fnct)
ELSE
  wf = c_null_funptr
ENDIF
IF (present(relation_fnct)) THEN
  rf = c_funloc(relation_fnct)
ELSE
  rf = c_null_funptr
ENDIF

readosm_parse_f = readosm_parse(osm_handle, user_data, nf, wf, rf)

END FUNCTION readosm_parse_f


! private function for "fortranizing" tags array, it has been
! temporarily converted to a subroutine because of (de)allocations
! problems with gfortran 4.6.3
SUBROUTINE readosm_object_f_tags(tags, tag_count, f_type) ! RESULT(f_type)
TYPE(c_ptr) :: tags ! array of TAG objects (may be NULL)
INTEGER(kind=c_int) :: tag_count; ! number of associated TAGs (may be zero)

TYPE(readosm_tag_f),INTENT(out),ALLOCATABLE :: f_type(:)

TYPE(readosm_tag),POINTER :: tmptags(:)
INTEGER :: i

IF (tag_count > 0 .AND. c_associated(tags)) THEN
  CALL c_f_pointer(tags, tmptags, (/tag_count/))
  ALLOCATE(f_type(tag_count))
  DO i = 1, tag_count
    f_type(i)%key = tmptags(i)%key
    f_type(i)%value = tmptags(i)%value
  ENDDO
ELSE
  ALLOCATE(f_type(0))
ENDIF

END SUBROUTINE readosm_object_f_tags


! private function for "fortranizing" members array, it has been
! temporarily converted to a subroutine because of (de)allocations
! problems with gfortran 4.6.3
SUBROUTINE readosm_object_f_members(members, member_count, f_type) ! RESULT(f_type)
TYPE(c_ptr) :: members ! array of MEMBER objects (may be NULL)
INTEGER(kind=c_int) :: member_count; ! number of associated MEMBERs (may be zero)

TYPE(readosm_member_f),INTENT(out),ALLOCATABLE :: f_type(:)

TYPE(readosm_member),POINTER :: tmpmembers(:)
INTEGER :: i

IF (member_count > 0 .AND. c_associated(members)) THEN
  CALL c_f_pointer(members, tmpmembers, (/member_count/))
  ALLOCATE(f_type(member_count))
  DO i = 1, member_count
    f_type(i)%member_type = tmpmembers(i)%member_type
    f_type(i)%id = tmpmembers(i)%id
    f_type(i)%role = tmpmembers(i)%role
  ENDDO
ELSE
  ALLOCATE(f_type(0))
ENDIF

END SUBROUTINE readosm_object_f_members


FUNCTION readosm_object_f_node(c_type) RESULT(f_type)
TYPE(readosm_node),INTENT(in) :: c_type

TYPE(readosm_node_f) :: f_type

f_type%id = c_type%id
f_type%latitude = c_type%latitude
f_type%longitude = c_type%longitude
f_type%version = c_type%version
f_type%changeset = c_type%changeset
!f_type%user = c_type%user
f_type%uid = c_type%uid
!f_type%timestamp = c_type%timestamp
CALL readosm_object_f_tags(c_type%tags, c_type%tag_count, f_type%tags)
!f_type%tags = readosm_object_f_tags(c_type%tags, c_type%tag_count)

END FUNCTION readosm_object_f_node


FUNCTION readosm_object_f_way(c_type) RESULT(f_type)
TYPE(readosm_way),INTENT(in) :: c_type

TYPE(readosm_way_f) :: f_type

INTEGER(kind=c_long_long),POINTER :: node_refs(:)

f_type%id = c_type%id
f_type%version = c_type%version
f_type%changeset = c_type%changeset
!f_type%user = c_type%user
f_type%uid = c_type%uid
!f_type%timestamp = c_type%timestamp
IF (c_type%node_ref_count > 0 .AND. c_associated(c_type%node_refs)) THEN
  CALL c_f_pointer(c_type%node_refs, node_refs, (/c_type%node_ref_count/))
  f_type%node_refs = node_refs
ELSE
  ALLOCATE(f_type%node_refs(0))
ENDIF
CALL readosm_object_f_tags(c_type%tags, c_type%tag_count, f_type%tags)
!f_type%tags = readosm_object_f_tags(c_type%tags, c_type%tag_count)

END FUNCTION readosm_object_f_way


FUNCTION readosm_object_f_relation(c_type) RESULT(f_type)
TYPE(readosm_relation),INTENT(in) :: c_type

TYPE(readosm_relation_f) :: f_type

f_type%id = c_type%id
f_type%version = c_type%version
f_type%changeset = c_type%changeset
!f_type%user = c_type%user
f_type%uid = c_type%uid
!f_type%timestamp = c_type%timestamp
CALL readosm_object_f_members(c_type%members, c_type%member_count, f_type%members)
CALL readosm_object_f_tags(c_type%tags, c_type%tag_count, f_type%tags)
!f_type%tags = readosm_object_f_tags(c_type%tags, c_type%tag_count)

END FUNCTION readosm_object_f_relation


! define dynamically extendible arrays of the _f types, second part
#undef ARRAYOF_ORIGEQ

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_node_f)
#define ARRAYOF_TYPE arrayof_readosm_node_f
#include "arrayof_post.F90"

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_way_f)
#define ARRAYOF_TYPE arrayof_readosm_way_f
#include "arrayof_post.F90"

#undef ARRAYOF_ORIGTYPE
#undef ARRAYOF_TYPE
#define ARRAYOF_ORIGTYPE TYPE(readosm_relation_f)
#define ARRAYOF_TYPE arrayof_readosm_relation_f
#include "arrayof_post.F90"


FUNCTION readosm_parse_full_f(osm_handle, fulldata)
TYPE(c_ptr),VALUE :: osm_handle
TYPE(readosm_full_f),INTENT(inout),TARGET :: fulldata
INTEGER :: readosm_parse_full_f

! parse using the predefined callbacks
readosm_parse_full_f = readosm_parse(osm_handle, c_loc(fulldata), &
 readosm_full_node, readosm_full_way, readosm_full_relation)

CALL packarray(fulldata%nodes)
CALL packarray(fulldata%ways)
CALL packarray(fulldata%relations)

END FUNCTION readosm_parse_full_f


FUNCTION readosm_full_node(user_data, node) BIND(C)
TYPE(c_ptr),VALUE :: user_data
TYPE(readosm_node) :: node
INTEGER(kind=c_int) :: readosm_full_node

TYPE(readosm_full_f),POINTER :: fulldata

! cast user_data to the desired fortran object and insert the entity
! in "Fortran-friendly" format
CALL c_f_pointer(user_data, fulldata)
CALL insert(fulldata%nodes, readosm_object_f(node))
! set the return code to OK, otherwise parsing will stop
readosm_full_node = readosm_ok

END FUNCTION readosm_full_node


FUNCTION readosm_full_way(user_data, way) BIND(C)
TYPE(c_ptr),VALUE :: user_data
TYPE(readosm_way) :: way
INTEGER(kind=c_int) :: readosm_full_way

TYPE(readosm_full_f),POINTER :: fulldata

! cast user_data to the desired fortran object and insert the entity
! in "Fortran-friendly" format
CALL c_f_pointer(user_data, fulldata)
CALL insert(fulldata%ways, readosm_object_f(way))
! set the return code to OK, otherwise parsing will stop
readosm_full_way = readosm_ok

END FUNCTION readosm_full_way


FUNCTION readosm_full_relation(user_data, relation) BIND(C)
TYPE(c_ptr),VALUE :: user_data
TYPE(readosm_relation) :: relation
INTEGER(kind=c_int) :: readosm_full_relation

TYPE(readosm_full_f),POINTER :: fulldata

! cast user_data to the desired fortran object and insert the entity
! in "Fortran-friendly" format
CALL c_f_pointer(user_data, fulldata)
CALL insert(fulldata%relations, readosm_object_f(relation))
! set the return code to OK, otherwise parsing will stop
readosm_full_relation = readosm_ok

END FUNCTION readosm_full_relation


END MODULE readosm