Commit de6a186a authored by Dave Griffiths's avatar Dave Griffiths

added tablet weaving/livecoding sketch

parent 0ef23091
......@@ -7,7 +7,7 @@ html, body {
font-family: 'amatic';
color: #000;
font-size: 20;
background: #fff;
background: #777;
// cursor: url(images/mouse.png), default;
}
......
......@@ -215,7 +215,7 @@ ditto.comp_begin = function(args) {
// adding semicolon here
"{\n"+ditto.list_map(ditto.comp,eexpr).join(";\n")+"\n"+
"return "+ditto.comp(last)+"\n}\n";
}
};
// ( ((arg1 exp1) (arg2 expr2) ...) body ...)
ditto.comp_let = function(args) {
......@@ -293,6 +293,8 @@ ditto.core_forms = function(fn, args) {
// var debug = "// generating: "+fn+"\n";
var debug = "/* "+fn+" */ ";
if (fn == "quote") return JSON.stringify(args);
// core forms
if (fn == "lambda") if (ditto.check(fn,args,2,-1)) return debug+ditto.comp_lambda(args);
if (fn == "if") if (ditto.check(fn,args,3,3)) return debug+ditto.comp_if(args);
......@@ -497,6 +499,7 @@ ditto.is_number = function(str) {
return ditto.char_is_number(str[0]);
};
ditto.comp = function(f) {
// console.log(f);
try {
......@@ -562,6 +565,14 @@ ditto.load_unparsed = function(url) {
};
ditto.clear = function(id)
{
var n = document.getElementById(id);
while (n.firstChild) {
n.removeChild(n.firstChild);
}
}
ditto.to_page = function(id,html)
{
var div=document.createElement("div");
......@@ -570,6 +581,46 @@ ditto.to_page = function(id,html)
document.getElementById(id).appendChild(div);
};
ditto.log = function(msg)
{
ditto.to_page("output",msg);
};
var corecode = "";
function ditto_eval_element(id) {
ditto.clear("output");
ditto.clear("compiled");
var js="";
var el = document.getElementById(id);
var code = $("#id_code").val();
js += "\n"+ditto.compile_code(code);
ditto.to_page("compiled",js);
try {
eval(corecode+js);
} catch (e) {
ditto.to_page("output", "An error occured while evaluating ");
ditto.to_page("output",e);
ditto.to_page("output",e.stack);
}
}
function ditto_eval_element_wrap(id,header,footer) {
ditto.clear("output");
ditto.clear("compiled");
var js="";
var el = document.getElementById(id);
var code = $("#id_code").val();
js += "\n"+ditto.compile_code(header+code+footer);
ditto.to_page("compiled",js);
try {
eval(corecode+js);
} catch (e) {
ditto.to_page("output", "An error occured while evaluating ");
ditto.to_page("output",e);
ditto.to_page("output",e.stack);
}
}
function init(filenames) {
......@@ -586,7 +637,7 @@ function init(filenames) {
console.log(e.stack);
}
var js=ditto.load("scm/base.jscm");
corecode=ditto.load("scm/base.jscm");
/*js+=ditto.load("scm/webgl.scm");
js+=ditto.load("scm/texture.scm");
js+=ditto.load("scm/maths.scm");
......@@ -598,15 +649,15 @@ function init(filenames) {
js+=ditto.load("scm/renderer.scm");
js+=ditto.load("scm/fluxus.scm");
js+=ditto.load("scm/gfx.scm");*/
js+=ditto.load("scm/nightjar.jscm");
corecode+=ditto.load("scm/nightjar.jscm");
filenames.forEach(function(filename) {
js+=ditto.load(filename);
corecode+=ditto.load(filename);
});
try {
eval(js);
eval(corecode);
} catch (e) {
//console.log("An error occured parsing "+js);
console.log(e);
......
......@@ -16,7 +16,7 @@
;; basic scheme stuff we need, and some tests
(define display (lambda (str) (console.log str)))
(define display (lambda (str) (console.log str) (ditto.log str)))
(define newline (lambda () (console.log "\n")))
(define (msg a) (display a))
(define (dbg a) (msg a) a)
......@@ -33,6 +33,16 @@
(define (max a b) (if (> a b) a b))
(define (min a b) (if (< a b) a b))
(define (equal? a b)
(cond
((and (list? a) (list? b))
(list-equal? a b))
(else
(eq? a b))))
(define (cddr l)
(cdr (cdr l)))
;; replaced by underlying iterative version
;;(define foldl
;; (lambda (fn v l)
......
......@@ -115,9 +115,9 @@
31 (lambda (i)
(read-line (string-append "lift-" (+ i 1)) 4)))
(repeat (list "fat" "fat-dark") 13)))
(repeat (list "fat" "fat" "fat-dark") 13)))
(set! weave
(loom-weave l (repeat (list "fat-dark" "fat") 15) 0))
(loom-weave l (repeat (list "fat" "fat" "fat-dark" ) 15) 0))
)
(define update-tick 0)
......
;; loom setup
;; warp weave
;; ___
;; /----|o o|---####\
;; \----|o o|---####/
;; ---
;;
;; forward rotation
;; a b > d a > d c > b d
;; d c > c b > b a > a c
;;
;; backwards
;; a b > b c
;; d c > a d
;;
;; sideways rotation
;; a b > b a
;; d c > c d
;;
;; weaving (this took a while to figure out)
;;
;; turn f f f b f b b
;; top-> a[b] d[a] c[d] [d]a c[d] [d]a [a]b
;; bot-> [d]c [c]b [b]a c[b][b]a c[b] d[c]
(define (flip a)
(if (equal? a "s") "z" "s"))
(define (card angle a b d c) (list angle a b d c "f"))
(define (card-angle c) (list-ref c 0))
(define (card-a c) (list-ref c 1))
(define (card-b c) (list-ref c 2))
(define (card-d c) (list-ref c 3))
(define (card-c c) (list-ref c 4))
(define (card-memory c) (list-ref c 5))
(define (card-print c)
(display (card-a c))(display " ")(display (card-b c))(newline)
(display (card-d c))(display " ")(display (card-c c))(newline))
(define (card-forward c)
(list
(card-angle c)
(card-d c) (card-a c)
(card-c c) (card-b c)
"f"))
(define (card-back c)
(list
(card-angle c)
(card-b c) (card-c c)
(card-a c) (card-d c)
"b"))
(define (card-flip c)
(list
(flip (card-angle c))
(card-b c) (card-a c)
(card-c c) (card-d c)
(card-memory c)))
(define (card-weave c)
(if (equal? (card-memory c) "f")
(list (card-b c) (card-d c))
(list (card-a c) (card-c c))))
(define (card-loom cards) (list cards))
(define (card-loom-cards c) (list-ref c 0))
(define (card-loom-all-forward c)
(card-loom
(map
(lambda (card)
(card-forward card))
(card-loom-cards c))))
(define (card-loom-all-back c)
(card-loom
(map
(lambda (card)
(card-back card))
(card-loom-cards c))))
(define (in-list? l c)
(cond
((null? l) #f)
((equal? (car l) c) #t)
(else (in-list? (cdr l) c))))
(define (card-loom-flip loom c)
(define pos (- 0 1))
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-flip card) card))
(card-loom-cards loom))))
(define (card-loom-ind-forward loom c)
(define pos (- 0 1))
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-forward card) card))
(card-loom-cards loom))))
(define (card-loom-ind-back loom c)
(define pos (- 0 1))
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-back card) card))
(card-loom-cards loom))))
(define pos 10)
(define (card-loom-weave-top loom)
(define canvas (document.getElementById "canvas"))
(define ctx (canvas.getContext "2d"))
(set! pos (+ pos 14))
(index-for-each
(lambda (i card)
(let ((direction (if (eq? (card-angle card) "z") "front" "back"))
(colour (if (eq? (car (card-weave card)) "#") "black" "white")))
(ctx.drawImage (find-image (string-append "tabwarp-" direction "-" colour ".png"))
(* i 7) pos)))
(card-loom-cards loom))
(index-for-each
(lambda (i card)
(let ((direction (if (eq? (card-angle card) "s") "front" "back"))
(colour (if (eq? (cadr (card-weave card)) "#") "black" "white")))
(ctx.drawImage (find-image (string-append "tabwarp-" direction "-" colour ".png"))
(+ (* i 7) 80) pos)))
(card-loom-cards loom))
loom)
(define (card-loom-weave-top-ascii loom)
(display
(foldl
(lambda (card r)
(string-append r (car (card-weave card))
;;(if (equal? (card-angle card) "s") "\\" "/")
))
""
(card-loom-cards loom)))
(newline) loom)
(define (card-loom-multi loom fn c)
(cond
((zero? c) loom)
(else
(card-loom-multi
(card-loom-weave-top (fn loom)) fn (- c 1)))))
(define (card-loom-loop loom c commands)
(cond
((zero? c) loom)
(else
(card-loom-loop
(foldl
(lambda (command loom)
(card-loom-interpret loom command))
loom commands)
(- c 1) commands))))
(define (card-loom-interpret loom command)
(cond
((list? command)
(cond
((eq? (car command) "weave_forward")
(card-loom-multi loom card-loom-all-forward (cadr command)))
((eq? (car command) "weave_back")
(card-loom-multi loom card-loom-all-back (cadr command)))
((eq? (car command) "twist")
(card-loom-flip loom (cdr command)))
((eq? (car command) "rotate_forward")
(card-loom-ind-forward loom (cdr command)))
((eq? (car command) "rotate_back")
(card-loom-ind-back loom (cdr command)))
((eq? (car command) "repeat")
(card-loom-loop loom (cadr command) (cddr command)))
(else
(display "unknown function ")
(display (car command))(newline) loom)))
(else (display "unknown command ")(display command)(newline) loom)))
(define (card-loom-run loom code)
(cond
((null? code) loom)
(else
(card-loom-run
(card-loom-interpret loom (car code))
(cdr code)))))
(define (assert q)
(when (not q)
(display "test failed...")
(newline)))
(define (test)
(assert (equal? (card-forward
(card "s"
"#" "."
"." "."))
(list "s"
"." "#"
"." "." "f")))
(assert (equal? (card-forward
(card "s"
"#" "."
"." "#"))
(list "s"
"." "#"
"#" "." "f")))
(assert (equal? (card-back
(card "z"
"#" "#"
"." "."))
(list "z"
"#" "."
"#" "." "b")))
(assert (equal? (card-back
(card-back
(card "z"
"#" "."
"#" ".")))
(list "z"
"." "#"
"." "#" "b")))
(assert (equal? (card-forward
(card-forward
(card-forward
(card-forward
(card "s"
"1" "4"
"2" "3")))))
(list "s"
"1" "4"
"2" "3" "f")))
(assert (equal? (card-flip (card "s"
"1" "2"
"3" "4"))
(card "z"
"2" "1"
"4" "3")))
(assert (equal? (card-weave
(card "z"
"1" "2"
"4" "3")) (list "2" "4")))
(assert (equal? (card-weave
(card-back
(card "z"
"1" "2"
"4" "3"))) (list "2" "4")))
(assert (equal? (card-weave
(card-back
(card-back
(card "z"
"1" "2"
"4" "3")))) (list "3" "1")))
)
(test)
(define loom
(card-loom
(list
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
(card "z"
"#" "#"
"." ".")
)))
;(load-images!
; (append
; (list
; "tabwarp.png"
; "tabwarp-black.png"
; ))
; (lambda ()
; (display "ello")
; ))
#lang racket
;; loom setup
;; warp weave
;; ___
;; /----|o o|---####\
;; \----|o o|---####/
;; ---
;;
;; forward rotation
;; a b > d a > d c > b d
;; d c > c b > b a > a c
;;
;; backwards
;; a b > b c
;; d c > a d
;;
;; sideways rotation
;; a b > b a
;; d c > c d
;;
;; weaving (this took a while to figure out)
;;
;; turn f f f b f b b
;; top-> a[b] d[a] c[d] [d]a c[d] [d]a [a]b
;; bot-> [d]c [c]b [b]a c[b][b]a c[b] d[c]
(define (flip a)
(if (equal? a "s") "z" "s"))
(define (card angle a b d c) (list angle a b d c "f"))
(define (card-angle c) (list-ref c 0))
(define (card-a c) (list-ref c 1))
(define (card-b c) (list-ref c 2))
(define (card-d c) (list-ref c 3))
(define (card-c c) (list-ref c 4))
(define (card-memory c) (list-ref c 5))
(define (card-print c)
(display (card-a c))(display " ")(display (card-b c))(newline)
(display (card-d c))(display " ")(display (card-c c))(newline))
(define (card-forward c)
(list
(card-angle c)
(card-d c) (card-a c)
(card-c c) (card-b c)
"f"))
(define (card-back c)
(list
(card-angle c)
(card-b c) (card-c c)
(card-a c) (card-d c)
"b"))
(define (card-flip c)
(list
(flip (card-angle c))
(card-b c) (card-a c)
(card-c c) (card-d c)
(card-memory c)))
(define (card-weave c)
(if (equal? (card-memory c) "f")
(list (card-b c) (card-d c))
(list (card-a c) (card-c c))))
(define (card-loom cards) (list cards))
(define (card-loom-cards c) (list-ref c 0))
(define (card-loom-all-forward c)
(card-loom
(map
(lambda (card)
(card-forward card))
(card-loom-cards c))))
(define (card-loom-all-back c)
(card-loom
(map
(lambda (card)
(card-back card))
(card-loom-cards c))))
(define (in-list? l c)
(cond
((null? l) #f)
((equal? (car l) c) #t)
(else (in-list? (cdr l) c))))
(define (card-loom-flip loom c)
(define pos -1)
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-flip card) card))
(card-loom-cards loom))))
(define (card-loom-ind-forward loom c)
(define pos -1)
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-forward card) card))
(card-loom-cards loom))))
(define (card-loom-ind-back loom c)
(define pos -1)
(card-loom
(map
(lambda (card)
(set! pos (+ pos 1))
(if (in-list? c pos)
(card-back card) card))
(card-loom-cards loom))))
(define (card-loom-weave-top c)
(for-each
(lambda (card)
(display (car (card-weave card)))
(display
(if (equal? (card-angle card) "s") #\\ #\/)))
(card-loom-cards c))
(newline) c)
(define (card-loom-multi loom fn c)
(cond
((zero? c) loom)
(else
(card-loom-multi
(card-loom-weave-top (fn loom)) fn (- c 1)))))
(define (card-loom-interpret loom command)
(cond
((list? command)
(cond
((equal? (car command) 'weave-forward)
(card-loom-multi loom card-loom-all-forward (cadr command)))
((equal? (car command) 'weave-back)
(card-loom-multi loom card-loom-all-back (cadr command)))
((equal? (car command) 'twist)
(card-loom-flip loom (cdr command)))
((equal? (car command) 'rotate-forward)
(card-loom-ind-forward loom (cdr command)))
((equal? (car command) 'rotate-back)
(card-loom-ind-back loom (cdr command)))
(else
(display "unknown function ")
(display (car command))(newline) loom)))
(else (display "unknown command ")(display command)(newline) loom)))
(define (card-loom-run loom code)
(cond
((null? code) loom)
(else
(card-loom-run
(card-loom-weave-top
(card-loom-interpret loom (car code)))
(cdr code)))))
(define (assert q)
(if (not q) (error "test failed...")
(display "test passed..."))
(newline))
(define (test)
(assert (equal? (card-forward