bc8ed2a9b4c0

Start cleaning this repo up
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 26 Jan 2018 21:27:01 -0500
parents ddd06eaac1cb
children 6eccaf72df12
branches/tags (none)
files .hgignore package.lisp sand.asd src/ascii.lisp src/color-difference.lisp src/generic-arithmetic.lisp src/graphs.lisp src/graphviz.lisp src/istruct.lisp src/mandelbrot.lisp src/names.lisp src/number-letters.lisp src/qud.lisp src/random-numbers.lisp src/sorting.lisp src/turing-omnibus/minimax.lisp src/turing-omnibus/monte-carlo.lisp src/turing-omnibus/wallpaper.lisp src/urn.lisp src/utils.lisp

Changes

--- a/.hgignore	Thu Sep 07 15:25:54 2017 -0400
+++ b/.hgignore	Fri Jan 26 21:27:01 2018 -0500
@@ -4,3 +4,6 @@
 *.dot
 sand.prof
 qud-items.txt
+*.ppm
+*.pgm
+*.pbm
--- a/package.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/package.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,319 +1,146 @@
-(defpackage :sand.utils
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils)
-  (:export
-    :average4))
-
-(defpackage :sand.random-numbers
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
+;; (defpackage :sand.parenscript
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :sand.quickutils
+;;     :cl-fad
+;;     :parenscript) 
+;;   (:shadowing-import-from :losh
+;;     :%))
 
-(defpackage :sand.generic-arithmetic
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sandalphon.compiler-macro
-    :sand.quickutils
-    :sand.utils)
-  (:shadow
-    :+
-    :-
-    :/
-    :*))
-
-(defpackage :sand.sorting
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
-
-(defpackage :sand.parenscript
-  (:use
-    :cl
-    :losh
-    :sand.quickutils
-    :cl-fad
-    :parenscript) 
-  (:shadowing-import-from :losh
-    :%))
-
-(defpackage :sand.ascii
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
+;; (defpackage :sand.terrain.diamond-square
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils))
 
-(defpackage :sand.terrain.diamond-square
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
-
-(defpackage :sand.dijkstra-maps
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    :dijkstra-map
-    :make-dijkstra-map
-    :dm-maximum-value
-    :dm-map
-    :dm-ref))
-
-(defpackage :sand.graphs
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.dijkstra-maps
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     :dijkstra-map
+;;     :make-dijkstra-map
+;;     :dm-maximum-value
+;;     :dm-map
+;;     :dm-ref))
 
-(defpackage :sand.graphviz
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    :graphviz-digraph))
+;; (defpackage :sand.ropes
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :trivia
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:shadowing-import-from :losh
+;;     :<>)
+;;   (:export
+;;     ))
 
-(defpackage :sand.ropes
-  (:use
-    :cl
-    :losh
-    :iterate
-    :trivia
-    :sand.quickutils
-    :sand.utils)
-  (:shadowing-import-from :losh
-    :<>)
-  (:export
-    ))
-
-(defpackage :sand.hanoi
-  (:use
-    :cl
-    :losh
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.hanoi
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-(defpackage :sand.huffman-trees
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.graphviz
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.streams
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.huffman-trees
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.graphviz
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-#+sbcl
-(defpackage :sand.ffi
-  (:use
-    :cl
-    :losh
-    :iterate
-    :cffi
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.color-difference
-  (:use
-    :cl
-    :losh
-    :iterate
-    :rs-colors
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.number-letters
-  (:use
-    :cl
-    :losh
-    :iterate
-    :function-cache
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.streams
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-(defpackage :sand.urn
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.qud
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.istruct
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; #+sbcl
+;; (defpackage :sand.ffi
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :cffi
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-(defpackage :sand.names
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
-
-(defpackage :sand.surreal-numbers
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.surreal-numbers
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-(defpackage :sand.easing
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.easing
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
-(defpackage :sand.serializing-functions
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    ))
+;; (defpackage :sand.serializing-functions
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     ))
 
 
-(defpackage :sand.sketch
-  (:use
-    :cl
-    :losh
-    :sketch
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:shadowing-import-from :iterate
-    :in)
-  (:shadowing-import-from :sketch
-    :degrees
-    :radians))
+;; (defpackage :sand.sketch
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :sketch
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:shadowing-import-from :iterate
+;;     :in)
+;;   (:shadowing-import-from :sketch
+;;     :degrees
+;;     :radians))
 
-(defpackage :sand.mandelbrot
-  (:use
-    :cl
-    :losh
-    :sketch
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:shadowing-import-from :iterate
-    :in)
-  (:shadowing-import-from :sketch
-    :degrees
-    :radians))
+;; #+sbcl
+;; (defpackage :sand.profiling
+;;   (:use
+;;     :cl
+;;     :losh
+;;     :iterate
+;;     :sand.quickutils
+;;     :sand.utils)
+;;   (:export
+;;     :start-profiling
+;;     :stop-profiling
+;;     :profile))
 
 
-#+sbcl
-(defpackage :sand.profiling
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:export
-    :start-profiling
-    :stop-profiling
-    :profile))
-
-
-(defpackage :sand.turing-omnibus.wallpaper
-  (:use
-    :cl
-    :losh
-    :sketch
-    :iterate
-    :sand.quickutils
-    :sand.utils)
-  (:shadowing-import-from :iterate
-    :in)
-  (:shadowing-import-from :sketch
-    :degrees
-    :radians))
-
-(defpackage :sand.turing-omnibus.monto-carlo
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
-
-(defpackage :sand.turing-omnibus.minimax
-  (:use
-    :cl
-    :losh
-    :iterate
-    :sand.quickutils
-    :sand.utils))
--- a/sand.asd	Thu Sep 07 15:25:54 2017 -0400
+++ b/sand.asd	Fri Jan 26 21:27:01 2018 -0500
@@ -10,32 +10,32 @@
   :depends-on (
 
                #+sbcl :sb-sprof
-               :cffi
-               :cl-algebraic-data-type
-               :cl-charms
-               :cl-fad
-               :cl-ppcre
-               :clss
-               :compiler-macro
-               :cl-conspack
-               :drakma
-               :easing
-               :flexi-streams
-               :function-cache
+               ;; :cffi
+               ;; :cl-algebraic-data-type
+               ;; :cl-charms
+               ;; :cl-fad
+               ;; :cl-ppcre
+               ;; :clss
+               ;; :compiler-macro
+               ;; :cl-conspack
+               ;; :drakma
+               ;; :easing
+               ;; :flexi-streams
+               ;; :function-cache
                :iterate
                :losh
-               :parenscript
-               :parse-float
-               :plump
-               :rs-colors
-               :sanitize
-               :sketch
-               :split-sequence
-               :storable-functions
-               :trivia
-               :trivial-main-thread
-               :vex
-               :yason
+               ;; :parenscript
+               ;; :parse-float
+               ;; :plump
+               ;; :rs-colors
+               ;; :sanitize
+               ;; :sketch
+               ;; :split-sequence
+               ;; :storable-functions
+               ;; :trivia
+               ;; :trivial-main-thread
+               ;; :vex
+               ;; :yason
 
                )
 
@@ -44,42 +44,4 @@
   ((:module "vendor"
     :serial t
     :components ((:file "quickutils")))
-   (:file "package")
-   (:module "src"
-    :serial t
-    :components ((:file "utils")
-                 (:file "graphs")
-                 (:file "graphviz")
-                 (:file "hanoi")
-                 (:file "urn")
-                 (:file "serializing-functions")
-                 (:file "random-numbers")
-                 (:file "generic-arithmetic")
-                 (:file "ropes")
-                 (:file "sorting")
-                 (:file "ascii")
-                 (:file "dijkstra-maps")
-                 #+sbcl (:file "ffi")
-                 #+sbcl (:file "profiling")
-                 (:file "huffman-trees")
-                 (:file "streams")
-                 (:file "color-difference")
-                 #+sbcl (:file "number-letters")
-                 (:module "terrain"
-                  :serial t
-                  :components ((:file "diamond-square")))
-                 (:module "parenscript"
-                  :serial t
-                  :components ((:file "compiler")))
-                 (:file "sketch")
-                 (:file "mandelbrot")
-                 (:file "qud")
-                 (:file "istruct")
-                 (:file "names")
-                 (:file "easing")
-                 (:file "surreal-numbers")
-                 (:module "turing-omnibus"
-                  :serial t
-                  :components ((:file "wallpaper")
-                               (:file "monte-carlo")
-                               (:file "minimax")))))))
+   (:file "package")))
--- a/src/ascii.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-(in-package :sand.ascii)
-
-
-(defparameter *running* nil)
-(defparameter *running* t)
-
-(defparameter *ball* (list :x 0 :y 6 :vx 2))
-(defparameter *width* 1)
-(defparameter *height* 1)
-(defparameter *window-x* 0)
-(defparameter *window-y* 0)
-
-
-(defun render (window)
-  (charms:clear-window window)
-  (charms:move-cursor window
-                      (getf *ball* :x)
-                      (getf *ball* :y))
-  (charms:write-char-at-cursor window #\@)
-  ; (charms:move-cursor window 0 0)
-  )
-
-
-(defun tick ()
-  (incf (getf *ball* :x)
-        (getf *ball* :vx))
-  (when (not (in-range-p 0 (getf *ball* :x) 10))
-    (negatef (getf *ball* :vx))
-    (zapf (getf *ball* :x)
-          (max 0 (min (1- 10) %))))
-  ; (setf (getf *ball* :y) (truncate (/ *height* 2)))
-  )
-
-(defparameter *input* nil)
-(defun handle-input ()
-  (let ((input (charms:get-char charms:*standard-window* :ignore-error t)))
-    (when input
-      (push input *input*))
-    (case input
-      ((nil) nil)
-      (#\h (zapf *window-x* (1- %)))
-      (#\j (zapf *window-y* (1+ %)))
-      (#\k (zapf *window-y* (1- %)))
-      (#\l (zapf *window-x* (1+ %)))
-      (#\q (setf *running* nil)))))
-
-(defun manage-screen ()
-  (multiple-value-bind (w h)
-      (charms:window-dimensions charms:*standard-window*)
-    (setf *width* w *height* h)))
-
-(defun fill-window (window width height ch)
-  (iterate (for-nested ((x :from 0 :below width)
-                        (y :from 0 :below height)))
-           (charms:write-char-at-point window ch x y)))
-
-(defmacro with-window ((symbol width height start-x start-y) &body body)
-  `(let ((,symbol (charms:make-window ,width ,height ,start-x ,start-y)))
-     (unwind-protect (progn ,@body)
-       (charms:destroy-window ,symbol))))
-
-(defmacro with-panel ((symbol window) &body body)
-  `(let ((,symbol (charms:make-panel ,window)))
-     (unwind-protect (progn ,@body)
-       (charms:destroy-panel ,symbol))))
-
-(defmacro with-windows (bindings &body body)
-  (if (null bindings)
-    `(progn ,@body)
-    `(with-window ,(first bindings)
-       (with-windows ,(rest bindings)
-         ,@body))))
-
-(defmacro with-panels (bindings &body body)
-  (if (null bindings)
-    `(progn ,@body)
-    `(with-panel ,(first bindings)
-       (with-panels ,(rest bindings)
-         ,@body))))
-
-
-; (defun run ()
-;   (setf *running* t)
-;   (charms:with-curses ()
-;     (charms:disable-echoing)
-;     (charms:enable-raw-input :interpret-control-characters t)
-;     (charms:enable-extra-keys charms:*standard-window*)
-;     (charms:enable-non-blocking-mode charms:*standard-window*)
-
-;     (with-windows ((x-win 20 20 1 1)
-;                    (ball-win 10 10 0 0)
-;                    (o-win 5 5 4 0))
-;       (fill-window x-win 20 20 #\x)
-;       (fill-window o-win 5 5 #\O)
-;       ; (with-panels ((x-pan x-win)
-;       ;               (ball-pan ball-win)
-;       ;               (o-pan o-win))
-;       (iterate
-;         (while *running*)
-;         (manage-screen)
-;         (handle-input)
-;         (tick)
-;         ; (charms:move-panel ball-pan *window-x* *window-y*)
-;         (render ball-win)
-;         ; (charms:update-panels)
-;         (charms:update)
-;         (sleep 0.1))
-;       ; )
-;       )))
-
-(defun run ()
-  (setf *running* t)
-  (charms:with-curses ()
-    (charms:disable-echoing)
-    (charms:enable-raw-input :interpret-control-characters t)
-    (charms:enable-extra-keys charms:*standard-window*)
-    (charms:enable-non-blocking-mode charms:*standard-window*)
-
-    (fill-window t 20 20 #\#)
-    (iterate
-      (while *running*)
-      (manage-screen)
-      (handle-input)
-      (tick)
-      (charms:refresh-window t)
-      (sleep 0.1))))
-
-; (run)
-
--- a/src/color-difference.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,22 +0,0 @@
-(in-package :sand.color-difference)
-
-; https://en.wikipedia.org/wiki/Color_difference
-
-(defparameter *c1* (make-cie-rgb-color 0.0 1.0 1.0))
-(defparameter *c2* (make-cie-rgb-color 0.1 1.0 1.0))
-(defparameter *c3* (make-cie-rgb-color 0.7 1.0 1.0))
-
-
-(defun cie-76-distance (c1 c2)
-  (multiple-value-bind (l1 a1 b1) (cie-lab-color-coordinates c1)
-    (multiple-value-bind (l2 a2 b2) (cie-lab-color-coordinates c2)
-      (sqrt (+ (square (- l2 l1))
-               (square (- a2 a1))
-               (square (- b2 b1)))))))
-
-
-; (cie-76-distance *c1* *c2*)
-
-; (defparameter *c* )
-
-; (cie-lab-color-coordinates (make-cie-xyz-color 0 0 0))
--- a/src/generic-arithmetic.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/generic-arithmetic.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,20 @@
+(losh:eval-dammit
+  (ql:quickload '(:compiler-macro)))
+
+(defpackage :sand.generic-arithmetic
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sandalphon.compiler-macro
+    :sand.quickutils
+    :sand.utils)
+  (:shadow
+    :+
+    :-
+    :/
+    :*))
+
 (in-package :sand.generic-arithmetic)
 
 ;;;;     ________  __________ __    __________   _       _________  ____  ______
--- a/src/graphs.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,115 +0,0 @@
-(in-package :sand.graphs)
-
-
-(defun make-edge (from to)
-  (cons from to))
-
-(defun edge-from (edge)
-  (car edge))
-
-(defun edge-to (edge)
-  (cdr edge))
-
-(defun edge= (test e1 e2)
-  (and (funcall test (edge-from e1) (edge-from e2))
-       (funcall test (edge-to e1) (edge-to e2))))
-
-
-(defclass directed-graph ()
-  ((edges :initarg :edges :accessor digraph-edges)
-   (nodes :initarg :nodes :accessor digraph-nodes)
-   (node-test :initarg :node-test :accessor digraph-node-test)
-   (edge-test :initarg :edge-test :accessor digraph-edge-test)))
-
-(defun make-directed-graph (&key (test #'eql))
-  (make-instance 'directed-graph
-                 :node-test test
-                 :edge-test (curry #'edge= test)
-                 :nodes nil
-                 :edges nil))
-
-
-(defun digraph-node= (digraph o1 o2)
-  (funcall (digraph-node-test digraph) o1 o2))
-
-(defun digraph-edge= (digraph e1 e2)
-  (funcall (digraph-edge-test digraph) e1 e2))
-
-
-(defun digraph-map-nodes (function digraph)
-  (mapcar function (digraph-nodes digraph)))
-
-(defun digraph-map-edges (function digraph)
-  (iterate (for edge :in (digraph-edges digraph))
-           (collect (funcall function (edge-from edge) (edge-to edge)))))
-
-(defun digraph-filter-edges (predicate digraph &key (key 'identity))
-  (remove-if-not predicate (digraph-edges digraph) :key key))
-
-
-(defun digraph-edges-from (digraph object)
-  (digraph-filter-edges (curry #'digraph-node= digraph object)
-                        digraph
-                        :key #'edge-from))
-
-(defun digraph-edges-to (digraph object)
-  (digraph-filter-edges (curry #'digraph-node= digraph object)
-                        digraph
-                        :key #'edge-to))
-
-(defun digraph-edges-involving (digraph object)
-  (digraph-filter-edges (lambda (edge)
-                          (or (digraph-node= digraph object (edge-from edge))
-                              (digraph-node= digraph object (edge-to edge))))
-                        digraph))
-
-
-(defun digraph-successors (digraph object)
-  (mapcar #'edge-to (digraph-edges-from digraph object)))
-
-(defun digraph-predecessors (digraph object)
-  (mapcar #'edge-from (digraph-edges-to digraph object)))
-
-(defun digraph-map-successors (function digraph object)
-  (mapcar function (digraph-successors digraph object)))
-
-(defun digraph-map-predecessors (function digraph object)
-  (mapcar function (digraph-predecessors digraph object)))
-
-
-(defun digraph-add-node (digraph object)
-  (zapf (digraph-nodes digraph)
-        (adjoin object % :test (digraph-node-test digraph))))
-
-(defun digraph-add-edge (digraph from to)
-  (zapf (digraph-edges digraph)
-        (adjoin (make-edge from to) %
-                :test (digraph-edge-test digraph))))
-
-(defun digraph-remove-node (digraph object)
-  (zapf (digraph-nodes digraph)
-        (remove object % :test (digraph-node-test digraph))
-        (digraph-edges digraph)
-        (set-difference % (digraph-edges-involving digraph object)
-                        :test (digraph-edge-test digraph)))
-  nil)
-
-(defun digraph-remove-edge (digraph from to)
-  (zapf (digraph-edges digraph)
-        (remove (make-edge from to) %
-                :test (digraph-edge-test digraph)))
-  nil)
-
-
-(defmethod print-object ((digraph directed-graph) stream)
-  (print-unreadable-object (digraph stream :type t :identity t)
-    (when (not (null (digraph-nodes digraph)))
-      (terpri stream)
-      (digraph-map-nodes
-        (lambda (node)
-          (format stream "    ~S -> ~S~%"
-                  node
-                  (mapcar #'edge-to (digraph-edges-from digraph node))))
-        digraph))))
-
-
--- a/src/graphviz.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,43 +0,0 @@
-(in-package :sand.graphviz)
-
-(defun graphviz-node (id &key (label id) (shape :box))
-  (format t "    ~A [shape=~(~A~),label=\"~A\"];~%"
-          id shape label))
-
-(defun graphviz-edge (from-id to-id &key (label "") (style :solid))
-  (format t "    ~A -> ~A [style=~(~A~),label=\"~A\"];~%"
-          from-id to-id style label))
-
-(defun %graphviz-digraph (nodes edges)
-  (format t "digraph G {~%")
-  (mapc (curry #'apply #'graphviz-node) nodes)
-  (mapc (curry #'apply #'graphviz-edge) edges)
-  (format t "}~%"))
-
-(defun graphviz-digraph (nodes edges &key (path t))
-  "Output some Graphviz code to draw a digraph.
-
-  If `path` is `t`, output to a string.  If `nil`, return a string.  Otherwise
-  it should be a path designator, and the code will be spit to that file.
-
-  Each element in `nodes` will have `graphviz-node` applied to it, so they
-  should look like this:
-
-    (node-id)
-    (node-id :label \"foo\" :shape :circle)
-
-  Each element in `edges` will have `graphviz-edge` applied to it, so they
-  should look like this:
-
-    (from-node-id to-node-id)
-    (from-node-id to-node-id :style :dashed :label \"bar\")
-
-  "
-  (case path
-    ((t) (%graphviz-digraph nodes edges))
-    ((nil) (with-output-to-string (*standard-output*)
-             (%graphviz-digraph nodes edges)))
-    (t (with-open-file (*standard-output* path
-                                          :direction :output
-                                          :if-exists :supersede)
-         (%graphviz-digraph nodes edges)))))
--- a/src/istruct.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/istruct.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,12 @@
+(defpackage :sand.istruct
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export))
+
 (in-package :sand.istruct)
 
 ;;;; Equality -----------------------------------------------------------------
--- a/src/mandelbrot.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/mandelbrot.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,116 +1,53 @@
-(in-package :sand.mandelbrot)
+(losh:eval-dammit
+  (ql:quickload '(:trivial-ppm)))
 
-;;;; Config
-(defparameter *width* 100)
-(defparameter *height* 100)
-(defparameter *black-pen* (make-pen :fill (rgb 0 0 0)))
+(defpackage :sand.mandelbrot
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils))
 
 
-;;;; Utils
-(defmacro with-setup (&body body)
-  `(progn
-    (background (gray 1.0))
-    ,@body))
-
-(defmacro in-context (&body body)
-  `(prog1
-    (push-matrix)
-    (progn ,@body)
-    (pop-matrix)))
-
-(defmacro scancode-case (scancode-form &rest pairs)
-  (with-gensyms (scancode)
-    `(let ((,scancode ,scancode-form))
-      (cond
-        ,@(mapcar (lambda (pair)
-                    (destructuring-bind (key-scancode &rest body) pair
-                      `((sdl2:scancode= ,scancode ,key-scancode)
-                        ,@body)))
-           pairs)))))
-
-(defmacro just-once (dirty-place &body body)
-  `(when ,dirty-place
-     (setf ,dirty-place nil)
-     ,@body))
+(in-package :sand.mandelbrot)
 
 
-;;;; Sketch
-(defun magnitude² (complex-number)
+(defun-inline magnitude-squared (complex-number)
   (+ (square (realpart complex-number))
      (square (imagpart complex-number))))
 
-(defun plot (x y)
-  (with-pen *black-pen*
-    (in-context
-      (translate x y)
-      (rect 0 0 1 1))))
-
 (defun escapesp (x y)
   (iterate
     (for c = (complex x y))
     (for z :first c :then (+ (square z) c))
     (repeat 10)
-    (thereis (>= (magnitude² z) 4))))
+    (thereis (>= (magnitude-squared z) 4))))
 
-(defun screen-to-coord (ox oy sx sy)
-  (values (- sx ox)
-          (- sy oy)))
-
+(defun cycles-to-escape (x y)
+  (declare (optimize speed)
+           (type single-float x y))
+  (iterate
+    (declare (iterate:declare-variables))
+    (for (the (complex single-float) c) = (complex x y))
+    (for (the (complex single-float) z) :first c :then (+ (square z) c))
+    (for (the fixnum cycle) :from 0 :below 255)
+    (finding cycle :such-that (>= (magnitude-squared z) 4))))
 
-(defsketch demo
-    ((width *width*) (height *height*) (y-axis :up) (title "Mandelbrot")
-     (copy-pixels t)
-     (mouse (list 0 0))
-     (mouse-down-left nil)
-     (mouse-down-right nil)
-     (dirty t)
-     ;; Data
-     (size 2.0d0)
-     (ox 0)
-     (oy 0)
-     )
-  ;;
-  (just-once dirty
-    (with-setup
-      (in-context
-        (translate (/ *width* 2)
-                   (/ *height* 2))
-        (iterate
-          (with scale = (/ size (/ *width* 2.0d0)))
-          (for-nested ((sx :from (- (/ *width* 2)) :below (/ *width* 2))
-                       (sy :from (- (/ *height* 2)) :below (/ *height* 2))))
-          (for x = (* scale sx))
-          (for y = (* scale sy))
-          (when (not (escapesp x y))
-            (plot sx sy))))))
-  ;;
+(defun coords (ix iy width height)
+  (values (map-range 0 width -2.3 0.7 ix)
+          (map-range 0 height -1.5 1.5 iy)))
 
-  )
-
-
-;;;; Keyboard
-(defun keydown (instance scancode)
-  (declare (ignorable instance))
-  (scancode-case scancode
-    (:scancode-space (sketch::prepare instance))
-    (:scancode-up (mulf (slot-value instance 'size) 1.1))
-    (:scancode-down (mulf (slot-value instance 'size) 0.9))
-    )
-  (setf (slot-value instance 'dirty) t))
-
-(defun keyup (instance scancode)
-  (declare (ignorable instance))
-  (scancode-case scancode
-    (:scancode-space nil)))
-
-
-(defmethod kit.sdl2:keyboard-event ((instance demo) state timestamp repeatp keysym)
-  (declare (ignore timestamp repeatp))
-  (cond
-    ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
-    ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
-    (t nil)))
-
-
-;;;; Run
-; (defparameter *demo* (make-instance 'demo))
+(defun draw (width height &optional (filename "mandelbrot"))
+  (let ((image (make-array (list width height))))
+    (time (iterate (for (pixel ix iy) :in-array image)
+                   (for (values x y) = (coords ix iy width height))
+                   (for cycles = (cycles-to-escape x y))
+                   (for color = (if (null cycles)
+                                  0
+                                  (- 255 cycles)))
+                   (setf (aref image ix iy) color)))
+    (trivial-ppm:write-to-file (format nil "~A.pgm" filename) image
+                               :format :pgm
+                               :encoding :binary
+                               :if-exists :supersede)))
--- a/src/names.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/names.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,14 +1,25 @@
+(defpackage :sand.names
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export))
+
 (in-package :sand.names)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun normalize-namespec (namespec)
-    (trivia:ematch namespec
-      ((list pre suf) (list (symbol-name pre)
-                            nil
-                            (symbol-name suf)))
-      ((list pre in suf) (list (symbol-name pre)
-                               (symbol-name in)
-                               (symbol-name suf)))))
+    (ecase (length namespec)
+      (2 (destructuring-bind (pre suf) namespec
+           (list (symbol-name pre)
+                 nil
+                 (symbol-name suf))))
+      (3 (destructuring-bind (pre in suf) namespec
+           (list (symbol-name pre)
+                 (symbol-name in)
+                 (symbol-name suf))))))
 
   (defun parse-namespecs (namespecs)
     (let ((namespecs (mapcar #'normalize-namespec namespecs)))
--- a/src/number-letters.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/number-letters.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,12 @@
+(defpackage :sand.number-letters
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export))
+
 (in-package :sand.number-letters)
 
 ; https://www.youtube.com/watch?v=LYKn0yUTIU4
@@ -29,7 +38,7 @@
 (declaim (ftype (function ((integer 0)) fixnum)
                 fast-letter-count))
 (defun fast-letter-count (n)
-  (declare (optimize (debug 0) (safety 0) (speed 3)))
+  (declare (optimize speed))
   (if (zerop n)
     4
     (iterate
@@ -54,7 +63,7 @@
     (1+ (chain-length (fast-letter-count n)))))
 
 (defun print-chain (n)
-  (let ((lc (letter-count n)))
+  (let ((lc (fast-letter-count n)))
     (format t "~D - ~R -> ~D~%" n n lc)
     (when (not (= n 4))
       (print-chain lc))))
@@ -73,7 +82,7 @@
     (summing 1 :into result)
     (declare (type fixnum result))
     (when (< i *cache-size*)
-      (return (the fixnum (* result (aref *cache+ i)))))))
+      (return (the fixnum (* result (aref *cache* i)))))))
 
 
 (defun longest-chain (max)
@@ -83,5 +92,5 @@
 
 
 
-; (time
-;   (print-chain (longest-chain (expt 10 9))))
+;; (time
+;;   (print-chain (longest-chain (expt 10 8))))
--- a/src/qud.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/qud.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,15 @@
+(losh:eval-dammit
+  (ql:quickload '(:plump :clss :parse-float)))
+
+(defpackage :sand.qud
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export))
+
 (in-package :sand.qud)
 
 (setf *print-length* 10)
--- a/src/random-numbers.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/random-numbers.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,11 @@
+(defpackage :sand.random-numbers
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils))
+
 (in-package :sand.random-numbers)
 
 
@@ -115,7 +123,7 @@
 
 ;;;; Spectral Test
 (defun spectral ()
-  (spit "data"
+  #+no (spit "data"
     (iterate
       (repeat 1000)
       (for i = (rand))
--- a/src/sorting.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,81 +0,0 @@
-(in-package :sand.sorting)
-
-
-;; http://cdn.cs50.net/2015/fall/lectures/3/m/notes3m/notes3m.html
-
-
-(defun bubble-sort (vector)
-  (iterate
-    (with size = (length vector))
-    (for done = t)
-    (iterate (for i :from 0 :below (1- size))
-             (for j = (1+ i))
-             (when (< (aref vector j) (aref vector i))
-               (rotatef (aref vector i)
-                        (aref vector j))
-               (setf done nil)))
-    (until done))
-  vector)
-
-
-(defun selection-sort (vector)
-  (iterate
-    (for target :index-of-vector vector)
-    (for smallest = (iterate
-                      (for value :in-vector vector :from target :with-index i)
-                      (finding i minimizing value)))
-    (prl target smallest)
-    (rotatef (aref vector target)
-             (aref vector smallest)))
-  vector)
-
-(defun merge-with-temporary (vector temp lstart lsize rstart rsize
-                             &key (predicate #'<))
-  "Merge two consecutive subvectors destructively, using `temp` for storage."
-  (let ((lend (+ lstart lsize))
-        (rend (+ rstart rsize)))
-    (recursively ((i 0) (l lstart) (r rstart))
-      (cond
-        ((= l lend) (replace temp vector ; Done with l, bulk-copy the rest of r
-                             :start1 i
-                             :start2 r :end2 rend))
-        ((= r rend) (replace temp vector ; Done with r, bulk-copy the rest of l
-                             :start1 i
-                             :start2 l :end2 lend))
-        ;; Take r only if it's strictly less than l, so we have a stable mege
-        ((funcall predicate (aref vector r) (aref vector l))
-         (setf (aref temp i) (aref vector r))
-         (recur (1+ i) l (1+ r)))
-        (t ; Otherwise l <= r, so take l
-         (setf (aref temp i) (aref vector l))
-         (recur (1+ i) (1+ l) r)))))
-  (replace vector temp :start1 lstart :end2 (+ lsize rsize)))
-
-(defun merge-sort (vector)
-  "Merge-sort `vector` destructively.
-
-  A single vector the same size as `vector` will be consed internally for
-  temporary storage.
-
-  "
-  (let ((temp (make-array (length vector)))) ; just cons one temp array
-    (recursively ((start 0)
-                  (size (length vector)))
-      (when (>= size 2)
-        (let* ((half (floor size 2))
-               (left-start start)
-               (right-start (+ start half))
-               (left-size half)
-               (right-size (- size half)))
-          (recur left-start left-size)
-          (recur right-start right-size)
-          (merge-with-temporary vector temp
-                                left-start left-size
-                                right-start right-size)))))
-  vector)
-
-
-(defparameter *v* #(1 3 7 0 2))
-; (selection-sort *v*)
-; (bubble-sort *v*)
-; (merge-sort *v*)
--- a/src/turing-omnibus/minimax.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/turing-omnibus/minimax.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,7 +1,15 @@
+(defpackage :sand.turing-omnibus.minimax
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils))
+
 (in-package :sand.turing-omnibus.minimax)
 
-(declaim (optimize (safety 1) (debug 3) (speed 3)))
-(declaim (optimize (safety 0) (debug 0) (speed 3)))
+;; (declaim (optimize (safety 1) (debug 3) (speed 3)))
+;; (declaim (optimize (safety 0) (debug 0) (speed 3)))
 
 
 ;;;; API ----------------------------------------------------------------------
--- a/src/turing-omnibus/monte-carlo.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/turing-omnibus/monte-carlo.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,11 @@
+(defpackage :sand.turing-omnibus.monto-carlo
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils))
+
 (in-package :sand.turing-omnibus.monto-carlo)
 
 ;;;; From The New Turing Omnibus, Chapter 4
--- a/src/turing-omnibus/wallpaper.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/turing-omnibus/wallpaper.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,110 +1,40 @@
+(losh:eval-dammit
+  (ql:quickload '(:trivial-ppm)))
+
+(defpackage :sand.turing-omnibus.wallpaper
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils))
+
+
 (in-package :sand.turing-omnibus.wallpaper)
 
 ;;;; From The New Turing Omnibus, Chapter 1
 
-;;;; Config
-(defparameter *width* 600)
-(defparameter *height* 600)
-
-
-;;;; Utils
-(defmacro with-setup (&body body)
-  `(progn
-    (background (gray 1.0))
-    ,@body))
-
-(defmacro in-context (&body body)
-  `(prog1
-    (push-matrix)
-    (progn ,@body)
-    (pop-matrix)))
-
-(defmacro scancode-case (scancode-form &rest pairs)
-  (with-gensyms (scancode)
-    `(let ((,scancode ,scancode-form))
-      (cond
-        ,@(mapcar (lambda (pair)
-                    (destructuring-bind (key-scancode &rest body) pair
-                      `((sdl2:scancode= ,scancode ,key-scancode)
-                        ,@body)))
-           pairs)))))
-
-(defmacro just-once (dirty-place &body body)
-  `(when ,dirty-place
-     (setf ,dirty-place nil)
-     ,@body))
+(defun draw (width height &optional (side 200.0d0) (colors 2))
+  (declare (optimize speed)
+           (type (integer 2 4) colors)
+           (type (integer 0 50000) width height)
+           (type double-float side))
+  (let ((image (make-array (list width height)))
+        (palette #(#(86 50 16)
+                   #(255 209 105)
+                   #(204 132 76)
+                   #(165 144 125))))
+    (time
+      (dotimes (i width)
+        (dotimes (j height)
+          (let* ((x (* i (/ side width)))
+                 (y (* j (/ side height)))
+                 (c (truncate (+ (* x x) (* y y)))))
+            (setf (aref image i j)
+                  (elt palette (mod c colors)))))))
+    (time (trivial-ppm:write-to-file "wallpaper.ppm" image
+                                     :format :ppm
+                                     :if-exists :supersede))))
 
 
-;;;; Sketch
-(defun plot (x y color)
-  (with-pen (make-pen :fill color)
-    (in-context
-      (translate x y)
-      (rect 0 0 1 1))))
 
-(defsketch wallpaper
-    ((width *width*) (height *height*) (y-axis :up) (title "Wallpaper")
-     (copy-pixels t)
-     (mouse (list 0 0))
-     (mouse-down-left nil)
-     (mouse-down-right nil)
-     (dirty t)
-     ;; Data
-     (palette (iterate (repeat (random-range 2 10))
-                       (collect (rgb (random 1.0) (random 1.0) (random 1.0))
-                                :result-type 'vector)))
-     (corner-a (random 100))
-     (corner-b (random 100))
-     (side (random-range 10.0 20.0))
-     (tiles (random-range 40 110))
-     (number-of-colors (length palette)))
-  ;;
-  (just-once dirty
-    (with-setup
-      (in-context
-        (scale (/ *width* tiles))
-        (iterate
-          (for-nested ((i :from 0 :below tiles)
-                       (j :from 0 :below tiles)))
-          (for x = (+ corner-a (* i (/ side tiles))))
-          (for y = (+ corner-b (* j (/ side tiles))))
-          (for c = (truncate (+ (* x x) (* y y))))
-          (plot i j (aref palette (mod c number-of-colors)))))
-      (with-pen (make-pen :fill (rgb 1.0 1.0 1.0))
-        (rect 0 0 110 20))
-      (text (format nil "Side: ~8F" side) 0 0)))
-  ;;
-
-  )
-
-
-;;;; Keyboard
-(defun keydown (instance scancode)
-  (declare (ignorable instance))
-  (scancode-case scancode
-    (:scancode-space (sketch::prepare instance))
-    (:scancode-up (mulf (slot-value instance 'side) 1.01))
-    (:scancode-down (mulf (slot-value instance 'side) 0.99))
-    (:scancode-l (decf (slot-value instance 'corner-a)))
-    (:scancode-h (incf (slot-value instance 'corner-a)))
-    (:scancode-k (decf (slot-value instance 'corner-b)))
-    (:scancode-j (incf (slot-value instance 'corner-b)))
-    )
-  (setf (slot-value instance 'dirty) t))
-
-(defun keyup (instance scancode)
-  (declare (ignorable instance))
-  (scancode-case scancode
-    (:scancode-space nil)))
-
-
-(defmethod kit.sdl2:keyboard-event ((instance wallpaper) state timestamp repeatp keysym)
-  (declare (ignore timestamp repeatp))
-  (cond
-    ((eql state :keyup) (keyup instance (sdl2:scancode-value keysym)))
-    ((eql state :keydown) (keydown instance (sdl2:scancode-value keysym)))
-    (t nil)))
-
-
-;;;; Run
-; (defparameter *wallpaper* (make-instance 'wallpaper))
--- a/src/urn.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ b/src/urn.lisp	Fri Jan 26 21:27:01 2018 -0500
@@ -1,3 +1,12 @@
+(defpackage :sand.urn
+  (:use
+    :cl
+    :losh
+    :iterate
+    :sand.quickutils
+    :sand.utils)
+  (:export))
+
 (in-package :sand.urn)
 
 (defun make-vec-from (contents)
--- a/src/utils.lisp	Thu Sep 07 15:25:54 2017 -0400
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,6 +0,0 @@
-(in-package :sand.utils)
-
-
-(defun average4 (a b c d)
-  (/ (+ a b c d) 4))
-