K-3iiのGPSログ(KML)をGPXに変換

昨年買ったカメラ(K-3 ii)にはGPSログ取得機能が付いているのですが、時刻情報がコメントで採取されており、ヤマレコにアップする際に時刻情報が落ちてしまうため、適当XMLコンバータを作成しました。

PENTAX デジタル一眼レフ K-3II ボディ GPS内蔵 ローパスセレクタ 最高約8.3コマ/秒 16162

開発環境はお手軽につくれるDrRacketで。

#lang racket/gui
(require xml)
(require xml/xexpr)
(require xml/plist)
(require xml/path)


(require racket/gui)
(require framework)
(require (only-in rnrs/io/ports-6
                  call-with-port
                  file-options
                  open-file-input-port
                  open-file-output-port))

(define (read-kml-file path)
  (call-with-port
   (open-file-input-port path)
   read-xml/document))

(define (write-gpx-file gpx path)
  (call-with-port
   (open-file-output-port path (file-options no-fail))
   (lambda (port)
     (display "<?xml version=\"1.0\" encoding=\"UTF-8\"?>" port)
     (write-xml/content gpx port))))

(define (placemarks kml)
  (define (description->date desc)
    (regexp-replace #rx"(.*)(....)/(..)/(..) (..:..:..) UTC([+-]..:..)(.*)"
                    (cdata-string desc)
                    "\\2-\\3-\\4T\\5\\6" ))  
  (define (coordinates->latlon cood)
    (cdr (regexp-match #rx"(.*),(.*),(.*)" cood)))
  
  (let ((xexpr (xml->xexpr (document-element kml))))
    (map (lambda (time lats) (cons time lats))
     (map description->date (se-path*/list '(Placemark description) xexpr))
     (map coordinates->latlon (se-path*/list '(Placemark Point coordinates) xexpr)))))


(define (placemark->trkpt placemark)
  `(trkpt ((lat ,(caddr placemark))
           (lon ,(cadr  placemark)))
          (ele ,(cadddr placemark))
          (time ,(car placemark))))

(define (placemarks->xexpr-gpx placemarks)
  `(gpx
    ((creator "K-3 ii KML2GPX converter") (version "1.1") (xmlns "http://www.topografix.com/GPX/1/1"))
    (trk ()
         (trkseg ()
                 ,@(map placemark->trkpt placemarks)))))

(let ((input (get-file "select KML file" #f #f #f #f null '(("KML" "*.kml")))))
  (if input
      (let ((output (put-file "select GPX file" #f #f (path-replace-suffix input ".gpx") #f null '(("GPX" "*.gpx")))))
        (if output
            (write-gpx-file
             (xexpr->xml
              (placemarks->xexpr-gpx
               (placemarks
                (read-kml-file input))))
             output)
            #f))
      #f))