# HG changeset patch # User Steve Losh # Date 1517690687 18000 # Node ID af9390b6947b05a8026493edcb5fed58fd02d2d7 # Parent 9bd6c3377af8b90d4fadb8b39798dea5c2463cb2 Add bit-loom diff -r 9bd6c3377af8 -r af9390b6947b Makefile --- 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 diff -r 9bd6c3377af8 -r af9390b6947b magitek.asd --- 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"))))) diff -r 9bd6c3377af8 -r af9390b6947b package.lisp --- 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 diff -r 9bd6c3377af8 -r af9390b6947b src/main.lisp --- 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)) diff -r 9bd6c3377af8 -r af9390b6947b src/robots/bit-loom.lisp --- /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"))) diff -r 9bd6c3377af8 -r af9390b6947b src/robots/frantic-barista.lisp --- 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)) diff -r 9bd6c3377af8 -r af9390b6947b src/robots/git-commands.lisp --- 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)) diff -r 9bd6c3377af8 -r af9390b6947b src/robots/lisp-talks.lisp --- 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))) diff -r 9bd6c3377af8 -r af9390b6947b src/robots/rpg-shopkeeper.lisp --- 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)) diff -r 9bd6c3377af8 -r af9390b6947b src/twitter.lisp --- 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))