cleaned up a little
This commit is contained in:
BIN
snek/img/img.png
BIN
snek/img/img.png
Binary file not shown.
|
Before Width: | Height: | Size: 273 KiB |
@@ -1,51 +0,0 @@
|
||||
#!/usr/bin/sbcl --script
|
||||
|
||||
(load "src/load")
|
||||
|
||||
(setf *print-pretty* t)
|
||||
(setf *random-state* (make-random-state t))
|
||||
|
||||
|
||||
(defun main (size fn)
|
||||
|
||||
(let ((mid (.5* size))
|
||||
(repeat 15)
|
||||
(grains 4)
|
||||
(itt 1000)
|
||||
(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 i in (linspace 100 900 repeat)
|
||||
for j from 1 to repeat do
|
||||
(print j)
|
||||
(let ((snk (snek*))
|
||||
(va (list 0 0))
|
||||
(vb (list 0 0))
|
||||
(p1 (list 100 i))
|
||||
(p2 (list 900 i)))
|
||||
|
||||
(loop for k from 1 to itt do
|
||||
(let ((v1 (insert-vert (l-on-line k itt p1 p2) into snk))
|
||||
(v2 (insert-vert (ladd va (l-on-line k itt p1 p2)) into snk)))
|
||||
|
||||
(setf va (ladd va (l-rand-in-circle (* 0.7 j))))
|
||||
(setf vb (ladd vb (l-rand-in-circle (* 0.001 j))))
|
||||
|
||||
(with-snek (snk)
|
||||
(with-all-verts (snk v)
|
||||
(move-vert v (ladd (l-rand-in-circle 0.1) vb)))
|
||||
(join-verts v1 v2))
|
||||
|
||||
(sandpaint-edges sand snk grains)
|
||||
(sandpaint-verts sand snk)))))
|
||||
|
||||
|
||||
(format t "~%writing to ~a" fn)
|
||||
;(sandpaint-chromatic-aberration sand (list mid mid) 100.0)
|
||||
(sandpaint-save sand fn)))
|
||||
|
||||
|
||||
(time (main 1000 (second (cmd-args))))
|
||||
|
||||
@@ -1,52 +0,0 @@
|
||||
#!/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))))
|
||||
|
||||
@@ -1,524 +0,0 @@
|
||||
#!/usr/bin/sbcl --script
|
||||
|
||||
(load "src/load")
|
||||
|
||||
(setf *print-pretty* t)
|
||||
;(setf *random-state* (make-random-state t))
|
||||
|
||||
|
||||
(defmacro do-test (a &optional (b nil))
|
||||
(with-gensyms (aname bname)
|
||||
`(let ((,aname ,a)
|
||||
(,bname ,b))
|
||||
(if (funcall #'equalp ,aname ,bname)
|
||||
(format t "~%~a ~%--> ok" ',a)
|
||||
(format t "~%~a ~%--> not ok. ~%-- wanted: ~% ~a ~%-- got: ~% ~a"
|
||||
',a
|
||||
',b
|
||||
,aname))
|
||||
(format t "~%---------------------------~%"))))
|
||||
|
||||
|
||||
(defun test-utils ()
|
||||
(do-test
|
||||
(lnorm '(3 0))
|
||||
'(1.0 0.0))
|
||||
|
||||
(do-test
|
||||
(lsub '(1 2) '(2 3))
|
||||
'(-1 -1))
|
||||
|
||||
(do-test
|
||||
(ladd '(1 2) '(2 3))
|
||||
'(3 5))
|
||||
|
||||
(do-test
|
||||
(lnsub '(1 2) '(2 10))
|
||||
'(-0.12403473 -0.99227786))
|
||||
|
||||
(do-test
|
||||
(llenn '(1 2))
|
||||
5)
|
||||
|
||||
(do-test
|
||||
(llen '(1 2))
|
||||
2.236068)
|
||||
|
||||
(do-test
|
||||
(ldst '(1 2) '(1 3))
|
||||
1.0)
|
||||
|
||||
(do-test
|
||||
(lget '(0 2) '((1 2) (3 4) (5 6)))
|
||||
'((1 2) (5 6))))
|
||||
|
||||
|
||||
(defun test-bin ()
|
||||
(let ((edges (make-array
|
||||
(list 10 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((1 0) (1 2) (1 5) (3 4) (10 3) (0 0) (0 0) (0 0) (0 0) (0 0)))))
|
||||
|
||||
(do-test
|
||||
(-binary-edge-insert-search edges '(3 4) 5)
|
||||
4)
|
||||
|
||||
(do-test
|
||||
(-binary-edge-insert-search edges '(0 0) 5)
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(-binary-edge-insert-search edges '(1 6) 5)
|
||||
3)
|
||||
|
||||
(-insert-edge edges '(11 1) 5 5)
|
||||
(-insert-edge edges '(11 0) 5 6)
|
||||
|
||||
(-remove-edge edges 0 7)
|
||||
|
||||
(do-test
|
||||
edges
|
||||
(make-array
|
||||
(list 10 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((1 2) (1 5) (3 4) (10 3) (11 0) (11 1) (0 0) (0 0) (0 0) (0 0)
|
||||
)))))
|
||||
|
||||
|
||||
(defun test-snek (s)
|
||||
(do-test
|
||||
(insert-vert '(0 0) into s)
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(10 0) into s)
|
||||
1)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(3 3) into s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(4 3) into s)
|
||||
3)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 0) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 2) into s)
|
||||
'(0 2))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 1) into s)
|
||||
'(0 1))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(5 0) into s)
|
||||
'(0 5))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(1 0) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(5 0) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 2) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(5 2) into s)
|
||||
'(2 5))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(4 1) into s)
|
||||
'(1 4))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(4 0) into s)
|
||||
'(0 4))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(5 1) into s)
|
||||
'(1 5))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(100 100) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(3 100) into s)
|
||||
'(3 100))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 1) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 4) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(100 99) into s)
|
||||
'(99 100))
|
||||
|
||||
(do-test
|
||||
(get-vert 2 from s)
|
||||
'(3.0 3.0))
|
||||
|
||||
(do-test
|
||||
(insert-vert '(0 1) into s)
|
||||
4)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 1) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(0 7) into s)
|
||||
5)
|
||||
|
||||
(do-test
|
||||
(get-one-ring of 5 from s)
|
||||
'((5 0) (5 1) (5 2)))
|
||||
|
||||
(do-test
|
||||
(get-one-ring of 0 from s)
|
||||
'((0 1) (0 2) (0 4) (0 5)))
|
||||
|
||||
(do-test
|
||||
(edge-length s '(0 4))
|
||||
1.0)
|
||||
|
||||
(do-test
|
||||
(edge-length s '(2 5))
|
||||
5.0)
|
||||
|
||||
(do-test
|
||||
(edge-length s '(1 2))
|
||||
7.615773))
|
||||
|
||||
|
||||
(defun test-snek-2 (s)
|
||||
(do-test
|
||||
(insert-vert '(0 0) into s)
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(20 20) into s)
|
||||
1)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(30 30) into s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(40 40) into s)
|
||||
3)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 1) into s)
|
||||
'(0 1))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(1 2) into s)
|
||||
'(1 2))
|
||||
|
||||
(do-test
|
||||
(insert-edge '(2 3) into s)
|
||||
'(2 3))
|
||||
|
||||
(do-test
|
||||
(-binary-edge-insert-search (snek-edges s) '(1 2) 2)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(get-one-ring of 0 from s)
|
||||
'((0 1)))
|
||||
|
||||
(do-test
|
||||
(get-one-ring of 1 from s)
|
||||
'((1 0) (1 2)))
|
||||
|
||||
(do-test
|
||||
(remove-edge '(0 1) from s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(remove-edge '(0 1) from s)
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(remove-edge '(3 2) from s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(remove-edge '(1 2) from s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(snek-num-verts s)
|
||||
4))
|
||||
|
||||
|
||||
(defun test-snek-3 (s)
|
||||
(do-test
|
||||
(insert-vert '(10 10) into s)
|
||||
0)
|
||||
(do-test
|
||||
(insert-vert '(20 10) into s)
|
||||
1)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(30 10) into s)
|
||||
2)
|
||||
|
||||
(do-test
|
||||
(insert-vert '(40 10) into s)
|
||||
3)
|
||||
|
||||
(do-test
|
||||
(insert-edge '(0 1) into s)
|
||||
'(0 1))
|
||||
(do-test
|
||||
(insert-edge '(1 2) into s)
|
||||
'(1 2))
|
||||
(do-test
|
||||
(insert-edge '(2 3) into s)
|
||||
'(2 3))
|
||||
(do-test
|
||||
(insert-edge '(2 3) into s)
|
||||
nil)
|
||||
|
||||
(do-test
|
||||
(-binary-edge-search
|
||||
(snek-edges s)
|
||||
'(2 3)
|
||||
(snek-num-edges s))
|
||||
4)
|
||||
|
||||
(do-test
|
||||
(-binary-edge-search
|
||||
(snek-edges s)
|
||||
'(0 1)
|
||||
(snek-num-edges s))
|
||||
0)
|
||||
|
||||
(do-test
|
||||
(-binary-edge-search
|
||||
(snek-edges s)
|
||||
'(10 1)
|
||||
(snek-num-edges s))
|
||||
nil))
|
||||
|
||||
(defun init-snek ()
|
||||
(let ((s (snek* 16)))
|
||||
(insert-vert '(0 2) into s)
|
||||
(insert-vert '(2 3) into s)
|
||||
(insert-vert '(3 4) into s)
|
||||
(insert-vert '(4 7) into s)
|
||||
(insert-vert '(5 4) into s)
|
||||
(insert-vert '(0 6) into s)
|
||||
(insert-vert '(-1 7) into s)
|
||||
(insert-vert '(0 8) into s)
|
||||
(insert-vert '(0 9) into s)
|
||||
(insert-vert '(10 1) into s)
|
||||
|
||||
(insert-edge '(1 2) into s)
|
||||
(insert-edge '(0 1) into s)
|
||||
(insert-edge '(3 1) into s)
|
||||
(insert-edge '(5 6) into s)
|
||||
(insert-edge '(7 3) into s)
|
||||
s))
|
||||
|
||||
(defun test-snek-move ()
|
||||
(let ((s (init-snek)))
|
||||
(with-snek (s)
|
||||
(move-vert 0 '(3 3))
|
||||
(move-vert 1 '(1 3))
|
||||
(move-vert 3 '(2 3) :rel nil)
|
||||
(move-vert 2 '(3 4)))
|
||||
|
||||
(do-test
|
||||
(get-vert 0 from s)
|
||||
'(3 5))
|
||||
|
||||
(do-test
|
||||
(get-vert 1 from s)
|
||||
'(3 6))
|
||||
|
||||
(do-test
|
||||
(get-vert 3 from s)
|
||||
'(2 3))
|
||||
|
||||
(do-test
|
||||
(get-vert 2 from s)
|
||||
'(6 8))))
|
||||
|
||||
(defun test-snek-join ()
|
||||
(let ((s (init-snek)))
|
||||
(with-snek (s)
|
||||
(join-verts 3 3)
|
||||
(join-verts 3 3)
|
||||
(join-verts 3 6)
|
||||
(join-verts 7 1))
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
14)
|
||||
|
||||
(do-test
|
||||
(snek-edges s)
|
||||
(make-array
|
||||
(list 16 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((0 1) (1 0) (1 2) (1 3) (1 7) (2 1) (3 1) (3 6)
|
||||
(3 7) (5 6) (6 3) (6 5) (7 1) (7 3) (0 0) (0 0))))))
|
||||
|
||||
|
||||
(defun test-snek-append ()
|
||||
(let ((s (init-snek)))
|
||||
(with-snek (s)
|
||||
(append-edge 3 '(3 4))
|
||||
(append-edge 3 '(8 5) :rel nil)
|
||||
(append-edge 7 '(1 2)))
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
16)
|
||||
|
||||
(do-test
|
||||
(snek-num-verts s)
|
||||
13)
|
||||
|
||||
(do-test
|
||||
(snek-edges s)
|
||||
(make-array
|
||||
(list 16 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((0 1) (1 0) (1 2) (1 3) (2 1) (3 1) (3 7) (3 10)
|
||||
(3 11) (5 6) (6 5) (7 3) (7 12) (10 3) (11 3) (12 7))))
|
||||
|
||||
(do-test
|
||||
(snek-verts s)
|
||||
(make-array
|
||||
(list 16 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((0.0 2.0) (2.0 3.0) (3.0 4.0) (4.0 7.0) (5.0 4.0) (0.0 6.0)
|
||||
(-1.0 7.0) (0.0 8.0) (0.0 9.0) (10.0 1.0) (7.0 11.0) (8.0 5.0)
|
||||
(1.0 10.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))))))
|
||||
|
||||
|
||||
(defun test-snek-split ()
|
||||
(let ((s (init-snek)))
|
||||
(with-snek (s)
|
||||
(split-edge '(1 2))
|
||||
(split-edge '(1 2))
|
||||
(split-edge '(5 6)))
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
14)
|
||||
|
||||
(do-test
|
||||
(snek-num-verts s)
|
||||
12)
|
||||
|
||||
(do-test
|
||||
(snek-edges s)
|
||||
(make-array
|
||||
(list 16 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((0 1) (1 0) (1 3) (1 10) (2 10) (3 1) (3 7) (5 11) (6 11)
|
||||
(7 3) (10 1) (10 2) (11 5) (11 6) (0 0) (0 0))))
|
||||
|
||||
(do-test
|
||||
(snek-verts s)
|
||||
(make-array
|
||||
(list 16 2)
|
||||
:adjustable nil
|
||||
:initial-contents
|
||||
'((0.0 2.0) (2.0 3.0) (3.0 4.0) (4.0 7.0) (5.0 4.0) (0.0 6.0)
|
||||
(-1.0 7.0) (0.0 8.0) (0.0 9.0) (10.0 1.0) (2.5 3.5) (-0.5 6.5)
|
||||
(0.0 0.0) (0.0 0.0) (0.0 0.0) (0.0 0.0))))))
|
||||
|
||||
|
||||
(defun test-snek-withs ()
|
||||
(let ((s (init-snek)))
|
||||
(with-snek (s)
|
||||
(with-rnd-vert (s v)
|
||||
(append-edge v (list 3 2))
|
||||
(move-vert v (list 2 2))))
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
12)
|
||||
|
||||
(do-test
|
||||
(snek-num-verts s)
|
||||
11)
|
||||
|
||||
(with-snek (s)
|
||||
(with-all-verts (s v)
|
||||
(move-vert v (list 2 2))))
|
||||
|
||||
(with-snek (s)
|
||||
(with-rnd-edge (s e)
|
||||
(split-edge e)))
|
||||
|
||||
(do-test
|
||||
(snek-num-edges s)
|
||||
14)
|
||||
|
||||
(do-test
|
||||
(snek-num-verts s)
|
||||
12)))
|
||||
|
||||
|
||||
(defun main ()
|
||||
|
||||
(format t "~%~%~%--------------------------------------- test utils")
|
||||
(test-utils)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- test bin")
|
||||
(test-bin)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek 1")
|
||||
(test-snek (snek*))
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek 2")
|
||||
(test-snek-2 (snek*))
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek 3")
|
||||
(test-snek-3 (snek*))
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek move")
|
||||
(test-snek-move)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek join")
|
||||
(test-snek-join)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek append")
|
||||
(test-snek-append)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek split")
|
||||
(test-snek-split)
|
||||
|
||||
(format t "~%~%~%--------------------------------------- snek with")
|
||||
(test-snek-withs))
|
||||
|
||||
(main)
|
||||
Reference in New Issue
Block a user