Skip to content

GitLab

Commit 66d36f82 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

added if, started sanity process

parent 68006595
Hide whitespace changes
Inline Side-by-side
README.md
View file @ 66d36f82
......@@ -92,8 +92,24 @@ Here is a program that randomly moves vertex positions around:
Willdo...
* let
(let ((name value) (name value) ...))
Note:
Scoping is not yet implemented, so all names are global.
True for function arguments also.
* define
* if
(if pred true-expr false-expr)
* cond
(cond (pred block) (pred block) ...)
Note: currently evaluates all parts sequentially
* loop
* forever
* do
......
assets/boot.scm
View file @ 66d36f82
......@@ -528,3 +528,24 @@
(let ((code (diy-macro (append '(begin) code))))
; (display code)(newline)
(eval code)))
;;---------------------------------------------------------
;; jellyfish helpers
(define (jelly-compiled code)
(define addr 0)
(for-each
(lambda (v)
(pdata-set! "x" addr v)
(set! addr (+ addr 1)))
code))
(define (program-jelly speed prim-type code)
(let ((c (compile-program speed prim-type 1 code)))
;;(disassemble c)
(jelly-compiled c)))
(define (disassemble-compiled code)
(let ((c (compile-program 50 'triangles 1 code)))
(disassemble c))
code)
assets/compiler.scm
View file @ 66d36f82
......@@ -207,6 +207,29 @@
(cddr x)))
(emit (vector ldl 0 0))))
(define (emit-write-sub! x)
(append
(cadr
(foldl
(lambda (val r)
(list
(+ (car r) 1)
(append
(cadr r)
(emit-expr (cadr x)) ;; address
(emit (vector ldl (car r) 0)) ;; offset
(emit (vector add 0 0)) ;; add them
(emit (vector lds 0 0)) ;; load value
(emit-expr val) ;; data
(emit (vector sub 0 0)) ;; add them
(emit (vector ldl (car r) 0)) ;; offset
(emit-expr (cadr x)) ;; address
(emit (vector add 0 0)) ;; add offset
(emit (vector sts 0 0)))))
(list 0 '())
(cddr x)))
(emit (vector ldl 0 0))))
(define (emit-read x)
(append
......@@ -231,6 +254,18 @@
(_ (cdr l))))))
(_ (cdr x)))
(define (emit-if x)
(let ((tblock (emit-expr (caddr x)))
(fblock (emit-expr (cadddr x))))
(append
(emit-expr (cadr x))
(emit (vector jmz (+ (length tblock) 2) 0))
tblock
(emit (vector jmr (+ (length fblock) 1) 0))
fblock)))
(define (emit-fncall x addr)
(let ((args (emit-expr-list-maintain-stack (cdr x))))
(append
......@@ -423,6 +458,7 @@
((eq? (car x) 'set!) (emit-set! x))
((eq? (car x) 'write!) (emit-write! x))
((eq? (car x) 'write-add!) (emit-write-add! x))
((eq? (car x) 'write-sub!) (emit-write-sub! x))
((eq? (car x) 'swizzle) (emit-swizzle x))
((eq? (car x) 'lambda) (emit-lambda x))
((eq? (car x) 'rndvec) (emit (vector rnd 0 0)))
......@@ -467,6 +503,9 @@
((eq? (car x) 'let) (emit-let x))
((eq? (car x) 'define) (emit-define x))
((eq? (car x) 'cond) (emit-cond x))
((eq? (car x) 'if)
(display "emit if")(newline)
(emit-if x))
((eq? (car x) 'loop) (emit-loop x))
((eq? (car x) 'do) (emit-expr-list (cdr x)))
(else (emit-procedure x)))
......
assets/jellyfish-old.scm deleted 100644 → 0
View file @ 68006595
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; jellyfish livecoding stuff
(define (jelly-compiled code)
(define addr 0)
(for-each
(lambda (v)
(pdata-set! "x" addr v)
(set! addr (+ addr 1)))
code))
(define jellyfish
(list
(build-jellyfish 512)
(build-jellyfish 512)
(build-jellyfish 512)))
(define current 0)
(define (make-jelly speed prim-type code)
(let ((p (list-ref jellyfish current)))
(msg p)
(with-primitive
p
(let ((c (compile-program speed prim-type 1 code)))
;; (disassemble c)
(jelly-compiled c))
(set! current (modulo (+ current 1) (length jellyfish)))
p)))
(with-primitive
(make-jelly
10000 prim-triangles
'(let ((vertex positions-start)
(t 0)
(v 0)
(np 0))
(forever
(set! vertex positions-start)
(loop (< vertex positions-end)
(set! np (+ (* (+ (read vertex) vertex) 0.1)
(swizzle yyx t)))
(set! v (+ (*v (noise np) (vector 1 0 0))
(*v (noise (+ np 101.1)) (vector 0 1 0))))
(set! v (*v (- v (vector 0.47 0.47 0.47)) (vector 0.1 0.1 0)))
(write-add! vertex v v v v v v)
(set! vertex (+ vertex 6)))
(set! t (+ t 0.01))
)))
(hint-unlit)
(pdata-index-map!
(lambda (i p)
(let ((z (* i 0.01)))
(if (odd? i)
(list-ref
(list (vector 0 0 z) (vector 1 0 z) (vector 1 1 z))
(modulo i 3))
(list-ref
(list (vector 1 1 z) (vector 0 1 z) (vector 0 0 z))
(modulo i 3))))) "p")
(texture (load-texture "raspberrypi.png"))
(translate (vector -0.5 -0.5 0))
(pdata-copy "p" "t")
(pdata-map! (lambda (t) (vmul t -1)) "t")
(pdata-map! (lambda (c) (vector 1 1 1)) "c")
(pdata-map! (lambda (n) (vector 0 0 0)) "n"))
assets/jellyfish.scm
View file @ 66d36f82
......@@ -11,8 +11,9 @@
(define jellyfish
(list
(build-jellyfish 4096)
(build-jellyfish 4096)))
(build-jellyfish 512)
(build-jellyfish 512)
(build-jellyfish 512)))
(define current 0)
......@@ -22,263 +23,45 @@
(with-primitive
p
(let ((c (compile-program speed prim-type 1 code)))
;(disassemble c)
;; (disassemble c)
(jelly-compiled c))
(set! current (modulo (+ current 1) (length jellyfish)))
p)))
(define weft
(make-jelly
50 prim-triangles
'(let ((vertex positions-start)
(t 0)
(v 0)
(weft-direction (vector 2 0 0))
(weft-position (vector 0 0 0))
(weft-t 0)
(draft-pos 0)
(draft-size 4)
(draft 1) (d-b 0) (d-c 0) (d-d 1)
(d-e 1) (d-f 1) (d-g 0) (d-h 0)
(d-i 0) (d-j 1) (d-k 1) (d-l 0)
(d-m 0) (d-n 0) (d-o 1) (d-p 1)
(draft-tmp 0)
(shed-tmp 0)
(weft-z (vector 0 0 0))
(weft-count 0))
(define calc-weft-z
(lambda ()
(set! draft-tmp
(read (+ (addr draft)
(+ (* draft-pos draft-size)
(cond ((> weft-direction 0)
(modulo weft-count (+ draft-size (vector 0 1 1)) ))
((< weft-direction 0)
(- draft-size (modulo weft-count (+ draft-size (vector 0 1 1)) ))))))))
(set! weft-count (+ weft-count 1))
(cond ((> draft-tmp 0.5)
(set! weft-z (vector 0 0 0.01)))
((< draft-tmp 0.5)
(set! weft-z (vector 0 0 -0.01))))
))
(define right-selvedge
(lambda (gap)
;; top corner
(write! vertex
(- (+ weft-position (vector 2 0 0)) gap)
(- (+ weft-position (vector 3 1 0)) gap)
(- (+ weft-position (vector 2 1 0)) gap))
(set! vertex (+ vertex 3))
;; vertical connection
(write! vertex
(- (+ weft-position (vector 3 1 0)) gap)
(- (+ weft-position (vector 2 1 0)) gap)
(+ weft-position (vector 2 0 0))
(- (+ weft-position (vector 3 1 0)) gap)
(+ weft-position (vector 2 0 0))
(+ weft-position (vector 3 0 0)))
(set! vertex (+ vertex 6))
;; bottom corner
(write! vertex
(+ weft-position (vector 2 0 0))
(+ weft-position (vector 3 0 0))
(+ weft-position (vector 2 1 0)))
(set! vertex (+ vertex 3))
))
(define left-selvedge
(lambda (gap)
;; top corner
(write! vertex
(- (+ weft-position (vector 0 0 0)) gap)
(- (+ weft-position (vector -1 1 0)) gap)
(- (+ weft-position (vector 0 1 0)) gap))
(set! vertex (+ vertex 3))
;; vertical connection
(write! vertex
(- (+ weft-position (vector -1 1 0)) gap)
(- (+ weft-position (vector 0 1 0)) gap)
(+ weft-position (vector 0 0 0))
(- (+ weft-position (vector -1 1 0)) gap)
(+ weft-position (vector 0 0 0))
(+ weft-position (vector -1 0 0)))
(set! vertex (+ vertex 6))
;; bottom corner
(write! vertex
(+ weft-position (vector 0 0 0))
(+ weft-position (vector -1 0 0))
(+ weft-position (vector 0 1 0)))
(set! vertex (+ vertex 3))
))
(forever
(set! vertex positions-start)
(loop (< vertex positions-end)
; (set! weft-t (+ weft-t 0.05))
; (cond ((> weft-t 1)
; (set! draft-pos (+ draft-pos 1))
; (cond ((> draft-pos draft-size)
; (set! draft-pos 0)))
; (set! weft-t 0)))
(calc-weft-z)
(set! weft-position (+ weft-position weft-direction))
;; selvedge time?
(cond
((> (mag (*v weft-position (vector 1 0 0))) 22)
(set! weft-count 0)
(set! draft-pos (+ draft-pos 1))
(cond ((> draft-pos draft-size)
(set! draft-pos 0)))
(set! weft-position (- (+ weft-position (vector 0 1.5 0))
weft-direction))
(set! weft-direction (* weft-direction -1))
(cond
((> 0 weft-direction) (right-selvedge (vector 0 1.5 0)))
((< 0 weft-direction) (left-selvedge (vector 0 1.5 0))))))
(write! vertex
(+ weft-z weft-position)
(+ weft-position (+ weft-z (vector 2 1 0)))
(+ weft-position (+ weft-z (vector 2 0 0)))
(+ weft-z weft-position)
(+ weft-position (+ weft-z (vector 2 1 0)))
(+ weft-position (+ weft-z (vector 0 1 0))))
(set! vertex (+ vertex 6)))
;;(set! t (+ t 0.01))
))))
;; weave section
;; top shed
;; bottom shed
;; back section
(define warp
(with-primitive
(make-jelly
3000 prim-triangles
10000 prim-triangles
'(let ((vertex positions-start)
(warp-end 0)
(warp-position (vector 0 0 0))
(shed 0)
(weft-t 0)
(draft-pos 0)
(draft-size 4)
(draft 1) (d-b 1) (d-c 0) (d-d 0)
(d-e 0) (d-f 1) (d-g 1) (d-h 0)
(d-i 0) (d-j 0) (d-k 1) (d-l 1)
(d-m 1) (d-n 0) (d-o 0) (d-p 1)
(draft-tmp 0)
(shed-tmp 0))
(define build-quad
(lambda (tl size)
(write! vertex
tl (+ tl size)
(+ tl (*v size (vector 1 0 0)))
tl (+ tl size)
(+ tl (*v size (vector 0 1 0))))
(set! vertex (+ vertex 6))))
(define animate-shed
(lambda (i v)
(set! shed-tmp (cond ((> v 0.5) (vector 0 0 3))
((< v 0.5) (vector 0 0 -3))))
(set! v (cond ((< v 0.5) (vector 0 0 3))
((> v 0.5) (vector 0 0 -3))))
(set! warp-end 0)
(loop (< warp-end 20)
(set! draft-tmp
(read (+ (addr draft) (+ (* draft-pos draft-size)
(modulo warp-end (+ draft-size (vector 0 1 1)) )))))
(cond ((> draft-tmp 0.5)
(write-add! (- i 6) 0 shed-tmp 0 0 shed-tmp shed-tmp
shed-tmp 0 shed-tmp shed-tmp))
((< draft-tmp 0.5)
(write-add! (- i 6) 0 v 0 0 v v
v 0 v v)))
(set! i (+ i 24))
(set! warp-end (+ warp-end 1)))))
(set! vertex positions-start)
; build 4 segments X warp-ends
(loop (< warp-end 20)
(set! warp-position (+ (vector -19 -35 0)
(* (vector 2 0 0) warp-end)))
(build-quad warp-position (vector 1 35 0))
(build-quad (+ warp-position (vector 0 35 0)) (vector 1 15 0))
(build-quad (+ warp-position (vector 0 50 0)) (vector 1 15 0))
(build-quad (+ warp-position (vector 0 65 0)) (vector 1 25 0))
(set! warp-end (+ warp-end 1)))
(forever
;; todo control externally
(set! weft-t (+ weft-t 0.05))
(cond ((> weft-t 1)
(set! draft-pos (+ draft-pos 1))
(cond ((> draft-pos draft-size)
(set! draft-pos 0)))
(set! weft-t 0)))
(set! vertex (+ positions-start 12))
(animate-shed vertex weft-t)
(set! shed (+ shed 5))
))))
(define weave-scale (vector 0.1 -0.1 0.1))
(with-primitive
warp
(hint-unlit)
; (texture (load-texture "thread.png"))
(scale weave-scale)
(pdata-index-map! (lambda (i t)
(cond
((eqv? (modulo i 6) 0) (vector 0 0 0))
((eqv? (modulo i 6) 1) (vector 1 10 0))
((eqv? (modulo i 6) 2) (vector 1 0 0))
((eqv? (modulo i 6) 3) (vector 0 0 0))
((eqv? (modulo i 6) 4) (vector 1 10 0))
((eqv? (modulo i 6) 5) (vector 0 10 0))
)) "t")
(pdata-map! (lambda (c) (vector 1 0.5 0.2)) "c")
(pdata-map! (lambda (n) (vector 0 0 0)) "n"))
(with-primitive
weft
(hint-unlit)
; (texture (load-texture "thread.png"))
(scale weave-scale)
(pdata-index-map! (lambda (i t)
(cond
((eqv? (modulo i 6) 0) (vector 0 0 0))
((eqv? (modulo i 6) 1) (vector 1 1 0))
((eqv? (modulo i 6) 2) (vector 1 0 0))
((eqv? (modulo i 6) 3) (vector 0 0 0))
((eqv? (modulo i 6) 4) (vector 1 1 0))
((eqv? (modulo i 6) 5) (vector 0 1 0))
)) "t")
(pdata-map! (lambda (c) (vector 0 0 1)) "c")
(pdata-map! (lambda (n) (vector 0 0 0)) "n"))
(every-frame
(with-primitive
weft
(when
(< (vy (vtransform (pdata-ref "x" 11) (get-transform))) 0)
(translate (vector 0 -0.1 0)))))
(t 0)
(v 0)
(np 0))
(forever
(set! vertex positions-start)
(loop (< vertex positions-end)
(set! np (+ (* (+ (read vertex) vertex) 0.1)
(swizzle yyx t)))
(set! v (+ (*v (noise np) (vector 1 0 0))
(*v (noise (+ np 101.1)) (vector 0 1 0))))
(set! v (*v (- v (vector 0.47 0.47 0.47)) (vector 0.1 0.1 0)))
(write-add! vertex v v v v v v)
(set! vertex (+ vertex 6)))
(set! t (+ t 0.01))
)))
(hint-unlit)
(pdata-index-map!
(lambda (i p)
(let ((z (* i 0.01)))
(if (odd? i)
(list-ref
(list (vector 0 0 z) (vector 1 0 z) (vector 1 1 z))
(modulo i 3))
(list-ref
(list (vector 1 1 z) (vector 0 1 z) (vector 0 0 z))
(modulo i 3))))) "p")
(texture (load-texture "raspberrypi.png"))
(translate (vector -0.5 -0.5 0))
(pdata-copy "p" "t")
(pdata-map! (lambda (t) (vmul t -1)) "t")
(pdata-map! (lambda (c) (vector 1 1 1)) "c")
(pdata-map! (lambda (n) (vector 0 0 0)) "n"))
assets/test.scm 0 → 100644
View file @ 66d36f82
(define test-vm (build-jellyfish 4096))
(define tests
'(let ((a 10))
(if (> a 0) (trace 1) (trace 0))
(if (< a 0) (trace 0) (trace 1))))
(disassemble-compiled tests)
(with-primitive
test-vm
(program-jelly
1 prim-triangles
tests))
main.cpp
View file @ 66d36f82
......@@ -416,7 +416,11 @@ int main(int argc, char *argv[])
tex=LoadPNG(ASSETS_LOCATION+"thread.png",w,h);
appLoadTexture("thread.png",w,h,(char *)tex);
appEval((char*)LoadFile(ASSETS_LOCATION+"jellyfish.scm").c_str());
// appEval((char*)LoadFile(ASSETS_LOCATION+"jellyfish.scm").c_str())
if (argc>1) {
appEval((char*)LoadFile(string(argv[1])).c_str());
}
// setup the repl thread
render_mutex = new pthread_mutex_t;
......
weavingcodes.scm 0 → 100644
View file @ 66d36f82
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; weavecoding raspberry pi installation
(define weft (build-jellyfish 4096))
(define warp (build-jellyfish 4096))
(define weave-scale (vector 0.1 -0.1 0.1))
(with-primitive
weft
(program-jelly
50 prim-triangles
'(let ((vertex positions-start)
(t 0)
(v 0)
(weft-direction (vector 2 0 0))
(weft-position (vector 0 0 0))
(weft-t 0)
(draft-pos 0)
(draft-size 4)
(draft 1) (d-b 0) (d-c 0) (d-d 1)
(d-e 1) (d-f 1) (d-g 0) (d-h 0)
(d-i 0) (d-j 1) (d-k 1) (d-l 0)
(d-m 0) (d-n 0) (d-o 1) (d-p 1)
(weft-z (vector 0 0 0))
(weft-count 0))
(define read-draft
(lambda ()
(read
(+ (addr draft)
(+ (* draft-pos draft-size)
(if (> weft-direction 0)
(modulo weft-count (+ draft-size (vector 0 1 1)) )
(- draft-size (modulo weft-count (+ draft-size (vector 0 1 1)) ))))))))
(define calc-weft-z
(lambda ()
(set! weft-count (+ weft-count 1))
(if (> (read-draft) 0.5)
(set! weft-z (vector 0 0 0.01))
(set! weft-z (vector 0 0 -0.01)))
))
(define right-selvedge
(lambda (gap)
;; top corner
(write! vertex
(- (+ weft-position (vector 2 0 0)) gap)
(- (+ weft-position (vector 3 1 0)) gap)
(- (+ weft-position (vector 2 1 0)) gap))
(set! vertex (+ vertex 3))
;; vertical connection
(write! vertex
(- (+ weft-position (vector 3 1 0)) gap)
(- (+ weft-position (vector 2 1 0)) gap)
(+ weft-position (vector 2 0 0))
(- (+ weft-position (vector 3 1 0)) gap)
(+ weft-position (vector 2 0 0))
(+ weft-position (vector 3 0 0)))
(set! vertex (+ vertex 6))
;; bottom corner
(write! vertex
(+ weft-position (vector 2 0 0))
(+ weft-position (vector 3 0 0))
(+ weft-position (vector 2 1 0)))
(set! vertex (+ vertex 3))
))
(define left-selvedge
(lambda (gap)
;; top corner
(write! vertex
(- (+ weft-position (vector 0 0 0)) gap)
(- (+ weft-position (vector -1 1 0)) gap)
(- (+ weft-position (vector 0 1 0)) gap))
(set! vertex (+ vertex 3))
;; vertical connection