#lang scheme/gui

(require net/url xml htdp/error)

(provide
 ;; Zoom in [0,21]
 zoom? ;; Any -> Boolean: Zoom 
 ;; is this value a zoom

 ;; Latitudes in [-90,90] 
 latitude? ;; Any -> Boolean : Latitude
 ;; is this value a Latitude

 ;; Longitude in [-180,180]
 longitude? ;; Any -> Boolean : Longitude
 ;; is this value a Longitude

 geo-code ;; String String String String String -> Xexpr
 ;; retrieve the Geocode informaiton for this address
 ;; effect: read from and write to the Yahoo geocode service
 
 map-image ;; Latitude Longitude Zoom -> Image 
 ;; retrieve the map for this location on Earth (lati,long) at zoom level z
 ;; effect: read from and write to the Google map service 
 )

(define (geo-code street city state zip country) 
  (define _1 (check-arg 'geo-code (string? street) "string" "first" street))
  (define _2 (check-arg 'geo-code (string? city) "string" "second" city))
  (define _3 (check-arg 'geo-code (string? state) "string" "third" state))
  (define _4 (check-arg 'geo-code (string? zip) "string" "fourth" zip))
  (define _5 (check-arg 'geo-code (string? country) "string" "fifth" country))
  (define url (addr->geocode-url-request-string street city state zip country))
  (send-request-xml url))

(define (map-image lat lon z) 
  (define _1 (check-arg 'map-image (latitude? lat) "Latitude" "first" lat))
  (define _2 (check-arg 'map-image (longitude? lon) "Longitude" "second" lon))
  (define _3 (check-arg 'map-image (zoom? z) "Zoom" "third" z))
  (define url (gaddr->google-map-url-request-string lat lon z))
  (send-request-png url))

(define (zoom? n)
  (and (number? n) (real? n) (<= 0 n 21)))

(define (latitude? n)
  (and (number? n) (real? n) (<= -90 n 90)))

(define (longitude? n)
  (and (number? n) (real? n) (<= -180 n 180)))

;; -----------------------------------------------------------------------------
;; constants 

(define SIZE 256)

(define app-id 
  "K_yfu_7V34GWzG4r24zyBlXPZfyQnTdHoYGSsLiQNNjyBeQn8PfJJUfWIg_XW9AAQA--")

(define google-app-id 
  "ABQIAAAAFMdr_8x0lQ70VcpoX_MiNhR3sNyu81uADQSfAQcCn-oWiRRvxxSLtFCMuSuI39fFqZUtQmbbtoFTnQ")

(define geocode-request-url 
  (string-append "http://local.yahooapis.com/MapsService/V1/geocode?appid=" app-id))

(define map-request-url
  (string-append "http://local.yahooapis.com/MapsService/V1/mapImage?appid=" app-id))

(define google-map-request-url
  (string-append "http://maps.google.com/maps/api/staticmap?key=" google-app-id))

(define-struct addr (street city state zip country))


;; -----------------------------------------------------------------------------
;; String String String String String -> String 
;; return a geocode url request string for the given address
(define (addr->geocode-url-request-string street city state zip country)
  (string-append geocode-request-url
                 (key-val->string "street"    street)
                 (key-val->string "city"      city)
                 (key-val->string "state"     state)
                 (key-val->string "zip"       zip)
                 (key-val->string "country"   country)))

;; -----------------------------------------------------------------------------
;; Latitude Longitude Zoom -> String
;; return a map-image url request string for the given address to google
(define (gaddr->google-map-url-request-string latitude longitude zoom)
  (define lat (number->string (exact->inexact latitude)))
  (define lon (number->string (exact->inexact longitude)))
  (string-append google-map-request-url
                 (key-val->string "center" (string-append lat "," lon))
                 (key-val->string "zoom" (number->string zoom))
                 (key-val->string "size" (format "~ax~a" SIZE SIZE))
		 ;; the size of google tiles
                 (key-val->string "sensor" "false")))

;; -----------------------------------------------------------------------------
;; String String [String] -> String
;; return string in format "{delim}{key}={val}" if val is not "empty"
(define (key-val->string key val (delim "&"))
  (if (number? val)
      (string-append delim key "=" (number->string val))
      (if (and (string? val) (not (string=? val "")))
          (string-append delim key "=" val)
          "")))

;; -----------------------------------------------------------------------------
;; String -> Xexpr
;; Consumes a request url and returns the xml response of it as an xexpr
;; [fixme] should catch exceptions
(define (send-request-xml req-url)
  (xml->xexpr (document-element (read-xml (send-request-port req-url)))))

;; -----------------------------------------------------------------------------
;; String -> Image
;; Consumes a request url and returns the png file it should point to
(define (send-request-png req-url)
  (load-image-from-port (send-request-port req-url))
  #;
  (load-image-from-port.v2 (send-request-port req-url)))

;; String -> InputPort
;; Consumes a request url and returns a pure port of the response
(define (send-request-port req-url)
  (get-pure-port (string->url req-url)))

;; -----------------------------------------------------------------------------
;; InputPort -> Image 
;; retrieve a PNG image from an input port
;; NOTE: 
;; [HACK HACK HACK !! !! !! This should go away in mred2]
;; first we write the image to disk, then load it with image-snip%
(define (load-image-from-port port)
  (define file (make-temporary-file))
  ;; -- in -- 
  (call-with-output-file file
    (lambda (out)
      (let loop ((b (read-byte port)))
        (unless (eof-object? b)
          (write-byte b out)
          (loop (read-byte port)))))
    #:mode 'binary
    #:exists 'replace)
  ;; --- in ---
  (begin0 
    (make-object image-snip% file)
    (delete-file file)))

;; this is almost right 
(define (load-image-from-port.v2 port)
  (define img:bytes
    (list->bytes 
     (let loop ((b (read-byte port)))
       (if (eof-object? b)
           '()
           (cons b (loop (read-byte port)))))))
  ;; of course you can't hope to decode the PNG format from raw bytes
  (define img:bitmap
    (make-object bitmap% img:bytes 256 256))
  ;; --- in ---
  (unless (send img:bitmap ok?) 
    (error 'map-image "unable to produce image from response"))
  (make-object image-snip% img:bitmap))