Parse a GPX file with Gauche scheme

gpxparse.scm

#!/usr/bin/env gosh

(use srfi-1)  ;; List library
(use srfi-13) ;; String library
(use srfi-19) ;; Date/time

(use sxml.ssax)

(define (make-tpt)
  (list 0 0 0 0))

(define the-track ())

(define (track-time pt)
  (~ pt 3))
(define (track-lat pt)
  (~ pt 0))
(define (track-lon pt)
  (~ pt 1))
(define (track-ele pt)
  (~ pt 2))

(define (set-time tpt tm)
  (set! (~ tpt 3) tm))

(define (set-lat tpt val)
  (set! (~ tpt 0) val))

(define (set-lon tpt val)
  (set! (~ tpt 1) val))

(define (set-ele tpt val)
  (set! (~ tpt 2) val))

(define cur-pt (make-tpt))

(define (show-track trk)
  (for-each
   (lambda (pt)
     (display (format #f
                      "\t~a: (~a, ~a, ~a)\n"
                      (track-time pt)
                      (track-lat pt)
                      (track-lon pt)
                      (track-ele pt))))
   trk))

(define start-tag-handlers
  (list
   (cons 'trkpt
         (lambda (atts)
           (let ((lat-val (cdr (assoc 'lat atts)))
                 (lon-val (cdr (assoc 'lon atts))))
             (set! cur-pt (make-tpt))
             (set-lat cur-pt lat-val)
             (set-lon cur-pt lon-val)
             (format #f " ~a ~a"  lat-val lon-val))))))

(define text-handlers
  (list
   (cons 'time
         (lambda (str)
           (set-time cur-pt (time->seconds (date->time-utc (string->date (string-trim-both str) "~Y-~m-~dT~H:~M:~SZ"))))))

   (cons 'ele
         (lambda (str)
           (set-ele cur-pt (string->number (string-trim-both str)))))))

(define end-tag-handlers
  (list

   (cons 'gpx
         (lambda (val)
           (display (format #f "The GPX file has ~a points\n" (length the-track)))
           (show-track the-track)
           ))

   (cons 'trkpt
         (lambda (val)
           (set! the-track (append! the-track (list cur-pt)))))))

(define (extract-tag elem-gi)
  (if (pair? elem-gi) (cdr elem-gi) elem-gi))

;; Return the appropriate handler, or an empty function
(define (exec-tag elem-gi handlers)
  (let ((tag (extract-tag elem-gi)))
    (if (assoc tag handlers)
        (cdr (assoc tag handlers))
        (lambda (val) ()))))

(define (outline xml-port)
  ((ssax:make-parser
      NEW-LEVEL-SEED
      (lambda (elem-gi attrs namespaces expected-content seed)
        ((exec-tag elem-gi start-tag-handlers) attrs)
        ;; Return the tag as the seed for parent elements
        (extract-tag elem-gi))

      FINISH-ELEMENT
      (lambda (elem-gi attributes namespaces parent-seed seed)
        ((exec-tag elem-gi end-tag-handlers) ())
          parent-seed)

      CHAR-DATA-HANDLER
      (lambda (s1 s2 seed)
        ((exec-tag seed text-handlers) s1)
        seed)

      ) xml-port ""))

(define (main args)
  (display (call-with-input-file (cadr args) outline)))