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
c0430935
Commit
c0430935
authored
Jan 18, 2015
by
Dave Griffiths
Browse files
sorted out cons (converted to ifs) and added when
parent
58ea31bb
Changes
8
Hide whitespace changes
Inline
Side-by-side
README.md
View file @
c0430935
...
...
@@ -52,10 +52,10 @@ The purpose of a Jellyfish Lisp program is to manipulate 3D objects in a
scene, move/rotate/scale or change vertex positions, lighting normals,
texture coords. It can also act on input from outside. It can do this
faster than in interpreted Scheme, particually on ARM devices as the VM
(written in C++) is very small and doesn't require any memory
allocation
. The VM also has access to more
data than a GPU shader,
although tight coupling to GPU functionality (ie
running parts of the VM
on GPU cores) is planned.
(written in C++) is very small and doesn't require any memory
allocation
so no garbage collection is required
. The VM also has access to more
data than a GPU shader,
although tight coupling to GPU functionality (ie
running parts of the VM
on GPU cores) is planned.
Jellyfish Lisp programs are compiled to bytecode executed by the VM -
there is one per object potentially running in parallel threads. The
...
...
@@ -95,20 +95,39 @@ Willdo...
(let ((name value) (name value) ...))
Note:
Scoping is not yet implemented, so all names are global.
True for function arguments also.
Normal binding of names to values. All values are vectors of lenght 3,
but can be specified as single numbers for convenience.
Tofix: Let bindings are not scoped correctly, varables can be referred
to after scope is closed and conflict with function parameters and other
let variables of the same name.
*
define
(define name value)
Tofix: scoping problem same as let.
*
if
(if pred true-expr false-expr)
Normal if expression - can be used as in normal scheme for example:
(define a (if (< 1 10) 100 200))
*
when
(when pred do-this-block)
Returns the value of the last expression if true, zero otherwise.
*
cond
(cond (pred block) (pred block) ...)
Note: currently evaluates all parts sequentially
Tofix: currently evaluates all parts sequentially, and sometimes doesn't
work remove and replace with syntatic version of 'if' forms...
*
loop
*
forever
...
...
@@ -155,4 +174,4 @@ add sub mul div abs scs atn dot crs
sqr len dup drp cmp shf bld ret dbg
nrm mst mad msb swp rnd mull
jmr ldlv lensq noise lds sts mulv
synth-crt synth-con synth-ply flr
synth-crt synth-con synth-ply flr
assets/compiler.scm
View file @
c0430935
...
...
@@ -195,22 +195,6 @@
(
define
(
emit-addr
x
)
(
emit
(
vector
ldl
(
variable-address
(
cadr
x
))
0
)))
(
define
(
emit-cond-part
x
)
(
let
((
block
(
emit-expr-list
(
cdr
x
))))
(
append
(
emit-expr
(
car
x
))
(
emit
(
vector
jmz
(
+
(
length
block
)
1
)
0
))
block
)))
(
define
(
emit-cond
x
)
(
define
(
_
l
)
(
cond
((
null?
l
)
'
())
(
else
(
append
(
emit-cond-part
(
car
l
))
(
_
(
cdr
l
))))))
(
_
(
cdr
x
)))
(
define
(
emit-if
x
)
(
let
((
tblock
(
emit-expr
(
caddr
x
)))
(
fblock
(
emit-expr
(
cadddr
x
))))
...
...
@@ -221,6 +205,14 @@
(
emit
(
vector
jmr
(
+
(
length
fblock
)
1
)
0
))
fblock
)))
(
define
(
emit-when
x
)
(
let
((
block
(
emit-expr-list
(
cddr
x
))))
(
append
(
emit-expr
(
cadr
x
))
(
emit
(
vector
jmz
(
+
(
length
block
)
2
)
0
))
block
(
emit
(
vector
jmr
2
0
))
(
emit
(
vector
ldl
0
0
)))))
(
define
(
emit-fncall
x
addr
)
(
let
((
args
(
emit-expr-list-maintain-stack
(
cdr
x
))))
...
...
@@ -458,8 +450,8 @@
(
cond
((
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
)
(
emit-if
x
))
((
eq?
(
car
x
)
'when
)
(
emit-when
x
))
((
eq?
(
car
x
)
'loop
)
(
emit-loop
x
))
((
eq?
(
car
x
)
'do
)
(
emit-expr-list
(
cdr
x
)))
(
else
(
emit-procedure
x
)))
...
...
@@ -554,6 +546,15 @@
(
cdr
x
))))))))
(
define
(
preprocess-cond-to-if
x
)
(
define
(
_
l
)
(
cond
((
null?
l
)
0
)
((
eq?
(
pre-process
(
caar
l
))
'else
)
(
cons
'do
(
pre-process
(
cdr
(
car
l
)))))
(
else
(
list
'if
(
pre-process
(
caar
l
))
(
cons
'do
(
pre-process
(
cdr
(
car
l
))))
(
_
(
cdr
l
))))))
(
_
(
cdr
x
)))
;; basically diy-macro from the main tinyscheme stuff
(
define
(
pre-process
s
)
(
cond
...
...
@@ -571,6 +572,8 @@
((
eq?
(
car
i
)
'--!
)
(
let
((
v
(
pre-process
(
cadr
i
))))
(
list
'set!
v
(
list
'-
v
1
))))
((
eq?
(
car
i
)
'cond
)
(
preprocess-cond-to-if
i
))
((
eq?
(
car
i
)
'play-now
)
(
append
(
list
'do
)
...
...
assets/test.scm
View file @
c0430935
...
...
@@ -4,9 +4,41 @@
'
(
let
((
a
10
))
(
if
(
>
a
0
)
(
trace
1
)
(
trace
0
))
(
if
(
<
a
0
)
(
trace
0
)
(
trace
1
))
(
trace
(
read
reg-control
))
(
write!
1000
(
vector
999
999
999
))
(
trace
(
read
reg-control
))
(
if
(
eq?
(
read
1000
)
(
vector
999
999
999
))
(
trace
1
)
(
trace
0
))
(
if
(
eq?
(
read
1000
)
(
vector
990
999
999
))
(
trace
0
)
(
trace
1
))
(
define
zzz
99
)
(
when
(
eq?
zzz
99
)
(
trace
1
))
(
when
(
eq?
zzz
88
)
(
trace
0
))
(
let
((
b
1
))
(
trace
b
))
(
trace
b
)
;; <-- fixme!
(
cond
((
eq?
1
1
)
(
trace
1
))
((
eq?
2
2
)
(
trace
0
)))
(
cond
((
eq?
2
1
)
(
trace
0
))
((
eq?
2
2
)
(
trace
1
)))
(
cond
((
eq?
2
1
)
(
trace
0
))
((
eq?
2
3
)
(
trace
0
))
(
else
(
trace
1
)))
(
loop
(
<
a
20
)
(
when
(
<
a
15
)
(
write-add!
1000
1
2
3
4
5
)
(
trace
99
)
)
(
cond
((
eq?
2
1
)
(
trace
0
))
((
eq?
2
3
)
(
trace
0
))
(
else
(
trace
1
)))
(
++!
a
)
)
))
(
disassemble-compiled
tests
)
...
...
engine/nomadic.cpp
View file @
c0430935
...
...
@@ -40,10 +40,13 @@ void appInit()
FILE
*
log_file
=
stdout
;
scheme_set_input_port_file
(
sc
,
stdin
);
#else
FILE
*
log_file
=
fopen
(
"/sdcard/
jellyfish
-log.txt"
,
"w"
);
FILE
*
log_file
=
fopen
(
"/sdcard/
symbai/symbai
-log
2
.txt"
,
"w"
);
#endif
#endif
if
(
log_file
!=
NULL
)
scheme_set_output_port_file
(
sc
,
log_file
);
fprintf
(
log_file
,
"testing...
\n
"
);
fflush
(
log_file
);
}
void
initGL
()
...
...
main.cpp
View file @
c0430935
...
...
@@ -331,14 +331,14 @@ void DisplayCallback()
appRender
(
w
,
h
);
glutSwapBuffers
();
#endif
/*
static char fn[256];
sprintf(fn,"shot-%0.4d.jpg",frame_num);
cerr<<fn<<endl;
WriteJPG(GetScreenBuffer(0, 0, w, h, 1),
fn,"",0,0,w,h,95,1);
frame_num++;
*/
pthread_mutex_unlock
(
render_mutex
);
}
//else { printf("locked\n"); }
}
...
...
scheme/opdefines.h
View file @
c0430935
...
...
@@ -196,6 +196,8 @@
_OP_DEF
(
opexe_6
,
"db-open"
,
1
,
1
,
TST_NONE
,
OP_OPEN_DB
)
_OP_DEF
(
opexe_6
,
"db-exec"
,
2
,
INF_ARG
,
TST_NONE
,
OP_EXEC_DB
)
_OP_DEF
(
opexe_6
,
"db-insert"
,
2
,
INF_ARG
,
TST_NONE
,
OP_INSERT_DB
)
// _OP_DEF(opexe_6, "db-insert-blob", 5, 5, TST_NONE, OP_INSERT_BLOB_DB )
// _OP_DEF(opexe_6, "db-select-blob", 5, 5, TST_NONE, OP_SELECT_BLOB_DB )
_OP_DEF
(
opexe_6
,
"db-status"
,
1
,
1
,
TST_NONE
,
OP_STATUS_DB
)
_OP_DEF
(
opexe_6
,
"time-of-day"
,
0
,
0
,
TST_NONE
,
OP_TIME
)
_OP_DEF
(
opexe_6
,
"date-time"
,
0
,
0
,
TST_NONE
,
OP_DATETIME
)
...
...
scheme/scheme.cpp
View file @
c0430935
...
...
@@ -281,6 +281,9 @@ INTERFACE INLINE void setimmutable(pointer p) { typeflag(p) |= T_IMMUTABLE; }
#define cddr(p) cdr(cdr(p))
#define cadar(p) car(cdr(car(p)))
#define caddr(p) car(cdr(cdr(p)))
#define cadddr(p) car(cdr(cdr(cdr(p))))
#define caddddr(p) car(cdr(cdr(cdr(cdr(p)))))
#define cadddddr(p) car(cdr(cdr(cdr(cdr(cdr(p))))))
#define cdaar(p) cdr(car(car(p)))
#define cadaar(p) car(cdr(car(car(p))))
#define cadddr(p) car(cdr(cdr(cdr(p))))
...
...
@@ -4279,6 +4282,118 @@ pointer db_exec(scheme* sc, db *d) {
return
ret
;
}
// blob stuff, unfortunately need to be prepared to match with eavdb
static
int
insert_blob
(
sqlite3
*
db
,
/* Database to insert data into */
const
char
*
table
,
/* Null-terminated key string */
const
char
*
key1
,
/* Null-terminated key string */
const
char
*
key2
,
/* Null-terminated key string */
const
unsigned
char
*
blob
,
/* Pointer to blob of data */
int
size
/* Length of data pointed to by zBlob */
)
{
char
sql
[
1024
];
snprintf
(
sql
,
1024
,
"insert into %s_value_blob values(null, ?, ?, ?, 0)"
,
table
);
sqlite3_stmt
*
pStmt
;
int
rc
;
do
{
rc
=
sqlite3_prepare
(
db
,
sql
,
-
1
,
&
pStmt
,
0
);
if
(
rc
!=
SQLITE_OK
){
return
rc
;
}
sqlite3_bind_text
(
pStmt
,
1
,
key1
,
-
1
,
SQLITE_STATIC
);
sqlite3_bind_text
(
pStmt
,
2
,
key2
,
-
1
,
SQLITE_STATIC
);
sqlite3_bind_blob
(
pStmt
,
3
,
blob
,
size
,
SQLITE_STATIC
);
rc
=
sqlite3_step
(
pStmt
);
rc
=
sqlite3_finalize
(
pStmt
);
}
while
(
rc
==
SQLITE_SCHEMA
);
return
rc
;
}
int
insert_file_blob
(
sqlite3
*
db
,
const
char
*
table
,
const
char
*
key1
,
const
char
*
key2
,
const
char
*
filename
)
{
FILE
*
file
=
fopen
(
filename
,
"rb"
);
if
(
file
)
{
fseek
(
file
,
0
,
SEEK_END
);
long
size
=
ftell
(
file
);
fseek
(
file
,
0
,
SEEK_SET
);
unsigned
char
*
buffer
=
new
unsigned
char
[
size
];
long
s
=
(
long
)
fread
(
buffer
,
1
,
size
,
file
);
fclose
(
file
);
insert_blob
(
db
,
table
,
key1
,
key2
,
buffer
,
size
);
delete
[]
buffer
;
return
0
;
}
printf
(
"insert_file_blob couldn't open %s
\n
"
,
filename
);
return
-
1
;
}
static
int
select_blob
(
sqlite3
*
db
,
/* Database containing blobs table */
const
char
*
table
,
/* Null-terminated key to retrieve blob for */
const
char
*
key1
,
/* Null-terminated key to retrieve blob for */
const
char
*
key2
,
/* Null-terminated key to retrieve blob for */
unsigned
char
**
blob
,
/* Set *pzBlob to point to the retrieved blob */
int
*
size
/* Set *pnBlob to the size of the retrieved blob */
)
{
char
sql
[
1024
];
snprintf
(
sql
,
1024
,
"select value from %s_value_blob where entity_id = ? and attribute_id = ?"
,
table
);
sqlite3_stmt
*
pStmt
;
int
rc
;
*
blob
=
0
;
*
size
=
0
;
do
{
/* Compile the SELECT statement into a virtual machine. */
rc
=
sqlite3_prepare
(
db
,
sql
,
-
1
,
&
pStmt
,
0
);
if
(
rc
!=
SQLITE_OK
){
return
rc
;
}
/* Bind the key to the SQL variable. */
sqlite3_bind_text
(
pStmt
,
1
,
key1
,
-
1
,
SQLITE_STATIC
);
sqlite3_bind_text
(
pStmt
,
1
,
key2
,
-
1
,
SQLITE_STATIC
);
rc
=
sqlite3_step
(
pStmt
);
if
(
rc
==
SQLITE_ROW
){
*
size
=
sqlite3_column_bytes
(
pStmt
,
0
);
*
blob
=
(
unsigned
char
*
)
malloc
(
*
size
);
memcpy
(
*
blob
,
sqlite3_column_blob
(
pStmt
,
0
),
*
size
);
}
rc
=
sqlite3_finalize
(
pStmt
);
}
while
(
rc
==
SQLITE_SCHEMA
);
return
rc
;
}
int
select_file_blob
(
sqlite3
*
db
,
const
char
*
table
,
const
char
*
key1
,
const
char
*
key2
,
const
char
*
filename
)
{
FILE
*
file
=
fopen
(
filename
,
"wb"
);
if
(
file
)
{
int
size
;
unsigned
char
*
blob
;
select_blob
(
db
,
table
,
key1
,
key2
,
&
blob
,
&
size
);
fwrite
(
blob
,
1
,
size
,
file
);
fclose
(
file
);
free
(
blob
);
return
0
;
}
printf
(
"select_file_blob couldn't open %s
\n
"
,
filename
);
return
-
1
;
}
#endif
static
pointer
opexe_6
(
scheme
*
sc
,
enum
scheme_opcodes
op
)
{
...
...
@@ -4382,6 +4497,23 @@ static pointer opexe_6(scheme *sc, enum scheme_opcodes op) {
#endif
s_return
(
sc
,
sc
->
F
);
}
/* case OP_INSERT_BLOB_DB: {
#ifndef FLX_RPI
if (is_string(car(sc->args)) &&
is_string(caddr(sc->args)) &&
is_string(cadddr(sc->args)) &&
is_string(caddddr(sc->args)) &&
is_string(cadddddr(sc->args))) {
db *d=the_db_container.get(string_value(car(sc->args)));
if (d!=NULL)
{
db_exec(sc,d);
s_return(sc,mk_integer(sc,d->last_rowid()));
}
}
#endif
s_return(sc,sc->F);
} */
case
OP_STATUS_DB
:
{
#ifndef FLX_RPI
if
(
is_string
(
car
(
sc
->
args
)))
{
...
...
weavingcodes.scm
View file @
c0430935
...
...
@@ -18,12 +18,13 @@
(
weft-t
0
)
(
draft-pos
0
)
(
draft-size
4
)
(
draft
1
)
(
d-b
0
)
(
d-c
1
)
(
d-d
0
)
(
d-e
0
)
(
d-f
1
)
(
d-g
0
)
(
d-h
1
)
(
d-i
1
)
(
d-j
0
)
(
d-k
1
)
(
d-l
0
)
(
d-m
0
)
(
d-n
1
)
(
d-o
0
)
(
d-p
1
)
(
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
))
(
weft-count
0
)
(
weft-total
21
))
(
define
read-draft
(
lambda
()
...
...
@@ -32,7 +33,7 @@
(
+
(
*
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
))
)))))))
)
(
modulo
(
-
(
-
weft-total
1
)
weft-count
)
(
+
draft-size
(
vector
0
1
1
))
)))))))
(
define
calc-weft-z
(
lambda
()
...
...
@@ -99,18 +100,17 @@
(
calc-weft-z
)
(
set!
weft-position
(
+
weft-position
weft-direction
))
;; selvedge time?
(
cond
((
>
weft-count
21
)
(
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
))))))
(
when
(
>
weft-count
weft-total
)
(
set!
weft-count
0
)
(
set!
draft-pos
(
+
draft-pos
1
))
(
when
(
>
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
))
(
if
(
>
0
weft-direction
)
(
right-selvedge
(
vector
0
1.5
0
))
(
left-selvedge
(
vector
0
1.5
0
))))
(
set!
weft-t
(
/
weft-count
21
))
...
...
@@ -156,10 +156,10 @@
(
weft-t
0
)
(
draft-pos
0
)
(
draft-size
4
)
(
draft
1
)
(
d-b
0
)
(
d-c
1
)
(
d-d
0
)
(
d-e
0
)
(
d-f
1
)
(
d-g
0
)
(
d-h
1
)
(
d-i
1
)
(
d-j
0
)
(
d-k
1
)
(
d-l
0
)
(
d-m
0
)
(
d-n
1
)
(
d-o
0
)
(
d-p
1
)
(
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
)
(
last-t
0
))
(
define
build-quad
...
...
@@ -187,12 +187,9 @@
(
vector
0
0
0
))))
(
set!
warp-end
0
)
(
loop
(
<
warp-end
20
)
(
if
(
>
(
read-draft
)
0.5
)
(
+
1
1
)
;(write-sub! (- i 6) 0 v 0 0 v v
; v 0 v v)
(
write-add!
(
-
i
6
)
0
v
0
0
v
v
v
0
v
v
))
(
when
(
<
(
read-draft
)
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
)))))
...
...
@@ -215,10 +212,10 @@
(
set!
vertex
(
+
positions-start
12
))
(
animate-shed
vertex
)
(
cond
(
(
>
(
-
last-t
weft-t
)
0.1
)
(
set!
draft-pos
(
+
draft-pos
1
))
(
cond
(
(
>
draft-pos
draft-size
)
(
set!
draft-pos
0
))
)
(
build-warp
))
)
(
when
(
>
(
-
last-t
weft-t
)
0.1
)
(
set!
draft-pos
(
+
draft-pos
1
))
(
when
(
>
draft-pos
draft-size
)
(
set!
draft-pos
0
))
(
build-warp
))
(
set!
last-t
weft-t
)
)))
...
...
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