af9390b6947b

Add bit-loom
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 03 Feb 2018 15:44:47 -0500
parents 9bd6c3377af8
children 26d560b85b8a
branches/tags (none)
files Makefile magitek.asd package.lisp src/main.lisp src/robots/bit-loom.lisp src/robots/frantic-barista.lisp src/robots/git-commands.lisp src/robots/lisp-talks.lisp src/robots/rpg-shopkeeper.lisp src/twitter.lisp

Changes

--- a/Makefile	Sat Feb 03 14:53:48 2018 -0500
+++ b/Makefile	Sat Feb 03 15:44:47 2018 -0500
@@ -25,6 +25,7 @@
 	hg -R /home/sjl/lib/cl-losh     -v pull -u
 	hg -R /home/sjl/lib/chancery    -v pull -u
 	hg -R /home/sjl/lib/trivial-ppm -v pull -u
+	hg -R /home/sjl/lib/flax        -v pull -u
 
 # Local
 deploy: binary
--- a/magitek.asd	Sat Feb 03 14:53:48 2018 -0500
+++ b/magitek.asd	Sat Feb 03 15:44:47 2018 -0500
@@ -12,6 +12,7 @@
                :chirp
                :fare-quasiquote
                :fare-quasiquote-readtable
+               :flax
                :iterate
                :losh
                :named-readtables
@@ -42,6 +43,7 @@
                              (:module "robots"
                               :components ((:file "git-commands")
                                            (:file "lisp-talks")
+                                           (:file "bit-loom")
                                            (:file "frantic-barista")
                                            (:file "rpg-shopkeeper")))
                              (:file "main")))))
--- a/package.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/package.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -43,13 +43,20 @@
     :generate-heightmap))
 
 
+(defpackage :magitek.robots.bit-loom
+  (:use
+    :cl
+    :losh
+    :magitek.quickutils)
+  (:export :random-tweet))
+
 (defpackage :magitek.robots.git-commands
   (:use
     :cl
     :losh
     :chancery
     :magitek.quickutils)
-  (:export :random-string))
+  (:export :random-tweet))
 
 (defpackage :magitek.robots.lisp-talks
   (:use
@@ -57,7 +64,7 @@
     :losh
     :chancery
     :magitek.quickutils)
-  (:export :random-string))
+  (:export :random-tweet))
 
 (defpackage :magitek.robots.rpg-shopkeeper
   (:use
@@ -65,7 +72,7 @@
     :losh
     :chancery
     :magitek.quickutils)
-  (:export :random-string))
+  (:export :random-tweet))
 
 (defpackage :magitek.robots.frantic-barista
   (:use
@@ -73,7 +80,7 @@
     :losh
     :chancery
     :magitek.quickutils)
-  (:export :random-string))
+  (:export :random-tweet))
 
 
 (defpackage :magitek
--- a/src/main.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/main.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -12,33 +12,39 @@
 
 (defparameter *git-commands*
   (make-bot :git-commands
-            #'magitek.robots.git-commands:random-string
+            #'magitek.robots.git-commands:random-tweet
             12))
 
 (defparameter *lisp-talks*
   (make-bot :lisp-talks
-            #'magitek.robots.lisp-talks:random-string
+            #'magitek.robots.lisp-talks:random-tweet
             12))
 
 (defparameter *rpg-shopkeeper*
   (make-bot :rpg-shopkeeper
-            #'magitek.robots.rpg-shopkeeper:random-string 
+            #'magitek.robots.rpg-shopkeeper:random-tweet 
             12))
 
 (defparameter *frantic-barista*
   (make-bot :frantic-barista
-            #'magitek.robots.frantic-barista:random-string
+            #'magitek.robots.frantic-barista:random-tweet
             6))
 
+(defparameter *bit-loom*
+  (make-bot :bit-loom
+            #'magitek.robots.bit-loom:random-tweet
+            5))
+
 
 (defun hours-to-minutes (h)
   (* h 60))
 
 
 (defun generate-tweet (generator)
-  (iterate
-    (repeat 100)
-    (finding (funcall generator) :such-that #'tt-tweetable-p)))
+  (do-repeat 100
+    (multiple-value-bind (text media) (funcall generator)
+      (when (tt-tweetable-p text)
+        (return (values text media))))))
 
 
 (defun run-bot (bot &key (force nil) (dry t))
@@ -46,16 +52,16 @@
     (format t "Running ~S~%" name)
     (when (or force
               (not (db-tweeted-since-p name (hours-to-minutes hours))))
-      (let ((tweet (generate-tweet generator)))
+      (multiple-value-bind (tweet media) (generate-tweet generator)
         (if (null tweet)
           (format t "Could not generate a suitable tweet for ~S~%" name)
           (progn
-            (format t "Tweeting as ~S: ~S~%" name tweet)
+            (format t "Tweeting as ~S (media ~S): ~S~%" name media tweet)
             (db-insert-tweet name tweet)
             (if dry
               (format t "Skipping actual tweet (dry run).")
               (progn
-                (tt-tweet name tweet)
+                (tt-tweet name tweet media)
                 (sleep 5.0)))))))))
 
 
@@ -70,4 +76,5 @@
   (run-bot *frantic-barista* :dry nil)
   (run-bot *git-commands* :dry nil)
   (run-bot *lisp-talks* :dry nil)
-  (run-bot *rpg-shopkeeper* :dry nil))
+  (run-bot *rpg-shopkeeper* :dry nil)
+  (run-bot *bit-loom* :dry nil))
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/robots/bit-loom.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -0,0 +1,24 @@
+(in-package :magitek.robots.bit-loom)
+
+(defun pnm-to-png (pnm png)
+  (sb-ext:run-program "pnmtopng" (list pnm)
+                      :search t
+                      :output png
+                      :if-output-exists :supersede)
+  (sb-ext:run-program "mogrify" (list "-resize" "800x800" png)
+                      :search t))
+
+(defun loom-1 (seed)
+  (let ((depth (random-range-inclusive 16 19)))
+    (flax.looms.001-triangles:loom seed depth "out.pnm" 3000 3000)
+    `(depth ,depth)))
+
+(defun generate-image (seed)
+  (prog1 (loom-1 seed)
+    (pnm-to-png "out.pnm" "out.png")))
+
+(defun random-tweet ()
+  (let* ((seed (random (expt 2 32)))
+         (parameters (append `(seed ,seed) (generate-image seed))))
+    (values (string-upcase (format nil "Loom ~R, ~{~A ~A~^, ~}" 1 parameters))
+            "out.png")))
--- a/src/robots/frantic-barista.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/robots/frantic-barista.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -121,6 +121,6 @@
 
 
 ;;;; API ----------------------------------------------------------------------
-(defun random-string ()
+(defun random-tweet ()
   (order))
 
--- a/src/robots/git-commands.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/robots/git-commands.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -218,6 +218,6 @@
 
 
 ;;;; API ----------------------------------------------------------------------
-(defun random-string ()
+(defun random-tweet ()
   (entry))
 
--- a/src/robots/lisp-talks.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/robots/lisp-talks.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -209,6 +209,6 @@
 
 
 ;;;; API ----------------------------------------------------------------------
-(defun random-string ()
+(defun random-tweet ()
   (cap (talk)))
 
--- a/src/robots/rpg-shopkeeper.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/robots/rpg-shopkeeper.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -535,7 +535,7 @@
 
 
 ;;;; API ----------------------------------------------------------------------
-(defun random-string ()
+(defun random-tweet ()
   (offer))
 
 
--- a/src/twitter.lisp	Sat Feb 03 14:53:48 2018 -0500
+++ b/src/twitter.lisp	Sat Feb 03 15:44:47 2018 -0500
@@ -47,10 +47,12 @@
   (load "creds.lisp")
   (load-accounts))
 
-(defun tt-tweet (account text)
+(defun tt-tweet (account text media)
   (with-account account
-    (chirp:tweet text)))
+    (if media
+      (chirp:tweet text :file (pathname media))
+      (chirp:tweet text))))
 
 (defun tt-tweetable-p (text)
-  (< 30 (length text) 138))
+  (< 5 (length text) 260))