hellerve/shinu
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

cleaned up a little

Browse Source
This commit is contained in:
Veit Heller
2017-03-09 08:20:48 +01:00
parent 274c00ad21
commit a5cb28f2e4
6 changed files with 11 additions and 638 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
shinu.lisp Normal file → Executable file
View File

@@ -1,26 +1,27 @@
#!/usr/local/bin/sbcl --script
(load "snek/src/load")
(setf *random-state* (make-random-state t))
(defvar *file* "out.png")
(defvar *file* "out~a.png")
(defvar *size* 1000)
(defmacro rand () `(random 1.0))
(defun rand-rgba ()
(list (rand) (rand) (rand) 1.0))
(defun rand-rgba (opacity)
(list (rand) (rand) (rand) opacity))
(defun main ()
(let* ((mid (* *size* .5))
(repeat (random 100))
(repeat (random 25))
(grains (random 10))
(itt (random 5000))
(bg (rand-rgba))
(active (rand-rgba))
(itt (random 2000))
(bg (rand-rgba 1.0))
(active (rand-rgba 0.6))
(sand (sandpaint* *size* :active active :bg bg)))
(loop for i in (linspace 100 900 repeat)
for j from 1 to repeat do
(format "~d/~d (~d)~%" j repeat (/ j repeat))
(format t "~a/~a (~a)~%" j repeat (/ j repeat))
(let ((snk (snek*))
(va (list 0 0))
(vb (list 0 0))
@@ -40,8 +41,7 @@
(join-verts v1 v2))
(sandpaint-edges sand snk grains)
(sandpaint-verts sand snk)))))
(sandpaint-save sand *file*)))
(sandpaint-verts sand snk)
(sandpaint-save sand (format nil *file* j))))))))
(main)

BIN
snek/img/img.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 273 KiB

0
snek/res/.empty
View File

51
snek/run-lines.lisp
View File

@@ -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))))

52
snek/run-slope.lisp
View File

@@ -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))))

524
snek/run-test.lisp
View File

@@ -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)