Skip to content

GitLab

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

weaving code and compiler function arguments fix

parent b760632d
Hide whitespace changes
Inline Side-by-side
Showing with 268 additions and 46 deletions
assets/compiler.scm
View file @ b0540185
......@@ -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
......
assets/jellyfish-old.scm 0 → 100644
View file @ b0540185
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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 @ b0540185
......@@ -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)))))
engine/importgl.h
View file @ b0540185
......@@ -42,7 +42,7 @@
#endif
extern "C" {
#include "GL/glew.h"
//#include "GL/glew.h"
#ifndef __APPLE__
#include "GL/glut.h"
......
engine/jellyfish_primitive.cpp
View file @ b0540185
......@@ -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 );
}
}
......
main.cpp
View file @ b0540185
......@@ -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