;; $Id: zip-util.cl,v 1.3 2007/01/11 01:07:39 layer Exp $
;;
;; This software is Copyright (c) Kevin Layer, 2006-2007.
;; You are granted the rights to distribute
;; and use this software as governed by the terms
;; of the Lisp Lesser GNU Public License
;; (http://opensource.franz.com/preamble.html),
;; known as the LLGPL.

;; This file contains utilities used only at compile time.

(eval-when (compile)
  (load (merge-pathnames "zip-package.fasl" *compile-file-pathname*)))

(in-package :util.zipcodes)

(defun read-zips-csv (csv-file)
  ;; Read the CSV file CSV-FILE which contains zip code data.  Return a
  ;; vector of `zip' structs, sorted by longitude then latitude.
  (flet ((string-to-number (string)
	   ;; Can't use parse-integer because these are floats.
	   (or (ignore-errors (read-from-string string))
	       (error "bad number: ~a." string))))
    (with-open-file (s csv-file)
      (let (line zips (nzips 0))
	(setq line (read-line s nil s))
	(when (eq line s) (error "bad zips file"))
	(loop
	  (setq line (read-line s nil s))
	  (when (eq line s) (return))
	  (destructuring-bind (zip state-abbrev lat lon city state)
	      (mapcar #'read-from-string (delimited-string-to-list line #\,))
	    (incf nzips)
	    (push (make-zip :code zip
			    :state-abbrev state-abbrev
			    :location (make-location
				       :latitude (string-to-number lat)
				       :longitude (string-to-number lon))
			    :city (if* (= 0 (length city))
				     then nil
				     else city)
			    :state state)
		  zips)))
	(setq zips (make-array nzips :initial-contents zips))

	;; Sort on longitude, then latitude
	(sort zips
	      (lambda (z1 z2)
		(if* (= (location-longitude (zip-location z1))
			(location-longitude (zip-location z2)))
		   then (< (location-latitude (zip-location z1))
			   (location-latitude (zip-location z2)))
		   else (< (location-longitude (zip-location z1))
			   (location-longitude (zip-location z2))))))))))

(defun vector-of (vector function)
  ;; Return a vector based on the contents of VECTOR created by calling
  ;; FUNCTION on each element of VECTOR.
  (let* ((len (length vector))
	 (res (make-array (length vector))))
    (dotimes (i len)
      (setf (svref res i) (funcall function (svref vector i))))
    res))
