#reader(lib "htdp-beginner-reader.ss" "lang")((modname grocery-shopper) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(define WIDTH 320)
(define HEIGHT 480)
(define-struct loc (lat long))
(define-struct place (name loc radius))
(define-struct item (place-name identifier))
(define ALL-ITEMS
(list (make-item "Stop and Shop" "Soap")
(make-item "Boynton" "Pizza")))
(define initial-world
(make-loc 0 0))
(define (update-location w lat long)
(make-loc lat long))
(define (filter-matching-items a-place items)
(cond
[(empty? items)
empty]
[(string=? (place-name a-place)
(item-place-name (first items)))
(cons (first items)
(filter-matching-items a-place (rest items)))]
[else
(filter-matching-items a-place (rest items))]))
(define (places-matching-items places)
(cond
[(empty? places)
empty]
[else
(append (filter-matching-items (first places) ALL-ITEMS)
(places-matching-items (rest places)))]))
(define (nearby-matching-items w)
(places-matching-items (find-places ALL-PLACES w)))
(define (find-places places a-loc)
(cond
[(empty? places)
empty]
[(place-matches? (first places) a-loc)
(cons (first places) (find-places (rest places) a-loc))]
[else
(find-places (rest places) a-loc)]))
(define (place-matches? a-place a-loc)
(<= (location-distance (loc-lat a-loc)
(loc-long a-loc)
(loc-lat (place-loc a-place))
(loc-long (place-loc a-place)))
(place-radius a-place)))
(define (description w)
(items->string (nearby-matching-items w)))
(define (items->string items)
(cond
[(empty? items)
""]
[else
(string-append
(item->string (first items))
(cond [(empty? (rest items)) ""] [else ", "])
(items->string (rest items)))]))
(define (item->string an-item)
(string-append "["
(item-place-name an-item)
": "
(item-identifier an-item)
"]"))
(define (render w)
(place-image
(text (description w) 10 "black")
20
20
(empty-scene WIDTH HEIGHT)))
(define (parse-places xexpr)
(parse-items
(find-children 'item
(children (first (find-children 'channel (children xexpr)))))))
(define (parse-items xexprs)
(cond
[(empty? xexprs)
empty]
[else
(cons (parse-item (first xexprs))
(parse-items (rest xexprs)))]))
(define (parse-item xexpr)
(make-place (get-text (first (find-children 'title (children xexpr))))
(parse-georss:point (first (find-children 'georss:point (children xexpr))))
100))
(define (parse-georss:point xexpr)
(make-loc (string->number (first (split-whitespace (get-text xexpr))))
(string->number (second (split-whitespace (get-text xexpr))))))
(define (children an-xexpr)
(cond
[(string? an-xexpr)
(error 'children "Can't have children of a string xexpr")]
[else
(rest (rest an-xexpr))]))
(define (attrs an-xexpr)
(cond
[(string? an-xexpr)
(error 'attrs "Can't get attributes of a string xexpr")]
[else
(second an-xexpr)]))
(define (get-text an-xexpr)
(cond
[(string? an-xexpr)
an-xexpr]
[(pair? an-xexpr)
(get-text* (children an-xexpr))]))
(define (get-text* xexprs)
(cond
[(empty? xexprs)
""]
[else
(string-append (get-text (first xexprs))
(get-text* (rest xexprs)))]))
(define (find-children name children)
(cond [(empty? children)
empty]
[else
(cond [(string? (first children))
(find-children name (rest children))]
[(pair? (first children))
(cond
[(symbol=? name (first (first children)))
(cons (first children)
(find-children name (rest children)))]
[else
(find-children name (rest children))])]
[else
(error 'find-children children)])]))
(define mymaps-url
(string-append "http://maps.google.com/maps/ms?ie=UTF8&hl=en&vps=1&jsv=151e&msa=0&output=georss&msid="
"106933521686950086948.00046579f4b482756abc5"))
(define ALL-PLACES
(parse-places (xml->s-exp (get-url mymaps-url))))
(define tick-delay 10)
(big-bang WIDTH HEIGHT initial-world
(on-redraw render)
(on-location-change update-location))