Never been to DZone Snippets before?

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

newLISP code to fetch flickr interesting photos and display on screen via TK (See related posts)

// 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)))
 

You need to create an account or log in to post comments to this site.


Click here to browse all 4858 code snippets

Related Posts