DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

NewLISP Code To Fetch Flickr Interesting Photos And Display On Screen Via TK

09.07.2006
| 4196 views |
  • submit to reddit
        // simple newLISP code to fetch interesting pictures from
// flickr and display on the monitor using TK

(set 'api "/services/rest")
(set 'apikey "YOUR-OWN-KEY-HERE")
(set 'host "http://flickr.com")
(set 'email "")
(set 'password "")

(define (doget method auth params)
  (setq url (append host api "/?api_key=" apikey "&method=" method))
  (if (list? params) 
   (setq url (append url "&" (urlencode params))))
  (if (not (nil? auth)) 
   (setq url (append url "&email=" email "&password=" password)))
  (setq xmldata (get-url url)))


(define (urlencode params)
  (setq urlstring "")
  (dolist (param1 params) 
   (if (not (= urlstring "")) 
    (setq urlstring (append urlstring "&"))) 
   (setq urlstring (append urlstring (nth 0 param1) "=" (nth 1 param1)))))

(define (xmlconvert data)
  (xml-type-tags nil nil nil nil)
  (setq sxmldata (xml-parse data (+ 1 2 4 8 16))))
  
(define (getphotos data)
  (if (ref 'photo sxmldata) 
   (setq photolist (slice (data (chop (ref 'photo data) 2)) 2 -1)) 
   (setq photolist '())))

(define (handlephotos sxmldata)
  (dolist (aphoto (getphotos sxmldata)) 
   (setq pr (first (rest aphoto))) 
   (print (format "http://static.flickr.com/%s/%s_%s_o.jpg" (lookup 
      'server pr) 
     (lookup 'id pr) 
     (lookup 'secret pr)))))

(define (fiv)
  (tk "package require Img")
  (tk "destroy .fivwin")
  (tk "toplevel  .fivwin")
  
  (tk "wm geometry .fivwin [winfo screenwidth .]x[winfo screenheight .]+0+0")
  
  ;; uncomment the following lines to make display "fullscreen"
  ;;(tk "bind .fivwin <Key> {destroy .fivwin}")
  ;;(tk "bind .fivwin <Motion> {destroy .fivwin}")
  ;;(tk "bind .fivwin <Button> {destroy .fivwin}")
  ;;(tk "wm overrideredirect .fivwin yes; focus -force .fivwin")

  (setq picture (tk "image create photo "))
  (tk (append "label .fivwin.picture  -image " picture))
  (tk "pack .fivwin.picture")

  (setq xmldata
            (doget "flickr.interestingness.getList" nil  
             '(("per_page" "100")("page" "1"))))		;; how many per page , from which page
  (setq sxmldata (xmlconvert xmldata))
  
  (if (ref 'photo sxmldata) 
   (setq photolist (slice (sxmldata (chop (ref 'photo sxmldata) 2)) 2 -1)) 
   (exit))
   
  (dolist (aphoto photolist)
  	(if (= "0" (tk "winfo exists .fivwin"))
  		(exit))
    (setq photodesc (first (rest aphoto)))
    (setq photourl (format "http://static.flickr.com/%s/%s_%s_o.jpg" 
                            (lookup 'server photodesc)
                            (lookup 'id photodesc)
                            (lookup 'secret photodesc)))
    (tk "update idletasks")

    (setq file (last (parse photourl "/")))
    (write-file file (get-url photourl))
    (tk (append picture " configure -file " file))
     (delete-file file)))