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
b0540185
Commit
b0540185
authored
Jan 16, 2015
by
Dave Griffiths
Browse files
weaving code and compiler function arguments fix
parent
b760632d
Changes
7
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
268 additions
and
46 deletions
+268
-46
assets/compiler.scm
assets/compiler.scm
+16
-4
assets/jellyfish-old.scm
assets/jellyfish-old.scm
+67
-0
assets/jellyfish.scm
assets/jellyfish.scm
+179
-38
assets/thread.png
assets/thread.png
+0
-0
engine/importgl.h
engine/importgl.h
+1
-1
engine/jellyfish_primitive.cpp
engine/jellyfish_primitive.cpp
+3
-3
main.cpp
main.cpp
+2
-0
No files found.
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
100
00
prim-triangles
5
00
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
)))))
assets/thread.png
0 → 100644
View file @
b0540185
1.41 KB
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
());
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment