Commit 2019544d authored by Dave Griffiths's avatar Dave Griffiths
Browse files

ported from old version

LOCAL_PATH := $(call my-dir)
include $(CLEAR_VARS)
#include ${ANDROID_NDK_ROOT}\sources\cxx-stl\stlport\stlport
LOCAL_MODULE := starwisp-core
APP_OPTIM := release
fluxa/Sample.cpp \
fluxa/Allocator.cpp \
fluxa/Graph.cpp \
fluxa/GraphNode.cpp \
fluxa/Modules.cpp \
fluxa/ModuleNodes.cpp \
core/list.cpp \
core/db.cpp \
core/db_container.cpp \
core/fixed.cpp \
core/geometry.cpp \
core/idmap.cpp \
core/noise.cpp \
sqlite/sqlite3.c \
scheme/scheme.cpp \
engine/primitive.cpp \
engine/text_primitive.cpp \
engine/scenenode.cpp \
engine/scenegraph.cpp \
engine/texture.cpp \
engine/importgl.c \
engine/obj_reader.cpp \
engine/nomadic.cpp \
engine/engine.cpp \
jellyfish/jellyfish.cpp \
jellyfish/jellyfish_primitive.cpp \
audio.cpp \
LOCAL_LDLIBS := -lGLESv1_CM -lOpenSLES -ldl -llog
APP_STL := stlport_static
Aims to be a fluxus compatible programmable game engine and 3D renderer
for livecoding small devices.
* Modified tinyscheme R5RS interpreter
* Fixed point maths throughout
* An experimental vector processor for fast procedural rendering
* OpenGL ES backend for ARM/android/rasperry pi/OUYA
* Linux target: reference version (also running fixed point)
* Playstation 2 target (legacy)
* Custom hardware renderer running on vu1 path
target = 'nomadic'
platform = ARGUMENTS.get('TARGET','LINUX')
env = Environment(CCFLAGS='-O3 -std=gnu++0x -ggdb -DUSE_MATH=1 -Wno-write-strings')
source = ['main.cpp',
if platform=='LINUX':
env.Append(LIBS = ['glut', 'GL', 'png', 'pthread', 'dl', 'lo'])
env.Append(CCFLAGS=' -fpermissive -DFLX_LINUX')
env.Append(CPPPATH = '.')
if platform=='RPI':
# raspberry pi
env.Append(LIBS = ['GLESv1_CM', 'EGL', 'bcm_host', 'X11', 'png', 'lo'])
env.Append(CCFLAGS=' -DFLX_RPI -fpermissive')
env.Append(CPPPATH = '/opt/vc/include/interface/vcos/pthreads/:/opt/vc/include/interface/vmcs_host/linux:/opt/vc/include/:.')
env.Append(LIBPATH = '/opt/vc/lib')
env.Program(target=target, source=source)
#include <jni.h>
#include <sys/time.h>
#include <time.h>
#include <android/log.h>
#include <stdint.h>
#include <stdio.h>
#include "scheme/scheme.h"
static int sWindowWidth = 320;
static int sWindowHeight = 480;
void Java_foam_starwisp_Scheme_nativeInit(JNIEnv* env)
/* Call to initialize the graphics state */
void Java_foam_starwisp_Scheme_nativeInitGL( JNIEnv* env )
void Java_foam_starwisp_Scheme_nativeResize( JNIEnv* env, jobject thiz, jint w, jint h )
sWindowWidth = w;
sWindowHeight = h;
__android_log_print(ANDROID_LOG_INFO, "SanAngeles", "resize w=%d h=%d", w, h);
void Java_foam_starwisp_Scheme_nativeDone(JNIEnv* env)
void Java_foam_starwisp_Scheme_nativeRender( JNIEnv* env )
appRender(sWindowWidth, sWindowHeight);
jstring Java_foam_starwisp_Scheme_nativeEval(JNIEnv* env, jobject thiz, jstring code)
const char *native_code = (*env)->GetStringUTFChars(env, code, 0);
(*env)->ReleaseStringUTFChars(env, code, native_code);
if (starwisp_data!=NULL) {
jstring ret = (*env)->NewStringUTF(env,starwisp_data);
return ret;
return (*env)->NewStringUTF(env,"");
void Java_foam_starwisp_Scheme_nativeLoadTexture(JNIEnv* env, jobject thiz, jstring texname, jbyteArray arr, jint w, jint h)
char *data = (char *) (*env)->GetByteArrayElements(env,arr,NULL);
int len = (*env)->GetArrayLength(env, arr);
const char *filename = (*env)->GetStringUTFChars(env, texname, 0);
__android_log_print(ANDROID_LOG_INFO, "starwisp", "loading texture");
int id=appLoadTexture(filename,w,h,data);
__android_log_print(ANDROID_LOG_INFO, "starwisp", "loaded texture");
(*env)->ReleaseStringUTFChars(env, texname, filename);
// create the engine and output mix objects
void Java_foam_starwisp_Scheme_createEngine(JNIEnv* env, jclass clazz)
#ifdef __cplusplus
extern "C" {
#define WINDOW_BPP 16
extern void appInit();
extern void initGL();
extern void appDeinit();
extern void appEval(char *code);
extern void appRender(int width, int height);
extern unsigned int appLoadTexture(const char *filename, int width, int height, char* data);
#ifdef __cplusplus
#endif // !APP_H_INCLUDED
;; [ Copyright (C) 2011 Dave Griffiths : GPLv2 see LICENCE ]
(define frame-thunk '())
(define flx_time 0)
(define _touching #f)
(define _touches '())
(define _fling (vector 0 0))
;(define-macro (every-frame . args)
; `(begin (set! frame-thunk (lambda () ,@args))))
(define (frame-hook)
(set! flx_time (+ flx_time 1))
(if (not (null? frame-thunk))
(set! _touches '())
(set! _touching #f)
(vector-set! _fling 0 0)
(vector-set! _fling 1 0))
(define triangles 0)
(define triangle-strip 1)
(define (hint-none) (hint 0))
(define (hint-solid) (hint 1))
(define (hint-wire) (hint 2))
(define (hint-normal) (hint 3))
(define (hint-points) (hint 4))
(define (hint-anti-alias) (hint 5))
(define (hint-bound) (hint 6))
(define (hint-unlit) (hint 7))
(define _mouse-x 0)
(define _mouse-y 0)
(define _mouse-b -1)
(define _mouse-s 1) ; state - 0 down, 1 up
(define (input-mouse-button b s)
(set! _mouse-b b)
(set! _mouse-s s))
(define (input-mouse x y)
(when (zero? _mouse-s) ; eh?
(set! _touching #t)
(set! _touches (list (list 0 x y))))
(set! _mouse-x x)
(set! _mouse-y y))
(define (mouse-x) _mouse-x)
(define (mouse-y) _mouse-y)
(define (mouse-button n)
(if _touching
(if (zero? _mouse-s)
(eqv? _mouse-b n) #f)))
(define keys '())
(define keys-this-frame '())
(define special-keys '())
(define special-keys-this-frame '())
(define mouse (vector 0 0))
(define mouse-buttons (vector #f #f #f))
(define mouse-wheel-v 0)
(define key-mods '())
; utils funcs for using lists as sets
(define (set-remove a l)
(if (null? l)
(if (eq? (car l) a)
(set-remove a (cdr l))
(cons (car l) (set-remove a (cdr l))))))
(define (set-add a l)
(if (not (memq a l))
(cons a l)
(define (set-contains a l)
(if (not (memq a l))
(define (clear-down)
(set! keys '()))
(define (update-input)
(set! keys-this-frame '())
(set! special-keys-this-frame '())
(set! mouse-wheel-v 0))
(define (register-down key button special state x y mod)
(when (not (or (number? key) (eq? key -1))) ; ordinary keypress
(set! keys (set-add key keys))
(set! keys-this-frame (set-add key keys-this-frame)))
(when (not (= special -1)) ; special keypress
(set! special-keys (set-add special special-keys))
(set! special-keys-this-frame (set-add special special-keys-this-frame)))
;(set! key-mods ; key modifiers
; (for/list ([bitmask (list 1 2 4)]
; [bitsym '(shift ctrl alt)]
; #:when (> (bitwise-and mod bitmask) 0))
; bitsym))
(cond ; mouse
((and (eq? key 0) (eq? special -1))
(when (eq? button 3) (set! mouse-wheel-v 1))
(when (eq? button 4) (set! mouse-wheel-v -1))
(when (and (eq? state 0)
(< button (vector-length mouse-buttons)))
(vector-set! mouse-buttons button #t))
(when (and (eq? state 1)
(< button (vector-length mouse-buttons)))
(vector-set! mouse-buttons button #f))
(vector-set! mouse 0 x)
(vector-set! mouse 1 y))))
(define (register-up key button special state x y mod)
(when (not (eq? key -1))
(set! keys (set-remove key keys)))
(when (not (eq? special -1))
(set! special-keys (set-remove special special-keys))))
(define (key-pressed s)
(set-contains (car (string->list s)) keys))
(define (keys-down)
(define (key-special-pressed k)
(set-contains k special-keys))
(define (keys-special-down)
(define (key-modifiers)
(define (key-pressed-this-frame s)
(set-contains (car (string->list s)) keys-this-frame))
(define (key-special-pressed-this-frame s)
(set-contains s special-keys-this-frame))
(define (fluxus-input-callback key button special state x y mod)
(register-down key button special state x y mod)
(input-camera key button special state x y mod width height))
(define (fluxus-input-release-callback key button special state x y mod)
(register-up key button special state x y mod))
(define (input-touches l)
(set! _touching #t)
(input-mouse (list-ref (car l) 1)
(list-ref (car l) 2))
(set! _touches l))
(define on-sensor (lambda (x y z) 0))
(define (input-sensor l)
(on-sensor (list-ref l 0) (list-ref l 1) (list-ref l 2) ))
(define (get-touch-ids)
(lambda (touch)
(car touch))
(define (get-pos-from-touch id)
(lambda (r touch)
(if (eq? (car touch) id)
(cdr touch)
'(0 0)
(define (on-fling vx vy)
(vector-set! _fling 0 vx)
(vector-set! _fling 1 vy))
(define (time) flx_time)
(define (build-locator)
(build-polygons 0 0))
(define-macro (with-state . args)
`(begin (push) (let ((r (begin ,@args))) (pop) r)))
(define-macro (with-primitive . args)
(let ((id (car args)) (body (cdr args)))
`(begin (grab ,id) (let ((r (begin ,@body))) (ungrab) r))))
(define (build-list fn n)
(define (_ fn n l)
(cond ((zero? n) l)
(_ fn (- n 1) (cons (fn (- n 1)) l)))))
(_ fn n '()))
(define (foldl op initial seq)
(define (iter result rest)
(if (null? rest)
(iter (op (car rest) result) (cdr rest))))
(iter initial seq))
(define (filter op seq)
(lambda (i s)
(if (op i) (cons i s) s))
;; (list-replace '(1 2 3 4) 2 100) => '(1 2 100 4)
(define (list-replace l i v)
((null? l) l)
((zero? i) (cons v (list-replace (cdr l) (- i 1) v)))
(else (cons (car l) (list-replace (cdr l) (- i 1) v)))))
(define (square x)
(* x x))
(define (vx v) (vector-ref v 0))
(define (vy v) (vector-ref v 1))
(define (vz v) (vector-ref v 2))
(define (vadd a b)
(vector (+ (vx a) (vx b))
(+ (vy a) (vy b))
(+ (vz a) (vz b))))
(define (vmag v)
(sqrt (+ (square (vx v))
(square (vy v))
(square (vz v)))))
(define (vsub a b)
(vector (- (vx a) (vx b))
(- (vy a) (vy b))
(- (vz a) (vz b))))
(define (vmul v a)
(vector (* (vx v) a) (* (vy v) a) (* (vz v) a)))
(define (vdiv v a)
(vector (/ (vx v) a) (/ (vy v) a) (/ (vz v) a)))
(define (vdist a b)
(vmag (vsub a b)))
(define (vlerp v1 v2 t)
(vadd v1 (vmul (vsub v2 v1) t)))
(define (vnormalise v)
(vdiv v (vmag v)))
(define (pdata-map! . args)
(let ((proc (car args))
(pdata-write-name (cadr args))
(pdata-read-names (cddr args)))
((loop (lambda (n total)
(cond ((not (> n total))
pdata-write-name n
(pdata-ref pdata-write-name n)
(lambda (read)
(pdata-ref read n))
(loop (+ n 1) total))))))
(loop 0 (- (pdata-size) 1)))))
(define (pdata-index-map! . args)
(let ((proc (car args))
(pdata-write-name (cadr args))
(pdata-read-names (cddr args)))
((loop (lambda (n total)
(cond ((not (> n total))
pdata-write-name n
(pdata-ref pdata-write-name n))
(lambda (read)
(pdata-ref read n))
(loop (+ n 1) total))))))
(loop 0 (- (pdata-size) 1)))))
(define (pdata-copy a b)
(pdata-add b)
(pdata-map! (lambda (b a) a) b a))
(define (mscale v)
(vector (vx v) 0 0 0
0 (vy v) 0 0
0 0 (vz v) 0
0 0 0 1))
; 0 1 2 3
; 4 5 6 7
; 8 9 10 11
;12 13 14 15
(define (mtranspose m)
(vector (vector-ref m 0) (vector-ref m 4) (vector-ref m 8) (vector-ref m 12)
(vector-ref m 1) (vector-ref m 5) (vector-ref m 9) (vector-ref m 13)
(vector-ref m 2) (vector-ref m 6) (vector-ref m 10) (vector-ref m 14)
(vector-ref m 3) (vector-ref m 7) (vector-ref m 11) (vector-ref m 15)))
(define (vtransform v m)
(let ((m m));(mtranspose m)))
(let ((w (+ (* (vx v) (vector-ref m 3))
(* (vy v) (vector-ref m 7))
(* (vz v) (vector-ref m 11))
(vector-ref m 15))))
(+ (* (vx v) (vector-ref m 0))
(* (vy v) (vector-ref m 4))
(* (vz v) (vector-ref m 8))
(vector-ref m 12))
(+ (* (vx v) (vector-ref m 1))
(* (vy v) (vector-ref m 5))
(* (vz v) (vector-ref m 9))
(vector-ref m 13))
(+ (* (vx v) (vector-ref m 2))
(* (vy v) (vector-ref m 6))
(* (vz v) (vector-ref m 10))
(vector-ref m 14)))
(define random-maker
(let* ((multiplier 48271)
(modulus 2147483647)
(lambda (current-seed)
(let ((candidate (modulo (* current-seed multiplier)
(if (zero? candidate)
(lambda (proposed-seed)
(if (integer? proposed-seed)
(- modulus (modulo proposed-seed modulus))
19860617)))) ;; an arbitrarily chosen birthday
(lambda (initial-seed)
(let ((seed (coerce initial-seed)))
(lambda args
(cond ((null? args)
(set! seed (apply-congruence seed))
(/ (- modulus seed) modulus))
((null? (cdr args))
(let* ((proposed-top
(ceiling (abs (car args))))
(if (inexact? proposed-top)
(inexact->exact proposed-top)
(if (zero? exact-top)
(set! seed (apply-congruence seed))
(inexact->exact (floor (* top (/ seed modulus))))))
((eq? (cadr args) 'reset)
(set! seed (coerce (car args))))
(display "random: unrecognized message")
(define rand
(random-maker 19781116)) ;; another arbitrarily chosen birthday
(define rndf rand)
(define (random n) (floor (abs (* (rndf) n))))
(define (rndvec) (vector (rndf)