Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Dave Griffiths
jellyfish
Commits
66d36f82
Commit
66d36f82
authored
Jan 17, 2015
by
Dave Griffiths
Browse files
added if, started sanity process
parent
68006595
Changes
8
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
3
000
prim-triangles
10
000
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