Skip to content

GitLab

Commit 0fd1901b authored by Dave Griffiths's avatar Dave Griffiths
Browse files

optimisations - widget bin search, tinyscheme opts, build opts, refactor

parent 4026f32c
Hide whitespace changes
Inline Side-by-side
Showing with 209 additions and 139 deletions
android/AndroidManifest.xml
View file @ 0fd1901b
......@@ -18,7 +18,7 @@
</intent-filter>
</activity>
<activity android:name="MainActivity"></activity>
<activity android:name="ExperimentsActivity"></activity>
<activity android:name="ObservationsActivity"></activity>
<activity android:name="PackSelectActivity"></activity>
<activity android:name="IndividualSelectActivity"></activity>
<activity android:name="PupFocalActivity"></activity>
......
android/assets/lib.scm
View file @ 0fd1901b
......@@ -56,6 +56,30 @@
((equal? n (car (car l))) (car l))
(else (find n (cdr l)))))
(define (sorted-add l i)
(cond
((null? l) (list i))
;; overwrite existing
((eqv? (car i) (caar l)) (cons i (cdr l)))
((< (car i) (caar l))
(cons i l))
(else
(cons (car l) (sorted-add (cdr l) i)))))
(define (sorted-find l k)
(define (_ bot top)
(if (null? l) #f
(let* ((m (inexact->exact (floor (+ bot (/ (- top bot) 2)))))
(mid (list-ref l m))
(v (car mid)))
(cond
((eqv? k v) mid)
((eqv? top bot) #f)
((< k v) (_ bot m))
(else (_ (+ m 1) top))))))
(_ 0 (- (length l) 1)))
(define (build-list fn n)
(define (_ fn n l)
(cond ((zero? n) l)
......@@ -288,6 +312,14 @@
(define (linear-layout-layout t) (list-ref t 3))
(define (linear-layout-children t) (list-ref t 4))
(define (grid-layout id cols orientation layout children)
(list "grid-layout" id cols orientation layout children))
(define (grid-layout-id t) (list-ref t 1))
(define (grid-layout-cols t) (list-ref t 2))
(define (grid-layout-orientation t) (list-ref t 3))
(define (grid-layout-layout t) (list-ref t 4))
(define (grid-layout-children t) (list-ref t 5))
(define (frame-layout id layout children)
(list "frame-layout" id layout children))
(define (frame-layout-id t) (list-ref t 1))
......@@ -398,6 +430,10 @@
(define (replace-fragment id type) (list "replace-fragment" id type))
(define (update-widget type id token value) (list type id token value))
(define (update-widget-type l) (list-ref l 0))
(define (update-widget-id l) (list-ref l 1))
(define (update-widget-token l) (list-ref l 2))
(define (update-widget-value l) (list-ref l 3))
(define id-map ())
(define current-id 1)
......@@ -432,6 +468,7 @@
(define (spacer size) (space (layout 'fill-parent size 1 'left)))
(define (horiz . l)
(linear-layout
(make-id "xv")
......@@ -471,39 +508,57 @@
((equal? (activity-name (car l)) name) (car l))
(else (activity-list-find (cdr l) name))))
(define (widget-find widget-list id)
(define activities 0)
(define fragments 0)
(define callbacks '())
(define (callback id type fn) (list id type fn))
(define (callback-id l) (list-ref l 0))
(define (callback-type l) (list-ref l 1))
(define (callback-fn l) (list-ref l 2))
(define (find-callback id) (sorted-find callbacks id))
(define (add-callback! cb) (set! callbacks (sorted-add callbacks cb)))
(define (widget-get-children w)
(cond
((null? widget-list) #f)
((eqv? (widget-id (car widget-list)) id) (car widget-list))
((equal? (widget-type (car widget-list)) "linear-layout")
(let ((ret (widget-find (linear-layout-children (car widget-list)) id)))
(if ret ret (widget-find (cdr widget-list) id))))
((equal? (widget-type (car widget-list)) "frame-layout")
(let ((ret (widget-find (frame-layout-children (car widget-list)) id)))
(if ret ret (widget-find (cdr widget-list) id))))
((equal? (widget-type (car widget-list)) "scroll-view")
(let ((ret (widget-find (scroll-view-children (car widget-list)) id)))
(if ret ret (widget-find (cdr widget-list) id))))
(else (widget-find (cdr widget-list) id))))
(define (widget-replace widget-list id w)
((equal? (widget-type w) "linear-layout") (linear-layout-children w))
((equal? (widget-type w) "frame-layout") (frame-layout-children w))
((equal? (widget-type w) "scroll-view") (scroll-view-children w))
((equal? (widget-type w) "grid-layout") (grid-layout-children w))
(else '())))
(define (widget-get-callback w)
(cond
((equal? (widget-type w) "edit-text") (edit-text-listener w))
((equal? (widget-type w) "button") (button-listener w))
((equal? (widget-type w) "toggle-button") (toggle-button-listener w))
((equal? (widget-type w) "seek-bar") (seek-bar-listener w))
((equal? (widget-type w) "spinner") (spinner-listener w))
(else #f)))
;; walk through activity stripping callbacks
(define (update-callbacks! widget-list)
(cond
((null? widget-list) #f)
((eqv? (widget-id (car widget-list)) id) (cons w (cdr widget-list)))
((equal? (widget-type (car widget-list)) "linear-layout")
(cons (widget-replace (linear-layout-children (car widget-list)) id w)
(widget-replace (cdr widget-list) id w)))
((equal? (widget-type (car widget-list)) "frame-layout")
(cons (widget-replace (frame-layout-children (car widget-list)) id w)
(widget-replace (cdr widget-list) id w)))
((equal? (widget-type (car widget-list)) "scroll-view")
(cons (widget-replace (scroll-view-children (car widget-list)) id w)
(widget-replace (cdr widget-list) id w)))
(else (cons (car widget-list) (widget-find (cdr widget-list) id w)))))
(define activities 0)
(define fragments 0)
(define dynamic-widgets '())
(else
(let* ((w (car widget-list))
(c (widget-get-children w)))
(if (not (null? c))
(update-callbacks! c)
(let ((cb (widget-get-callback w)))
(when cb (add-callback! (callback (edit-text-id w) (widget-type w) cb))))))
(update-callbacks! (cdr widget-list)))))
;; walk through update stripping callbacks
(define (update-callbacks-from-update! widget-list)
(if (null? widget-list) #f
(let ((w (car widget-list)))
(cond
((null? w) #f)
;; drill deeper
((eq? (update-widget-token w) 'contents)
(update-callbacks! (update-widget-value w))))
(update-callbacks! (cdr widget-list)))))
(define (define-activity-list . args)
(set! activities (activity-list args)))
......@@ -511,25 +566,8 @@
(define (define-fragment-list . args)
(set! fragments (activity-list args)))
;; hack for dynamic widgets
(define (add-new-widget! w)
(msg "dynamic widgets now " (length w))
;; todo - speed this stuff up
(cond ((widget-find dynamic-widgets (widget-id w))
(set! dynamic-widgets (widget-replace dynamic-widgets (widget-id w) w)))
(else
(set! dynamic-widgets (cons w dynamic-widgets)))))
(define (update-dynamic-widgets! events)
(for-each
(lambda (event)
(if (equal? (list-ref event 2) 'contents)
(for-each
(lambda (w)
(add-new-widget! w))
(list-ref event 3))))
events))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; replace with new cb system
(define dialogs '())
......@@ -559,6 +597,8 @@
(add-new-dialog! event)))
events)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (dialog-callback name args)
(let ((dialog (dialog-find dialogs name)))
(if (not dialog)
......@@ -593,8 +633,9 @@
(else
(display "no callback called ")(display type)(newline)
'()))))
(when (not (eq? type 'on-create))
(update-dynamic-widgets! ret))
(if (eq? type 'on-create)
(update-callbacks! (list ret))
(update-callbacks-from-update! ret))
(send (scheme->json ret)))))
(define (find-activity-or-fragment name)
......@@ -602,28 +643,23 @@
(if r r
(activity-list-find fragments name))))
;; called by java
(define (widget-callback activity-name widget-id args)
(let ((activity (find-activity-or-fragment activity-name)))
(if (not activity)
(begin (display "no activity called ")(display activity-name)(newline))
(let ((widget (widget-find (cons (activity-layout activity) dynamic-widgets) widget-id)))
;;(display widget)(newline)
(if (not widget)
(begin (display "no widget ")(display widget-id)(display " in ")(display activity-name)(newline))
(let ((events
(cond
((equal? (widget-type widget) "edit-text")
((edit-text-listener widget) (car args)))
((equal? (widget-type widget) "button")
((button-listener widget)))
((equal? (widget-type widget) "toggle-button")
((toggle-button-listener widget) (car args)))
((equal? (widget-type widget) "seek-bar")
((seek-bar-listener widget) (car args)))
((equal? (widget-type widget) "spinner")
((spinner-listener widget) (car args)))
(else (display "no callbacks for type ")
(display (widget-type widget))(newline)))))
(update-dialogs! events)
(send (scheme->json events))))))))
(let ((cb (find-callback widget-id)))
(if (not cb)
(msg "no widget" widget-id "found!")
(let ((events
(cond
((equal? (callback-type cb) "edit-text")
((callback-fn cb) (car args)))
((equal? (callback-type cb) "button")
((callback-fn cb)))
((equal? (callback-type cb) "toggle-button")
((callback-fn cb) (car args)))
((equal? (callback-type cb) "seek-bar")
((callback-fn cb) (car args)))
((equal? (callback-type widget) "spinner")
((callback-fn cb) (car args)))
(else (msg "no callbacks for type" (callback-type cb))))))
;;(update-callbacks! events)
(update-dialogs! events)
(send (scheme->json events))))))
android/assets/starwisp.scm
View file @ 0fd1901b
......@@ -170,62 +170,44 @@
(_ (append c (list (car l))) (cdr l)))))
(_ '() l))
(define (build-pack-buttons act fn)
(map
(lambda (packs)
(apply
horiz
(map
(lambda (pack)
(let ((name (ktv-get pack "name")))
(button (make-id (string-append act "-pack-" name))
name 20 fillwrap
(lambda ()
(fn pack)))))
packs)))
(xwise 2 (db-all db "sync" "pack"))))
;(define (build-individual-buttons act fn)
; (map
;(define (build-pack-buttons act fn)
; (map
; (lambda (individuals)
; (apply
; horiz
; (map
; (lambda (individual)
; (let ((name (ktv-get individual "name")))
; (lambda (pack)
; (let ((name (ktv-get pack "name")))
; (button (make-id (string-append act "-ind-" name))
; name 20 fillwrap
; (lambda ()
; (fn individual)))))
; (fn pack)))))
; individuals)))
; (xwise
; 2 (db-all-where
; db "sync" "mongoose"
; (list "pack-id" (ktv-get (get-current 'pack '()) "unique_id"))))))
; (xwise 2 (db-all db "sync" "pack"))))
;(define (build-pack-buttons act fn)
; (map
; (lambda (pack)
; (let ((name (ktv-get pack "name")))
; (button (make-id (string-append act "-pack-" name))
; name 20 fillwrap
; (lambda ()
; (fn pack)))))
; (db-all db "sync" "pack")))
(define (build-pack-buttons act fn)
(map
(lambda (pack)
(let ((name (ktv-get pack "name")))
(button (make-id (string-append act "-pack-" name))
name 20 (layout '150 'wrap-content 1 'centre)
(lambda ()
(fn pack)))))
(db-all db "sync" "pack")))
(define (build-individual-buttons act fn)
(map
(lambda (individual)
(let ((name (ktv-get individual "name")))
(lambda (ind)
(let ((name (ktv-get ind "name")))
(button (make-id (string-append act "-ind-" name))
name 20 fillwrap
name 20 (layout '150 'wrap-content 1 'centre)
(lambda ()
(fn individual)))))
(fn ind)))))
(db-all-where
db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))))
(define (build-dirty)
(let ((sync (get-dirty-stats db "sync"))
(stream (get-dirty-stats db "stream")))
......@@ -258,14 +240,14 @@
"test-fragment2"
(vert
(text-view (make-id "splash-title") "This is also a fragment" 40 fillwrap)
(text-view (make-id "changeme") "unchanged" 30 fillwrap)
(mbutton "frag-but" "sdsds"
(text-view (make-id "changeme2") "unchanged" 30 fillwrap)
(mbutton "frag-but3" "sdsds"
(lambda () (list)))
(spacer 20)
(mbutton "frag-but" "Pow wow"
(mbutton "frag-but2" "Pow wow"
(lambda ()
(list (toast "hello dude")
(update-widget 'text-view (get-id "changeme") 'text "I have changed!")))))
(update-widget 'text-view (get-id "changeme2") 'text "I have changed!")))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg) '())
......@@ -307,7 +289,7 @@
(text-view (make-id "main-title") "Mongoose 2000" 40 fillwrap)
(text-view (make-id "main-about") "Advanced mongoose technology" 20 fillwrap)
(spacer 10)
(mbutton "main-experiments" "Experiments" (lambda () (list (start-activity "experiments" 2 ""))))
(mbutton "main-observations" "Observations" (lambda () (list (start-activity "observations" 2 ""))))
(mbutton "main-manage" "Manage Packs" (lambda () (list (start-activity "manage-packs" 2 ""))))
(mbutton "main-tag" "Tag Location" (lambda () (list (start-activity "tag-location" 2 ""))))
(mtext "foo" "Your ID")
......@@ -334,9 +316,9 @@
(lambda (activity requestcode resultcode) '()))
(activity
"experiments"
"observations"
(vert
(text-view (make-id "title") "Experiments" 40 fillwrap)
(text-view (make-id "title") "Observation" 40 fillwrap)
(spacer 10)
(button (make-id "main-sync") "Pup Focal" 20 fillwrap (lambda () (list (start-activity "pack-select" 2 ""))))
)
......@@ -574,16 +556,16 @@
"manage-packs"
(vert
(text-view (make-id "title") "Manage packs" 40 fillwrap)
(linear-layout
(grid-layout
(make-id "manage-packs-pack-list")
'vertical fill (list))
3 'horizontal (layout 'wrap-content 'wrap-content 1 'centre) (list))
(button (make-id "manage-packs-new") "New pack" 20 fillwrap (lambda () (list (start-activity "new-pack" 2 ""))))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-packs-pack-list") 'contents
(update-widget 'grid-layout (get-id "manage-packs-pack-list") 'contents
(build-pack-buttons
"manage-packs"
(lambda (pack)
......@@ -629,16 +611,16 @@
(vert
(text-view (make-id "title") "Manage individuals" 40 fillwrap)
(text-view (make-id "manage-individual-pack-name") "Pack:" 20 fillwrap)
(linear-layout
(grid-layout
(make-id "manage-individuals-list")
'vertical fill (list))
3 'horizontal (layout 'wrap-content 'wrap-content 1 'centre) (list))
(button (make-id "manage-individuals-new") "New individual" 20 fillwrap (lambda () (list (start-activity "new-individual" 2 ""))))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-individuals-list") 'contents
(update-widget 'grid-layout (get-id "manage-individuals-list") 'contents
(build-individual-buttons
"manage-ind"
(lambda (individual)
......
android/jni/Android.mk
View file @ 0fd1901b
......@@ -4,7 +4,8 @@ include $(CLEAR_VARS)
LOCAL_MODULE := starwisp-core
LOCAL_CFLAGS := -DANDROID_NDK -O3 -Wno-write-strings
LOCAL_CFLAGS := -DANDROID_NDK -O3 -Wno-write-strings -DNDEBUG
APP_OPTIM := release
LOCAL_SRC_FILES := \
core/list.cpp \
......
android/jni/scheme/scheme.h
View file @ 0fd1901b
......@@ -50,7 +50,7 @@ extern "C" {
* Leave it defined if you want continuations, and also for the Sharp Zaurus.
* Undefine it if you only care about faster speed and not strict Scheme compatibility.
*/
#define USE_SCHEME_STACK
//#define USE_SCHEME_STACK
#if USE_DL
# define USE_INTERFACE 1
......@@ -73,9 +73,9 @@ extern "C" {
# define USE_STRING_PORTS 1
#endif
//#ifndef USE_TRACING
# define USE_TRACING 1
//#endif
#ifndef USE_TRACING
# define USE_TRACING 0
#endif
#ifndef USE_PLIST
# define USE_PLIST 0
......
android/res/values/styles.xml
View file @ 0fd1901b
......@@ -9,6 +9,7 @@
<item name="android:textSize">50sp</item>
<item name="android:layout_margin">10dip</item>
<item name="android:background">@drawable/swarmbutton</item>
<item name="android:layout_marginBottom">5dp</item>
</style>
<style name="StarwispSpinnerItem" parent="android:Widget.TextView.SpinnerItem">
......
android/src/foam/mongoose/ExperimentsActivity.java → android/src/foam/mongoose/ObservationsActivity.java
View file @ 0fd1901b
......@@ -19,12 +19,12 @@ import android.app.Activity;
import android.os.Bundle;
import android.content.Context;
public class ExperimentsActivity extends StarwispActivity
public class ObservationsActivity extends StarwispActivity
{
@Override
public void onCreate(Bundle savedInstanceState)
{
m_Name = "experiments";
m_Name = "observations";
super.onCreate(savedInstanceState);
}
}
android/src/foam/mongoose/Scheme.java
View file @ 0fd1901b
......@@ -46,9 +46,13 @@ public class Scheme
}
public String eval(String code) {
Log.i("starwisp","eval on");
synchronized (mLock)
{
return nativeEval(code);
String ret=nativeEval(code);
Log.i("starwisp","eval done: "+ret.length());
Log.i("starwisp",ret);
return ret;
}
}
......
android/src/foam/mongoose/StarwispBuilder.java
View file @ 0fd1901b
......@@ -39,6 +39,8 @@ import android.widget.Button;
import android.widget.ToggleButton;
import android.widget.LinearLayout;
import android.widget.FrameLayout;
import android.widget.GridLayout;
import android.widget.GridLayout.Spec;
import android.widget.ScrollView;
import android.widget.HorizontalScrollView;
import android.widget.SeekBar;
......@@ -106,6 +108,7 @@ public class StarwispBuilder
if (p.equals("centre")) return Gravity.CENTER;
if (p.equals("left")) return Gravity.LEFT;
if (p.equals("right")) return Gravity.RIGHT;
if (p.equals("fill")) return Gravity.FILL;
return Gravity.LEFT;
}
......@@ -169,9 +172,12 @@ public class StarwispBuilder
}
public void Build(final StarwispActivity ctx, final String ctxname, JSONArray arr, ViewGroup parent) {
try {
String type = arr.getString(0);
Log.i("starwisp","building started "+type);
if (type.equals("build-fragment")) {
String name = arr.getString(1);
int ID = arr.getInt(2);
......@@ -213,6 +219,23 @@ public class StarwispBuilder
return;
}
if (type.equals("grid-layout")) {
GridLayout v = new GridLayout(ctx);
v.setId(arr.getInt(1));
v.setColumnCount(arr.getInt(2));
v.setOrientation(BuildOrientation(arr.getString(3)));
v.setLayoutParams(BuildLayoutParams(arr.getJSONArray(4)));
parent.addView(v);
JSONArray children = arr.getJSONArray(5);
for (int i=0; i<children.length(); i++) {
Build(ctx,ctxname,new JSONArray(children.getString(i)), v);
}
return;
}
if (type.equals("scroll-view")) {
HorizontalScrollView v = new HorizontalScrollView(ctx);
v.setId(arr.getInt(1));
......@@ -259,10 +282,18 @@ public class StarwispBuilder
v.setTextSize(arr.getInt(3));
v.setMovementMethod(LinkMovementMethod.getInstance());
v.setLayoutParams(BuildLayoutParams(arr.getJSONArray(4)));
if (arr.length()>5 && arr.getString(5).equals("left")) {
v.setGravity(Gravity.LEFT);
if (arr.length()>5) {
if (arr.getString(5).equals("left")) {
v.setGravity(Gravity.LEFT);
} else {
if (arr.getString(5).equals("fill")) {
v.setGravity(Gravity.FILL);
} else {
v.setGravity(Gravity.CENTER);
}
}
} else {
v.setGravity(Gravity.CENTER);
v.setGravity(Gravity.LEFT);
}
v.setTypeface(((StarwispActivity)ctx).m_Typeface);
parent.addView(v);
......@@ -428,6 +459,9 @@ public class StarwispBuilder
} catch (JSONException e) {
Log.e("starwisp", "Error parsing ["+arr.toString()+"] " + e.toString());
}
Log.i("starwisp","building ended");
}
public void UpdateList(Activity ctx, String ctxname, JSONArray arr) {
......@@ -655,6 +689,18 @@ public class StarwispBuilder
}
}
if (type.equals("grid-layout")) {
GridLayout v = (GridLayout)vv;
if (token.equals("contents")) {
v.removeAllViews();
JSONArray children = arr.getJSONArray(3);
for (int i=0; i<children.length(); i++) {
Build(ctx,ctxname,new JSONArray(children.getString(i)), v);
}
}
}
if (type.equals("image-view")) {
ImageView v = (ImageView)vv;
if (token.equals("image")) {
......