#! /bin/sh

string=? ; exec /home/scheme/Executables/mzscheme -r $0 "$@"

; Time-stamp: <99/07/07 23:00:29 shriram>

; Summary:
; Given a list of US ZIP codes, it generates a map with a pin on
; each ZIP code location.  Note that the process sometimes fails
; because the ZIP code is not in the US Census database.  It may
; also fail because the format of information in the output file
; has changed.
;
; Warnings:
; Due to a bug in the released CGI code (as of 11/98) this refers
; to the version in ~shriram/plt/collects/.  This may not always
; be available, or may be buggy.
;
; Limitation:
; Currently only accepts codes in the contiguous US states.  This
; is easy to extend.
;
; Interface:
; The zip codes must be in a file that, when `read', yields a list
; of strings corresponding to the codes.  Invoke the program as
;   <program name> <zip codes filename> <map output filename>

(current-library-collection-paths
  (cons "/home/shriram/plt/collects"
    (current-library-collection-paths)))

(require-library "url.ss" "net")

(define usage-string "usage: zip-file-name map-file-name")

(define response-regexp (regexp "Location: (.*) (N|S), (.*) (E|W)"))

(define tmp-specfile-name "tmp-coordinates")

(define base-finder-url
  "http://www.census.gov/cgi-bin/gazetteer-tbl?city=&state=&zip=")

;; zip-finder-url : str[zip] -> url

(define (zip-finder-url zip)
  (string->url (string-append base-finder-url zip)))

(define base-map-url "http://bluefs.census.gov/cgi-bin/mapper/map.gif?lat=37&lon=-96&wid=50&ht=24&iht=230&iwd=400&murl=http://www.cs.rice.edu/CS/PLT/Teaching/Workshops/1999/Scheme/Map/")

;; map-maker-url : str -> url

(define (map-maker-url specfile)
  (string->url (string-append base-map-url specfile)))

;; remove-file/no-error : str -> ()

(define (remove-file/no-error f)
  (with-handlers ((void void))
    (delete-file f)))

;; get-lat/lon : str[zip] -> num[lat] x ("N" + "S") x num[lon] x ("E" + "W")

(define (get-lat/lon zip)
  (call/input-url (zip-finder-url zip) get-pure-port
    (lambda (in)
      (let loop ()
	(let ((l (read-line in)))
	  (if (eof-object? l)
	    (error 'coordinates "Cannot parse response for ~a" zip)
	    (let ((m (regexp-match response-regexp l)))
	      (if m
		(apply values (cdr m))
		(loop)))))))))

;; generate-coord-file : str x list(str[zip]) -> ()

(define (generate-coord-file filename zips)
  (let ((o (open-output-file filename)))
    (printf "Downloading ZIP codes: ") (flush-output)
    (fprintf o "#tms-marker~n")
    (map (lambda (zip)
	   (let-values (((lat lat-direction lon lon-direction)
			  (get-lat/lon zip)))
	     (display "@") (flush-output)
	     (fprintf o "~a~a,~a~a:reddot7~n"
	       (if (string=? lon-direction "W") "-" "")
	       lon
	       (if (string=? lat-direction "S") "-" "")
	       lat)))
      zips)
    (newline) (flush-output)
    (close-output-port o)))

;; generate-map : str x url -> ()

(define (generate-map outfile-name map-url)
  (let ((o (open-output-file outfile-name)))
    (call/input-url map-url get-pure-port
      (lambda (p)
	(printf "Downloading map: ") (flush-output)
	(let loop ((n 1))
	  (let ((c (read-char p)))
	    (unless (eof-object? c)
	      (when (zero? (remainder n 1000))
		(display "#") (flush-output))
	      (display c o)
	      (loop (add1 n)))))
	(newline) (flush-output)))
    (close-output-port o)))

(case (vector-length argv)
  ((2) (let ((zips-file (vector-ref argv 0)) (map-file (vector-ref argv 1)))
	 (remove-file/no-error tmp-specfile-name)
	 (generate-coord-file tmp-specfile-name
	   (read (open-input-file zips-file)))
	 (remove-file/no-error map-file)
	 (generate-map map-file (map-maker-url tmp-specfile-name))
	 (exit 0)))
  (else (fprintf (current-error-port) usage-string)
    (newline (current-error-port))
    (exit 1)))