2016-06-07

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

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

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

出版社/メーカー: リコー
発売日: 2015/05/22
メディア: Camera
この商品を含むブログ (3件) を見る

開発環境はお手軽につくれる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))

2011-02-17

jibeを入れた。

androidマーケットにskypeとjibeが登録されていたのでインストールした。skypeはauマーケットから乗り換え。

2010-10-24

Shibuya.lisp Hackathon#1

Shibuya.lisp Hackathon #1 : ATNDに行ってきました。

swank-gaucheの機能追加を行なおうと思ったのですが、思う様には行きませんでした。
ユニットテストを書こうとか、プレゼンテーションストリームを実装しようとかいろいろ迷いましたが、手続きの定義箇所にジャンプする機能(slime-edit-definition)を実装してみることにしました。

slime-edit-definitionの実装をするには、swank側では、find-definitions-for-emacsという手続を定義すればよさそうです。この関数はシンボルが定義されたファイル名とoffsetを返します。
そこで、gaucheが持っている情報にアクセスする方法を調査しました。

エラー発生時には、ファイル名と行番号が表示されるのでそのあたりから見ていきます。

Scm_ShowStackTrace()でスタックトレースを表示しています。スタックトレースでは、スタックに積まれている手続きのファイル名と行番号を表示しています。
Scm_ShowStackTrace()を見ると、ファイル名と行番号の情報をとるの、Scm_PairAttrGet()の模様。
これが、swank-gaucheから使えれば、定義位置の特定ができそうです。

ソースを調べたところ、似た名前の手続き(pair-attribute-get)がgauche.internalで定義されていました。
このpair-attribute-getで情報がとれるか実験します。

gauche.internal> (pair-attribute-get '(1 2 3) 'source-info)
("(input string port)" 1)
gauche.internal> (pair-attribute-get (cons 1 2) 'source-info)
*** ERROR: No value associated with key source-info in pair attributes of (1 . 2)
Stack Trace:
_______________________________________
  0  (with-ports in out out fun)
        At line 373 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  1  (with-ports in out out fun)
        At line 373 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  2  (cdr sexp)
        At line 397 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  3  (write-return `(:ok ,(apply (swank-gauche: (car sexp)) (cdr sexp)) ...
        At line 396 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  4  (write-abort "Not Impremented: ~s" (car sexp))
        At line 387 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  5  (dispatch-event event)
        At line 142 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  6  (do ((event (event-dequeue!) (event-dequeue!))) ((not event)) (dis ...
        At line 140 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
  7  (do ((packet (read-packet) (read-packet))) ((eof-object? packet) ( ...
        At line 136 of "/home/takayuki/scm/swank-gauche/swank-gauche.scm"
; Evaluation aborted on eval (swank:listener-eval (pair-attribute-get (cons 1 2) 'source-info)
).
gauche.internal>

取れそうです。
consで作ったpairには当然ながらsource-infoは付いていません。

gauche.internalをuseしようとしましたが、gauche.internalはuseできない様です。
そこで、select-moduleした後にimportして使用することにしました。が、importしてみたけど、exportされていないシンボルの様子。

gauche.internal> (module-exports (find-module 'gauche.internal))
()
gauche.internal>

というか、gauche.internalは何もexportしていません・・・。あたりまえといえばあたりまえですが。

global-variable-refを使って、pair-attribute-getの値を参照することにします。
あとは、手続きから、元となったpairを取得する方法が分かれば、ジャンプの機能を実装できそうです。

ちなみに、source-infoはread_list()かread_quoted()で付けられていました。

とここで時間切れで終了です。

2010-01-05

swank-gaucheをgithubに移行

Gauche

年末年始にswank-gaucheをちょっといじったので、ついでにgithubに移行しました。

http://github.com/cj2tszk/swank-gauche

Gaucheは0.9、SLIMEのバージョンは"2010-01-03"で確認しています。

2009-12-24

executor

Common Lisp

外部の実行可能プログラムを起動するためのライブラリ。
処理系毎の違いを吸収してくれます。

http://www.cliki.net/executor

いまのところ「ドキュメントはソース」かつ対応実装はSBCLのみの様です。

外部コマンドの実行

execute

基本的な機能。パス検索もなし。

(exec:execute "/bin/ls" '("/tmp"))
;; -> /tmpのファイル一覧
;; => 0 ;; commandのexit status


;; 別の書き方
(exec:execute* "/bin/ls" "/tmp")

execute-external

パス検索機能あり。

実行形式ファイルを探すディレクトリをexec:*search-path*にリストで設定します。ロード後には (#p"/bin" #p"/usr/bin")が設定されています。
:outputは起動するコマンドの出力先ポートを指定します。デフォルトはnilで標準出力は破棄されます。tを指定すると*standard-output*が標準出力になります。:captureはコマンドの出力を文字列にして、２つめの戻り値として返します。

(exec:execute-external 'ls '("/tmp") :output t)
;; -> /tmpのファイル一覧
;; => t


(exec:execute-external 'ls '("/tmp") :output :capture)
;; => t
;;    "/tmpのファイル一覧"


(with-output-to-string (port)
	   (exec:execute-external 'ls '("/tmp") :output port))
;; => "/tmpのファイル一覧"

define-executable

exec:execute-externalの実行を行う関数を定義するマクロです。
:outputに:cautureを指定した様に動きます。

(exec:define-executable (ls "ls"))
:: => LS
(ls "/tmp")
;; => t
;;    "/tmpのファイル一覧"

パイプラインの形成

pipeline

基本的な機能。パス検索もなし。

(exec:pipeline '(("/bin/cat" "hoge.txt")
                 ("/usr/bin/grep" "hoge")))
;; -> hoge.txtの中の"hoge"を含む行
;; => 0 ;; commandのexit status


;; 別の書き方
(exec:pipeline* '("/bin/cat" "hoge.txt")
                '("/usr/bin/gerp" "hoge"))

pipe

pipelineを呼び出すマクロ。
なぜかfind-executableでシンボルに対応する実行可能ファイルの登録を行わないと使用できない。

(exec:find-executable 'cat)
;; => #p"/bin/cat"
(exec:find-executable 'grep)
;; => #p"/usr/bin/grep"
(exec:pipe (cat "hoge.txt") (grep "hoge"))
;; -> hoge.txtの中の"hoge"を含む行
;; => 0 ;; commandのexit status

他にも色々関数、マクロはありますが、基本的なところはこんな感じでした。

2009-12-22

slime + auto-complete

Common Lisp

ググッても誰もやってなさそうだったので。

id:m2ymさんのauto-completeをslimeで使ってみる試み。

auto-completeインストール後、.emacsに以下を追加。

(defvar ac-slime-modes
  '(lisp-mode))

(defun ac-slime-candidates ()
  "Complete candidates of the symbol at point."
  (if (memq major-mode ac-slime-modes)
      (let* ((end (point))
	     (beg (slime-symbol-start-pos))
	     (prefix (buffer-substring-no-properties beg end))
	     (result (slime-simple-completions prefix)))
	(destructuring-bind (completions partial) result
	  completions))))

(defvar ac-source-slime
  '((candidates . ac-slime-candidates)
    (requires-num . 3)))

(add-hook 'lisp-mode-hook (lambda ()
			    (slime-mode t)
			    (push 'ac-source-slime ac-sources)
			    (auto-complete-mode))))

すると、シンボル補完候補がpopup表示に!

候補リスト作成部分は、slime.elから適当に切り取ってきたので、動きが怪しいです。
なぜか、package名は補完されない…。

2009-12-20

sheepleでディスパッチ

Common Lisp

sheepleはCLOSの総称関数の様なディスパッチ機構を持っています。

まず、「メッセージ」を定義し、「メッセージ」への各オブジェクトの「応答(reply)」を定義していきます。
「メッセージ」がCLOSの総称関数、「応答」がCLOSのメソッドにあたります。

(defmessage test (obj))
(defvar *obj1* (object))

(defreply test ((obj *obj1*))
  (write "*obj1*"))

(test *obj1*)
;; -> "*obj1*"
;; => nil

CLOSと明に違うのは、sheepleにはクラスがないため、「応答」の特定がオブジェクトに対して行なわれるところでしょうか?
ただし、「応答」の特定がオブジェクのみだと不便であるため、parentsで指定したオブジェクトに特定された「応答」も選択されます。

(defvar *obj2* (object :parents (list *obj1*)))

(test *obj2*)
;; -> "*obj1*"
;; => nil

CLのオブジェクトのプロトタイプも用意されていて、「応答」の特定の際に指定できます。

(defmessage add (a b))

(defreply add ((a =number=) (b =number=))
  (+ a b))

(add 10 20)
;; => 30

(defreply add ((a =string=) (b =string=))
  (concatenate 'string a b))

(add "hoge" "huga")
;; => "hogehuga"

最後に、fibをsheepleで書いてみます。

(defmessage fib (n))
(defreply fib ((n 0))
  1)
(defreply fib ((n 1))
  1)
(defreply fib (n)
  (+ (fib (- n 1)) (fib (- n 2))))

既に分かっている応答については、defmessageで定義できるみたいです。

(defmessage fib (n)
  (:reply ((n 0)) 1)
  (:reply ((n 1)) 1)
  (:reply (n) (+ (fib (- n 1)) (fib (- n 2)))))