loads of fixes from scheme bricks test

README.md

@@ -243,3 +243,38 @@ 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
+
+
+### TinyScheme Licence follows ###
+
+                         LICENSE TERMS
+
+Copyright (c) 2000, Dimitrios Souflis
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+Neither the name of Dimitrios Souflis nor the names of the
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR
+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

assets/boot.scm

@@ -30,11 +30,31 @@
 (define (hint-anti-alias) (hint 5))
 (define (hint-bound) (hint 6))
 (define (hint-unlit) (hint 7))
+(define (hint-vertcols) (hint 8))
+(define (hint-origin) (hint 9))
+(define (hint-cast-shadow) (hint 10))
+(define (hint-ignore-depth) (hint 11))
+(define (hint-depth-sort) (hint 12))
+(define (hint-lazy-parent) (hint 13))
+(define (hint-cull-ccw) (hint 14))
+(define (hint-wire-stippled) (hint 15))
+(define (hint-spere-map) (hint 16))
+(define (hint-frustum-cull) (hint 17))
+(define (hint-normalise) (hint 18))
+(define (hint-noblend) (hint 19))
+(define (hint-nozwrite) (hint 20))
 
 ;------------------------------------------------------------
 
-(define _mouse-x 0)
-(define _mouse-y 0)
+(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 #f))
+(define mouse-wheel-v 0)
+(define key-mods '())
+;; this stuff for touchscreens
 (define _mouse-b -1)
 (define _mouse-s 1) ; state - 0 down, 1 up
 
@@ -46,25 +66,21 @@
   (when (zero? _mouse-s) ; eh?
         (set! _touching #t)
         (set! _touches (list (list 0 x y))))
-  (set! _mouse-x x)
-  (set! _mouse-y y))
+  (vector-set! mouse 0 x)
+  (vector-set! mouse 1 y))
+
+(define (mouse-x) (vector-ref mouse 0))
+(define (mouse-y) (vector-ref mouse 1))
+
+;;(define (mouse-button n)
+;;  (if _touching
+;;      #t
+;;      (if (zero? _mouse-s)
+;;          (eqv? _mouse-b n) #f)))
 
-(define (mouse-x) _mouse-x)
-(define (mouse-y) _mouse-y)
 (define (mouse-button n)
-  (if _touching
-      #t
-      (if (zero? _mouse-s)
-          (eqv? _mouse-b n) #f)))
+  (vector-ref mouse-buttons (- n 1)))
 
-(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)
@@ -106,17 +122,17 @@
   ; #:when (> (bitwise-and mod bitmask) 0))
                                         ;                bitsym))
   (cond ; mouse
-   ((and (eq? key 0) (eq? special -1))
+   ((and (eqv? key 0) (eqv? 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)
+    (when (and (eqv? state 0)
                (< button (vector-length mouse-buttons)))
           (vector-set! mouse-buttons button #t))
-    (when (and (eq? state 1)
+    (when (and (eqv? state 1)
                (< button (vector-length mouse-buttons)))
-          (vector-set! mouse-buttons button #f))
+          (vector-set! mouse-buttons button #f))))
   (vector-set! mouse 0 x)
-    (vector-set! mouse 1 y))))
+  (vector-set! mouse 1 y))
 
 (define (register-up key button special state x y mod)
   (when (not (eq? key -1))
@@ -289,6 +305,27 @@
                          (loop (+ n 1) total))))))
        (loop 0 (- (pdata-size) 1)))))
 
+(define (pdata-range-map! start end . args)
+  (let ((proc (car args))
+        (pdata-write-name (cadr args))
+        (pdata-read-names (cddr args)))
+     (letrec
+         ((loop (lambda (n total)
+                  (cond ((not (> n total))
+                         (pdata-set!
+                          pdata-write-name n
+                          (apply
+                           proc
+                           (cons
+                            (pdata-ref pdata-write-name n)
+                            (map
+                             (lambda (read)
+                               (pdata-ref read n))
+                             pdata-read-names))))
+                         (loop (+ n 1) total))))))
+       (loop start (min (pdata-size) end)))))
+
+
 (define (pdata-index-map! . args)
   (let ((proc (car args))
         (pdata-write-name (cadr args))
@@ -482,6 +519,13 @@
 ;    (display code)(newline)
     (eval code)))
 
+;; detach and retain original transform
+(define (detach-parent)
+  (let ((m (get-global-transform)))
+    (parent 1) ;; reparent to root
+    (identity)
+    (concat m)))
+
 ;;---------------------------------------------------------
 ;; jellyfish helpers
 

experiments/math-hack.scm

+;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+; maths hacks, move to fluxa
+
+(define (all-numbers? l)
+  (cond
+   ((null? l) #t)
+   ((not (number? (car l))) #f)
+   (else (all-numbers? (cdr l)))))
+
+(define (+ . args)
+  (if (all-numbers? args)
+      (apply + args)
+      (proc-list add args)))
+
+(define (- . args)
+  (if (all-numbers? args)
+      (apply - args)
+      (proc-list sub args)))
+
+(define (/ . args)
+  (if (all-numbers? args)
+      (apply / args)
+      (proc-list div args)))
+
+(define (* . args)
+  (if (all-numbers? args)
+      (apply * args)
+      (proc-list mul args)))
+
+(define (proc-list p l)
+  (cond
+   ((eq? (length l) 1) (car l))
+   ((eq? (length l) 2) (p (car l) (cadr l)))
+   (else (p (car l) (proc-list p (cdr l))))))

experiments/tesst.scm

@@ -66,3 +66,16 @@
  (colour (vector 1 0 0))
  (hint-unlit)
  (build-cube))
+
+(translate (vector -4 2 0))
+
+(with-state
+ (texture (load-texture "font.png"))
+ (build-text "hello"))
+
+(translate (vector 2 -6 0))
+(texture 0)
+(define a (build-cube))
+(define b (with-state (parent a) (build-cube)))
+(define c (build-cube))
+(with-primitive b (parent c))

src/core/geometry.cpp

@@ -60,6 +60,12 @@ flx_real intersect_line_triangle(const vec3 &start, const vec3 &end,
     return r;
 }
 
+bool intersect_point_bb(const vec3 &p, const vec3 &min, const vec3 &max, flx_real threshold) {
+	return (p.x>min.x-threshold && p.x<max.x+threshold &&
+			p.y>min.y-threshold && p.y<max.y+threshold &&
+			p.z>min.z-threshold && p.z<max.z+threshold);
+}
+
 // need to delete the point
 intersect_point *interpolate_pdata(const list *pdata, float t, const vec3 &bary, u32 i1, u32 i2, u32 i3)
 {

src/core/geometry.h

@@ -25,6 +25,8 @@ flx_real intersect_line_triangle(const vec3 &start, const vec3 &end,
                                  const vec3 &ta, const vec3 &tb, const vec3 &tc,
                                  vec3 &bary);
 
+bool intersect_point_bb(const vec3 &p, const vec3 &min, const vec3 &max, flx_real threshold);
+
 class intersect_point : public list::node
 {
 public:

src/engine/engine.cpp

@@ -351,8 +351,8 @@ int engine::build_text(char *str)
 {
 	// 16*16 grid of letters
 	text_primitive *p = new text_primitive(strlen(str),16/256.0f,16/256.0f,16,0);
-    p->set_text(str);
     scenenode *n=new scenenode(p);
+    p->set_text(str);
     setup_state(n);
     return m_sg->add(state_top()->m_parent,n);
 }
@@ -369,6 +369,7 @@ int engine::build_polygons(unsigned int size, int type)
     scenenode *n=new scenenode(
         new primitive(size,
                       static_cast<primitive::type>(type)));
+    // todo: why not setup_state(n); ??
     n->m_tx=state_top()->m_tx;
     n->m_hints=state_top()->m_hints;
     n->m_line_width=state_top()->m_line_width;
@@ -505,6 +506,33 @@ void engine::pdata_set(const char *name, int i, vec3 v)
     }
 }
 
+void engine::recalc_bb()
+{
+    if (grabbed())
+    {
+        scenenode *n = grabbed_node();
+        if (n && n->m_primitive!=NULL)
+        {
+            n->m_primitive->recalc_bb();
+        }
+    }
+    return;
+}
+
+bool engine::bb_point_intersect(const vec3 &p, flx_real threshold)
+{
+    if (grabbed())
+    {
+        scenenode *n = grabbed_node();
+        if (n && n->m_primitive!=NULL)
+        {
+            vec3 pt=n->m_tx.transform(p);
+            return n->m_primitive->intersect_bb(pt,threshold);
+        }
+    }
+    return false;
+}
+
 bb::list *engine::geo_line_intersect(const vec3 &start, const vec3 &end)
 {
     if (grabbed())

src/engine/engine.h

@@ -83,6 +83,8 @@ public:
     u32 get_texture(const char *filename);
     list *geo_line_intersect(const vec3 &start, const vec3 &end);
     u32 get_line_intersect(const vec3 &start, const vec3 &end);
+    void recalc_bb();
+    bool bb_point_intersect(const vec3 &p, flx_real threshold);
 
     void render();
 

src/engine/primitive.cpp

@@ -168,6 +168,20 @@ void primitive::apply(const mat44 &m)
     }
 }
 
+void primitive::recalc_bb()
+{
+    for (int i=0; i<m_size; i++)
+    {
+        if (m_bbmin>m_positions[i]) m_bbmin=m_positions[i];
+        if (m_bbmax<m_positions[i]) m_bbmax=m_positions[i];
+    }
+}
+
+bool primitive::intersect_bb(const vec3 &p, flx_real threshold)
+{
+    return intersect_point_bb(p, m_bbmin, m_bbmin, threshold);
+}
+
 list *primitive::intersect(const vec3 &start, const vec3 &end)
 {
     return intersect_tristrip(start,end);

src/engine/primitive.h

@@ -46,9 +46,13 @@ public:
     void pdata_set(const char* name, int i, vec3 v);
     vec3 *pdata_get(const char* name, int i);
 
+    void recalc_bb();
+
     // delete my list please, see geometry.h:points
     list *intersect(const vec3 &start, const vec3 &end);
     bool intersect_fast(const vec3 &start, const vec3 &end);
+    // p is in object space
+    bool intersect_bb(const vec3 &p, flx_real threshold);
 
 protected:
 
@@ -64,6 +68,10 @@ protected:
     u32 m_type;
     u32 m_size;
     list m_pdata;
+
+    vec3 m_bbmin;
+    vec3 m_bbmax;
+
 };
 
 #endif

src/engine/scenenode.cpp

@@ -50,13 +50,13 @@ scenenode *scenenode::find_child(int id)
     return NULL;
 }
 
-
+// deleting the node is someone elses business - we may be reparenting
 void scenenode::remove_child(int id)
 {
     scenenode *n=find_child(id);
     if (n!=NULL)
     {
-        delete n;
+        //delete n;
         m_children.remove(n);
     }
 }

src/engine/text_primitive.cpp

@@ -139,5 +139,3 @@ void text_primitive::render(u32 hints)
 {
 	primitive::render(hints);
 }
-
-

src/main.cpp

@@ -138,6 +138,29 @@ void IdleCallback()
 	glutPostRedisplay();
 }
 
+void MouseCallback(int button, int state, int x, int y)
+{
+    char code[256];
+	snprintf(code,256,"(%s %d %d %d %d %d %d %d)",INPUT_CALLBACK.c_str(),0,button,-1,state,x,y,0);
+	appEval(code);
+    cerr<<code<<endl;
+}
+
+void MotionCallback(int x, int y)
+{
+    char code[256];
+	snprintf(code,256,"(%s %d %d %d %d %d %d %d)",INPUT_CALLBACK.c_str(),0,-1,-1,-1,x,y,0);
+	appEval(code);
+}
+
+void PassiveMotionCallback(int x, int y)
+{
+    char code[256];
+	snprintf(code,256,"(%s %d %d %d %d %d %d %d)",INPUT_CALLBACK.c_str(),0,-1,-1,-1,x,y,0);
+	appEval(code);
+}
+
+
 #endif
 
 void KeyboardUpCallback(unsigned char key,int x, int y)
@@ -169,8 +192,8 @@ int main(int argc, char *argv[])
    memset( state, 0, sizeof( *state ) );
    init_ogl_rpi(state);
 #else
-   w=640;
-   h=480;
+   w=800;
+   h=600;
 
    unsigned int flags = GLUT_DOUBLE|GLUT_RGBA|GLUT_DEPTH;
 
@@ -185,13 +208,14 @@ int main(int argc, char *argv[])
    glutIdleFunc(IdleCallback);
    glutKeyboardFunc(KeyboardCallback);
    glutKeyboardUpFunc(KeyboardUpCallback);
+   glutMouseFunc(MouseCallback);
+   glutMotionFunc(MotionCallback);
+   glutPassiveMotionFunc(PassiveMotionCallback);
 #endif
 
    appInit();
    initGL();
 
-   cerr<<ASSETS_PATH<<endl;
-
    appEval((char*)LoadFile(string(ASSETS_PATH)+"init.scm").c_str());
    appEval((char*)LoadFile(string(ASSETS_PATH)+"boot.scm").c_str());
    appEval((char*)LoadFile(string(ASSETS_PATH)+"lib.scm").c_str());
@@ -208,6 +232,8 @@ int main(int argc, char *argv[])
     appLoadTexture("bg.png",w,h,(char *)tex);
     tex=LoadPNG(string(ASSETS_PATH)+"thread.png",w,h);
     appLoadTexture("thread.png",w,h,(char *)tex);
+    tex=LoadPNG(string(ASSETS_PATH)+"font.png",w,h);
+    appLoadTexture("font.png",w,h,(char *)tex);
 
     if (argc>1) {
         appEval((char*)LoadFile(string(argv[1])).c_str());

src/scheme/opdefines.h

@@ -243,6 +243,8 @@
     _OP_DEF(opexe_6, "pdata-ref",                      2,  2,       0,                               OP_PDATA_REF        )
     _OP_DEF(opexe_6, "pdata-set!",                     3,  3,       0,                               OP_PDATA_SET        )
     _OP_DEF(opexe_6, "set-text",                       1,  1,       0,                               OP_SET_TEXT         )
+    _OP_DEF(opexe_6, "recalc-bb",                      0,  0,       0,                               OP_RECALC_BB        )
+    _OP_DEF(opexe_6, "bb/point-intersect?",             2,  2,       0,                               OP_BB_POINT_INTERSECT )
     _OP_DEF(opexe_6, "geo/line-intersect",             2,  2,       0,                               OP_GEO_LINE_INTERSECT )
     _OP_DEF(opexe_6, "get-line-intersect",             2,  2,       0,                               OP_GET_LINE_INTERSECT )
     _OP_DEF(opexe_6, "get-screen-size",                0,  0,       0,                               OP_GET_SCREEN_SIZE  )

src/scheme/scheme-private.h

@@ -73,7 +73,7 @@ int tracing;
 
 
 #define CELL_SEGSIZE    100000      /* # of cells in one segment */
-#define CELL_NSEGMENT   500       /* # of segments for cells */
+#define CELL_NSEGMENT   5000       /* # of segments for cells */
 char *alloc_seg[CELL_NSEGMENT];
 pointer cell_seg[CELL_NSEGMENT];
 int     last_cell_seg;
@@ -156,6 +156,7 @@ enum scheme_opcodes {
   OP_MAXDEFINED
 };
 
+void print_opcode_name(scheme* sc, enum scheme_opcodes op);
 
 #define cons(sc,a,b) _cons(sc,a,b,0)
 #define immutable_cons(sc,a,b) _cons(sc,a,b,1)