reinlined snek

snek/run-slope.lisp

@@ -0,0 +1,52 @@
+#!/usr/bin/sbcl --script
+
+(load "src/load")
+
+(setf *print-pretty* t)
+(setf *random-state* (make-random-state t))
+
+
+(defun main (size fn)
+
+  (let ((p1 (l-rand-in-circle 100 :x 800.0 :y 200.0))
+        (p2 (l-rand-in-circle 100 :x 200.0 :y 800.0)))
+    (let ((va (ladd
+                (lscale
+                   (lnorm
+                     (lmult (reverse (lsub p1 p2)) (list -1.0 1.0)))
+                   40.0)
+                 (l-rand-on-circle 20 :x 0.0 :y 0.0)))
+         (repeat 10)
+         (noise (random 4.0))
+         (grains 70)
+         (itt 6000)
+         (sand (sandpaint*
+                 size
+                 :active (list 0.0 0.0 0.0 0.01)
+                 :bg (list 1.0 1.0 1.0 1.0))))
+
+      (loop for j from 1 to repeat
+        do
+          (print j)
+          (let ((snk (snek*)))
+            (setf va (ladd va (l-rand-in-circle noise :x 0.0 :y 0.0)))
+
+            (loop for k from 1 to itt
+              do
+                (insert-vert (l-rand-on-line p1 p2) into snk)
+                (with-snek (snk)
+                  (with-rnd-vert (snk v)
+                    (append-edge v va))
+                  (with-rnd-vert (snk v)
+                    (with-rnd-vert (snk w)
+                      (join-verts w v)))))
+              (sandpaint-edges sand snk grains)))
+
+
+   (-pixel-hack sand)
+   (format t "~%writing to ~a" fn)
+   (sandpaint-save sand fn))))
+
+
+(time (main 1000 (second (cmd-args))))
+