Commit b0540185 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

weaving code and compiler function arguments fix

parent b760632d
......@@ -2,6 +2,7 @@
;; vectorlisp: a strange language for procedural rendering
(define debug #f)
(define prim-size 4096)
(define nop 0) (define jmp 1) (define jmz 2) (define jlt 3) (define jgt 4)
(define ldl 5) (define lda 6) (define ldi 7) (define sta 8) (define sti 9)
......@@ -66,7 +67,7 @@
addr))
;; segments are data areas, positions, normals, colours etc
(define segment-size 512)
(define segment-size prim-size)
(define (memseg n) (* segment-size n))
......@@ -142,6 +143,17 @@
(emit (vector drp 0 0))
(emit-expr-list (cdr l))))))))
;; append a bunch of expressions, don't drop
;; as we want to build the stack (for fn call)
(define (emit-expr-list-maintain-stack l)
(cond
((null? l) '())
(else
(append (emit-expr (car l))
(if (null? (cdr l)) '()
(emit-expr-list-maintain-stack (cdr l)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; primitive function calls follow
......@@ -216,7 +228,7 @@
(_ (cdr x)))
(define (emit-fncall x addr)
(let ((args (emit-expr-list (cdr x))))
(let ((args (emit-expr-list-maintain-stack (cdr x))))
(append
;; offset from here -> stitch up in second pass
(emit (list 'add-abs-loc 'this 1
......@@ -234,7 +246,7 @@
;; for moment use global pile for arguments :O
(make-variable! arg)
(vector sta (variable-address arg) 0))
(cadr x))
(reverse (cadr x)))
;; now args are loaded, do body
(emit-expr-list (cddr x))
;; swap ret ptr to top
......@@ -462,7 +474,7 @@
(define (header code-start cycles prim hints)
(list
(vector code-start cycles 0) ;; control (pc, cycles, stack)
(vector 512 prim hints) ;; graphics
(vector prim-size prim hints) ;; graphics
(vector 0 0 0) ;; translate
(vector 1 0 0) ;; rota
(vector 0 1 0) ;; rotb
......
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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"))
......@@ -11,9 +11,8 @@
(define jellyfish
(list
(build-jellyfish 512)
(build-jellyfish 512)
(build-jellyfish 512)))
(build-jellyfish 4096)
(build-jellyfish 4096)))
(define current 0)
......@@ -23,45 +22,187 @@
(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 3 0 0))
(weft-position (vector 0 0 0)))
(with-primitive
(define right-selvedge
(lambda (gap)
;; top corner
(write! vertex
(- (+ weft-position (vector 3 0 0)) gap)
(- (+ weft-position (vector 4 1 0)) gap)
(- (+ weft-position (vector 3 1 0)) gap))
(set! vertex (+ vertex 3))
;; vertical connection
(write! vertex
(- (+ weft-position (vector 4 1 0)) gap)
(- (+ weft-position (vector 3 1 0)) gap)
(+ weft-position (vector 3 0 0))
(- (+ weft-position (vector 4 1 0)) gap)
(+ weft-position (vector 3 0 0))
(+ weft-position (vector 4 0 0)))
(set! vertex (+ vertex 6))
;; bottom corner
(write! vertex
(+ weft-position (vector 3 0 0))
(+ weft-position (vector 4 0 0))
(+ weft-position (vector 3 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-position (+ weft-position weft-direction))
;; selvedge time?
(cond
((> (mag (*v weft-position (vector 1 0 0))) 40)
(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-position
(+ weft-position (vector 3 1 0))
(+ weft-position (vector 3 0 0))
weft-position
(+ weft-position (vector 3 1 0))
(+ weft-position (vector 0 1 0)))
(set! vertex (+ vertex 6)))
;;(set! t (+ t 0.01))
))))
;; weave section
;; top shed
;; bottom shed
;; back section
(define warp
(make-jelly
10000 prim-triangles
500 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"))
(warp-end 0)
(warp-position (vector 0 0 0))
(shed 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! warp-end 0)
(loop (< warp-end 10)
(write-add! (- i 6) 0 v 0 0 v v)
(write-add! i 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 10)
(set! warp-position (+ (vector -25 -35 0)
(* (vector 5 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
(set! vertex (+ positions-start 12))
(animate-shed vertex (*v (vector 1 0 0) (* (sincos shed) 1)))
(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 1 1)) "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 1 1 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)))))
......@@ -42,7 +42,7 @@
#endif
extern "C" {
#include "GL/glew.h"
//#include "GL/glew.h"
#ifndef __APPLE__
#include "GL/glut.h"
......
......@@ -55,9 +55,9 @@ jellyfish_primitive::~jellyfish_primitive()
void jellyfish_primitive::execute() {
for (int i=0; i<m_machine->peekiy(REG_CONTROL); i++) {
m_machine->run();
// m_machine->pretty_dump();
// char cmd_str[80];
// fgets( cmd_str, 80, stdin );
// m_machine->pretty_dump();
//char cmd_str[80];
//fgets( cmd_str, 80, stdin );
}
}
......
......@@ -413,6 +413,8 @@ int main(int argc, char *argv[])
appLoadTexture("raspberrypi.png",w,h,(char *)tex);
tex=LoadPNG(ASSETS_LOCATION+"stripes.png",w,h);
appLoadTexture("stripes.png",w,h,(char *)tex);
tex=LoadPNG(ASSETS_LOCATION+"thread.png",w,h);
appLoadTexture("thread.png",w,h,(char *)tex);
appEval((char*)LoadFile(ASSETS_LOCATION+"jellyfish.scm").c_str());
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment