Tumblr random posts

chatikbot.asd

@@ -21,6 +21,7 @@
                (:file "forecast")
                (:file "vk")
                (:file "finance")
+               (:file "tumblr")
                (:file "patmatch")
                (:file "eliza")
                (:file "chatikbot")))

eliza.lisp

@@ -24,7 +24,9 @@
      (в жопу себе его засунь) (хуюровень) ,@*fuck-off*)
     (((?* ?a) (?is ?x ,(lambda (i) (search "ХАХА" (symbol-name i)))) (?* ?b))
      (очень смешно) (клоунов тут нашел?) (посмейся мне еще) ,@*fuck-off*)
-    (((?* ?a) (?or ты бот) (?* ?x))
+    (((?* ?a) (?or сиськи титьки буфера tits) (?* ?b))
+     (#'tumblr-random-photo))
+    (((?* ?a) (?or ты бот ботяра) (?* ?x))
      (сам ?x) (сам ты ?x) (а по ебалу?) (сейчас мы разберемся кто еще тут ?x) ,@*fuck-off*)
     (((?* x))
      (:text . "И чё?")
@@ -56,18 +58,6 @@
 (defun print-with-spaces (list)
   (format nil "~@(~{~a~^ ~}~)" list))
 
-(defun mappend (fn &rest lists)
-  "Apply fn to each element of lists and append the results."
-  (apply #'append (apply #'mapcar fn lists)))
-
-(defun random-elt (choices)
-  "Choose an element from a list at random."
-  (elt choices (random (length choices))))
-
-(defun flatten (the-list)
-  "Append together elements (or lists) in the list."
-  (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))
-
 (defun switch-viewpoint (words)
   "Change I to you and vice versa, and so on."
   (sublis '((I . you) (you . I) (me . you) (am . are)
@@ -82,11 +72,13 @@
                                              (random-elt responses)))))
 
 (defun eliza (input)
-  (let ((response (use-eliza-rules
-                   (read-from-string-no-punct input))))
-    (when response
-      (if (keywordp (first response))
-          response
-          (print-with-spaces (flatten response))))))
+  (let ((r (use-eliza-rules
+            (read-from-string-no-punct input))))
+    (cond
+      ((null r))
+      ((and (consp (car r)) (eq 'function (caar r)))
+       (apply (cadar r) (cdr r)))
+      ((keywordp (car r)) r)
+      (t (print-with-spaces (flatten r))))))
 
 

tumblr.lisp

@@ -0,0 +1,33 @@
+(in-package :chatikbot)
+
+(defvar *tumblr-roll* nil "List of tumblr to select from")
+(defparameter *read-timeout* 5 "API request timeout")
+
+(defun lo-string (val)
+  (string-downcase (princ-to-string val)))
+
+(defun tumblr-read (domain &rest args)
+  (handler-case
+      (let ((params (loop for (k v) on args by #'cddr
+                       when v collect (cons (lo-string k) (lo-string v)))))
+        (yason:parse
+         (subseq (flexi-streams:octets-to-string
+                  (bordeaux-threads:with-timeout (*read-timeout*)
+                    (drakma:http-request
+                     (format nil "~A/api/read/json" domain)
+                     :parameters params
+                     :force-binary t))
+                  :external-format :utf-8) 22)
+         :object-as :alist))
+    (bordeaux-threads:timeout (e) (error e))))
+
+(defun tumblr-random-post (&key (roll *tumblr-roll*) type)
+  (when roll
+    (let* ((domain (random-elt roll))
+           (total (aget "posts-total" (tumblr-read domain :num 1 :type type)))
+           (res (tumblr-read domain :num 1 :type type :start (random total))))
+      (aget "photo-url-1280"
+            (first (aget "posts" res))))))
+
+(defun tumblr-random-photo (&optional (roll *tumblr-roll*))
+  (tumblr-random-post :roll roll :type :photo))

utils.lisp

@@ -41,3 +41,16 @@ is replaced with replacement."
 
 (defmacro aget (key alist)
   `(cdr (assoc ,key ,alist :test #'equal)))
+
+(defun mappend (fn &rest lists)
+  "Apply fn to each element of lists and append the results."
+  (apply #'append (apply #'mapcar fn lists)))
+
+(defun random-elt (choices)
+  "Choose an element from a list at random."
+  (elt choices (random (length choices))))
+
+(defun flatten (the-list)
+  "Append together elements (or lists) in the list."
+  (mappend #'(lambda (x) (if (listp x) (flatten x) (list x))) the-list))
+