Commit 864e89a8 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

vibrate, sound, filtering, sorting, notes added

parent 3002c8f9
<?xml version="1.0" encoding="utf-8"?> <?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" <manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.mongoose" package="foam.mongoose"
android:versionCode="4" android:versionCode="5"
android:versionName="1.0"> android:versionName="1.0">
<application android:label="@string/app_name" <application android:label="@string/app_name"
android:icon="@drawable/logo" android:icon="@drawable/logo"
...@@ -36,6 +36,7 @@ ...@@ -36,6 +36,7 @@
<uses-permission android:name="android.permission.CHANGE_WIFI_STATE" /> <uses-permission android:name="android.permission.CHANGE_WIFI_STATE" />
<uses-permission android:name="android.permission.ACCESS_WIFI_STATE" /> <uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
<uses-permission android:name="android.permission.INTERNET"/> <uses-permission android:name="android.permission.INTERNET"/>
<uses-permission android:name="android.permission.VIBRATE"/>
<uses-sdk android:minSdkVersion="8" /> <uses-sdk android:minSdkVersion="8" />
<supports-screens <supports-screens
......
...@@ -215,8 +215,12 @@ ...@@ -215,8 +215,12 @@
(define (all-entities db table type) (define (all-entities db table type)
(let ((s (db-select (let ((s (db-select
db (string-append "select entity_id from " table "_entity where entity_type = ?") db (string-append "select e.entity_id from " table "_entity as e "
type))) "join " table "_value_varchar "
" as n on n.entity_id = e.entity_id "
"where entity_type = ? and n.attribute_id = ? order by n.value")
type "name")))
(msg (db-status db))
(if (null? s) (if (null? s)
'() '()
(map (map
...@@ -230,8 +234,11 @@ ...@@ -230,8 +234,11 @@
"select e.entity_id from " table "_entity as e " "select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv) "join " table "_value_" (ktv-type ktv)
" as a on a.entity_id = e.entity_id " " as a on a.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? and a.value = ?") "join " table "_value_varchar "
type (ktv-key ktv) (ktv-value ktv)))) " as n on n.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? "
"and a.value = ? and n.attribute_id = ? order by n.value")
type (ktv-key ktv) (ktv-value ktv) "name")))
(msg (db-status db)) (msg (db-status db))
(if (null? s) (if (null? s)
'() '()
...@@ -240,6 +247,41 @@ ...@@ -240,6 +247,41 @@
(vector-ref i 0)) (vector-ref i 0))
(cdr s))))) (cdr s)))))
(define (all-entities-where2 db table type ktv ktv2)
(let ((s (db-select
db (string-append
"select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv)
" as a on a.entity_id = e.entity_id "
"join " table "_value_" (ktv-type ktv2)
" as b on b.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value = ? ")
type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (all-entities-where-newer db table type ktv ktv2)
(let ((s (db-select
db (string-append
"select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv)
" as a on a.entity_id = e.entity_id "
"join " table "_value_" (ktv-type ktv2)
" as b on b.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? and b.attribute_id =? and a.value = ? and b.value > DateTime(?) ")
type (ktv-key ktv) (ktv-key ktv2) (ktv-value ktv) (ktv-value ktv2))))
(msg (db-status db))
(if (null? s)
'()
(map
(lambda (i)
(vector-ref i 0))
(cdr s)))))
(define (validate db) (define (validate db)
;; check attribute for duplicate entity-id/attribute-ids ;; check attribute for duplicate entity-id/attribute-ids
...@@ -272,27 +314,46 @@ ...@@ -272,27 +314,46 @@
(prof-end "db-all") (prof-end "db-all")
r)) r))
(define (db-all-where db table type clause) ;(define (db-all-where db table type clause)
; (prof-start "db-all-where")
; (let ((r (foldl
; (lambda (i r)
; (let ((e (get-entity db table i)))
; (if (equal? (ktv-get e (car clause)) (cadr clause))
; (cons e r) r)))
; '()
; (all-entities db table type))))
; (prof-end "db-all-where")
; r))
(define (db-all-where db table type ktv)
(prof-start "db-all-where") (prof-start "db-all-where")
(let ((r (foldl (let ((r (map
(lambda (i r) (lambda (i)
(let ((e (get-entity db table i))) (get-entity db table i))
(if (equal? (ktv-get e (car clause)) (cadr clause)) (all-entities-where db table type ktv))))
(cons e r) r)))
'()
(all-entities db table type))))
(prof-end "db-all-where") (prof-end "db-all-where")
r)) r))
(define (db-all-where2 db table type ktv) (define (db-all-where2 db table type ktv ktv2)
(prof-start "db-all-where2") (prof-start "db-all-where2")
(let ((r (map (let ((r (map
(lambda (i) (lambda (i)
(get-entity db table i)) (get-entity db table i))
(all-entities-where db table type ktv)))) (all-entities-where2 db table type ktv ktv2))))
(prof-end "db-all-where2") (prof-end "db-all-where2")
r)) r))
(define (db-all-where2 db table type ktv ktv2)
(prof-start "db-all-where2")
(let ((r (map
(lambda (i)
(get-entity db table i))
(all-entities-where2 db table type ktv ktv2))))
(prof-end "db-all-where2")
r))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data ;; updating data
......
...@@ -461,9 +461,9 @@ ...@@ -461,9 +461,9 @@
(define (drawlist-line colour width points) (list "line" colour width points)) (define (drawlist-line colour width points) (list "line" colour width points))
(define (drawlist-text text x y colour size align) (list "text" text x y colour size align)) (define (drawlist-text text x y colour size align) (list "text" text x y colour size align))
(define (toast msg) (list "toast" 0 "toast" msg)) (define (toast msg) (list "toast" 0 "toast" msg))
(define (play-sound wav) (list "play-sound" 0 "play-sound" wav))
(define (vibrate time) (list "vibrate" 0 "vibrate" time))
(define (make-directory name) (list "make-directory" 0 "make-directory" name)) (define (make-directory name) (list "make-directory" 0 "make-directory" name))
;; treat this like a dialog so the callback fires ;; treat this like a dialog so the callback fires
(define (list-files name path fn) (list "list-files" 0 "list-files" name fn path)) (define (list-files name path fn) (list "list-files" 0 "list-files" name fn path))
...@@ -618,14 +618,14 @@ ...@@ -618,14 +618,14 @@
(define (horiz . l) (define (horiz . l)
(linear-layout (linear-layout
0 'horizontal 0 'horizontal
(layout 'fill-parent 'fill-parent 1 'left 0) (layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0) (list 0 0 0 0)
l)) l))
(define (vert . l) (define (vert . l)
(linear-layout (linear-layout
0 'vertical 0 'vertical
(layout 'fill-parent 'fill-parent 1 'left 0) (layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0) (list 0 0 0 0)
l)) l))
......
...@@ -149,7 +149,7 @@ ...@@ -149,7 +149,7 @@
(define (entity-record-values db table type) (define (entity-record-values db table type)
;; standard bits ;; standard bits
(entity-add-value! "user" "varchar" (get-current 'user-id "none")) (entity-add-value! "user" "varchar" (get-current 'user-id "none"))
(entity-add-value! "time" "varchar" (dt->string (date-time))) (entity-add-value! "time" "varchar" (date->string (date-time)))
(entity-add-value! "lat" "real" 0) (entity-add-value! "lat" "real" 0)
(entity-add-value! "lon" "real" 0) (entity-add-value! "lon" "real" 0)
(let ((values (get-current 'entity-values '()))) (let ((values (get-current 'entity-values '())))
...@@ -367,24 +367,28 @@ ...@@ -367,24 +367,28 @@
;;;; ;;;;
(define (build-grid-selector name type title) (define (build-grid-selector name type title)
(vert (linear-layout
(mtext "title" title) 0 'vertical
(linear-layout (layout 'fill-parent 'wrap-content 1 'left 0)
0 'horizontal (list 0 0 0 0)
(layout 'fill-parent 'fill-parent 1 'left 2) trans-col (list
(list (mtext "title" title)
(image-view (make-id "im") "arrow_left" (layout 100 'fill-parent 1 'left 0)) (linear-layout
(scroll-view 0 'horizontal
(make-id "scroller") (layout 'fill-parent 'wrap-content 1 'left 2) trans-col
(layout 'wrap-content 'wrap-content 1 'left 20) (list
(list (image-view (make-id "im") "arrow_left" (layout 100 'fill-parent 1 'left 0))
(linear-layout (scroll-view
(make-id name) 'horizontal (make-id "scroller")
(layout 'wrap-content 'wrap-content 1 'centre 20) trans-col (layout 'wrap-content 'wrap-content 1 'left 20)
(list (list
(button-grid (make-id name) type 3 20 (layout 100 40 1 'left 40) (linear-layout
(list) (lambda (v) '())))))) (make-id name) 'horizontal
(image-view (make-id "im") "arrow_right" (layout 100 'fill-parent 1 'right 0)))))) (layout 'wrap-content 'wrap-content 1 'centre 20) trans-col
(list
(button-grid (make-id name) type 3 20 (layout 100 40 1 'left 40)
(list) (lambda (v) '()))))))
(image-view (make-id "im") "arrow_right" (layout 100 'fill-parent 1 'right 0)))))))
;; assumes grid selectors on mongeese only ;; assumes grid selectors on mongeese only
(define (fast-get-name item) (define (fast-get-name item)
...@@ -432,10 +436,42 @@ ...@@ -432,10 +436,42 @@
r))) r)))
(define (db-mongooses-by-pack) (define (db-mongooses-by-pack)
(db-all-where2 (db-all-where
db "sync" "mongoose" db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id")))) (ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))))
(define (db-mongooses-by-pack-male)
(db-all-where2
db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "gender" "varchar" "Male")))
(define (db-mongooses-by-pack-female)
(db-all-where2
db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "gender" "varchar" "Female")))
;; (y m d h m s)
(define (date-minus-months d ms)
(let ((year (list-ref d 0))
(month (- (list-ref d 1) 1)))
(let ((new-month (- month ms)))
(list
(if (< new-month 0) (- year 1) year)
(+ (if (< new-month 0) (+ new-month 12) new-month) 1)
(list-ref d 2)
(list-ref d 3)
(list-ref d 4)
(list-ref d 5)))))
(define (db-mongooses-by-pack-pups)
(all-entities-where-newer
db "sync" "mongoose"
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(ktv "dob" "varchar" (date->string (date-minus-months (date-time) 6)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ;;
...@@ -514,7 +550,8 @@ ...@@ -514,7 +550,8 @@
(horiz (horiz
(mbutton2 "evb-grpint" "Interaction" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpint")))) (mbutton2 "evb-grpint" "Interaction" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpint"))))
(mbutton2 "evb-grpalarm" "Alarm" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpalarm")))) (mbutton2 "evb-grpalarm" "Alarm" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpalarm"))))
(mbutton2 "evb-grpmov" "Movement" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpmov"))))))))) (mbutton2 "evb-grpmov" "Movement" (lambda () (list (replace-fragment (get-id "event-holder") "ev-grpmov"))))
(mbutton2 "evb-grpnote" "Note" (lambda () (list (replace-fragment (get-id "event-holder") "note")))))))))
(lambda (fragment arg) (lambda (fragment arg)
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -548,6 +585,8 @@ ...@@ -548,6 +585,8 @@
(activity-layout fragment)) (activity-layout fragment))
(lambda (fragment arg) (lambda (fragment arg)
(list (list
(play-sound "ping")
(vibrate 300)
(populate-grid-selector (populate-grid-selector
"pf-scan-nearest" "single" "pf-scan-nearest" "single"
(db-mongooses-by-pack) (db-mongooses-by-pack)
...@@ -718,7 +757,7 @@ ...@@ -718,7 +757,7 @@
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gp-col (make-id "") 'vertical fillwrap gp-col
(list (list
(mtitle "title" "Event: Group Interaction") (mtext "title" "Event: Group Interaction")
(build-grid-selector "gp-int-pack" "single" "Inter-group interaction: Other pack identity") (build-grid-selector "gp-int-pack" "single" "Inter-group interaction: Other pack identity")
(build-grid-selector "gp-int-leader" "single" "Leader") (build-grid-selector "gp-int-leader" "single" "Leader")
(linear-layout (linear-layout
...@@ -842,6 +881,33 @@ ...@@ -842,6 +881,33 @@
(lambda (fragment) '()) (lambda (fragment) '())
(lambda (fragment) '())) (lambda (fragment) '()))
(fragment
"note"
(linear-layout
(make-id "") 'vertical fillwrap gp-col
(list
(mtitle "title" "Make a note")
(edit-text (make-id "note-text") "" 20 "text" fillwrap
(lambda (v)
(entity-add-value! "text" "varchar" v)
'()))
(horiz
(mbutton "note-done" "Done"
(lambda ()
(entity-record-values db "stream" "note")
(list (replace-fragment (get-id "event-holder") "events"))))
(mbutton "note-cancel" "Cancel"
(lambda ()
(entity-reset!)
(list (replace-fragment (get-id "event-holder") "events")))))))
(lambda (fragment arg)
(activity-layout fragment))
(lambda (fragment arg) (list))
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '())
(lambda (fragment) '()))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
...@@ -852,7 +918,7 @@ ...@@ -852,7 +918,7 @@
(fragment (fragment
"gc-start" "gc-start"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtitle "title" "Start") (mtitle "title" "Start")
(mtoggle-button "gc-start-main-obs" "Main observer" (lambda (v) '())) (mtoggle-button "gc-start-main-obs" "Main observer" (lambda (v) '()))
...@@ -878,7 +944,7 @@ ...@@ -878,7 +944,7 @@
(fragment (fragment
"gc-weights" "gc-weights"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtitle "title" "Weights") (mtitle "title" "Weights")
(build-grid-selector "gc-weigh-choose" "toggle" "Choose mongoose") (build-grid-selector "gc-weigh-choose" "toggle" "Choose mongoose")
...@@ -903,7 +969,7 @@ ...@@ -903,7 +969,7 @@
(fragment (fragment
"gc-preg" "gc-preg"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtitle "title" "Pregnant females") (mtitle "title" "Pregnant females")
(build-grid-selector "gc-preg-choose" "toggle" "Choose"))) (build-grid-selector "gc-preg-choose" "toggle" "Choose")))
...@@ -914,7 +980,7 @@ ...@@ -914,7 +980,7 @@
(list (list
(populate-grid-selector (populate-grid-selector
"gc-preg-choose" "toggle" "gc-preg-choose" "toggle"
(db-mongooses-by-pack) (db-mongooses-by-pack-female)
(lambda (individual) (lambda (individual)
(list))) (list)))
)) ))
...@@ -927,7 +993,7 @@ ...@@ -927,7 +993,7 @@
(fragment (fragment
"gc-pup-assoc" "gc-pup-assoc"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtitle "title" "Pup Associations") (mtitle "title" "Pup Associations")
(build-grid-selector "gc-pup-choose" "toggle" "Choose pup") (build-grid-selector "gc-pup-choose" "toggle" "Choose pup")
...@@ -956,7 +1022,7 @@ ...@@ -956,7 +1022,7 @@
(fragment (fragment
"gc-oestrus" "gc-oestrus"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtext "" "Oestrus..."))) (mtext "" "Oestrus...")))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -971,7 +1037,7 @@ ...@@ -971,7 +1037,7 @@
(fragment (fragment
"gc-babysitting" "gc-babysitting"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtext "" "Babysittings..."))) (mtext "" "Babysittings...")))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -986,7 +1052,7 @@ ...@@ -986,7 +1052,7 @@
(fragment (fragment
"gc-end" "gc-end"
(linear-layout (linear-layout
(make-id "") 'vertical fillwrap gc-col (make-id "") 'vertical fill gc-col
(list (list
(mtext "" "end!..."))) (mtext "" "end!...")))
(lambda (fragment arg) (lambda (fragment arg)
...@@ -1142,8 +1208,8 @@ ...@@ -1142,8 +1208,8 @@
(text-view (make-id "obs-title") "" 40 fillwrap) (text-view (make-id "obs-title") "" 40 fillwrap)
(linear-layout (linear-layout
(make-id "obs-buttons-bar") 'horizontal fillwrap trans-col '()) (make-id "obs-buttons-bar") 'horizontal fillwrap trans-col '())
(build-fragment "gc-start" (make-id "gc-top") (layout 595 400 1 'left 0)) (build-fragment "gc-start" (make-id "gc-top") (layout 'fill-parent 400 1 'left 0))
(build-fragment "events" (make-id "event-holder") (layout 595 450 1 'left 0)) (build-fragment "events" (make-id "event-holder") (layout 'fill-parent 450 1 'left 0))
(mbutton "gc-done" "Done" (lambda () (list (finish-activity 0)))))) (mbutton "gc-done" "Done" (lambda () (list (finish-activity 0))))))
(lambda (activity arg) (lambda (activity arg)
(activity-layout activity)) (activity-layout activity))
......
...@@ -46,11 +46,11 @@ public class Scheme ...@@ -46,11 +46,11 @@ public class Scheme
} }
public String eval(String code) { public String eval(String code) {
Log.i("starwisp","eval on"); //Log.i("starwisp","eval on");
synchronized (mLock) synchronized (mLock)
{ {
String ret=nativeEval(code); String ret=nativeEval(code);
Log.i("starwisp","eval done: "+ret.length()); //Log.i("starwisp","eval done: "+ret.length());
//Log.i("starwisp",ret); //Log.i("starwisp",ret);
return ret; return ret;
} }
......
...@@ -24,6 +24,8 @@ import android.support.v4.app.FragmentTransaction; ...@@ -24,6 +24,8 @@ import android.support.v4.app.FragmentTransaction;
import android.support.v4.app.FragmentManager; import android.support.v4.app.FragmentManager;
import android.support.v4.app.FragmentPagerAdapter; import android.support.v4.app.FragmentPagerAdapter;
import android.support.v4.view.ViewPager; import android.support.v4.view.ViewPager;
import android.media.MediaPlayer;
import android.os.Vibrator;
// removed due to various aggravating factors // removed due to various aggravating factors
//import android.support.v7.widget.GridLayout; //import android.support.v7.widget.GridLayout;
...@@ -674,7 +676,7 @@ public class StarwispBuilder ...@@ -674,7 +676,7 @@ public class StarwispBuilder
final Integer id = arr.getInt(1); final Integer id = arr.getInt(1);
String token = arr.getString(2); String token = arr.getString(2);
Log.i("starwisp", "Update: "+type+" "+id+" "+token); //Log.i("starwisp", "Update: "+type+" "+id+" "+token);
// non widget commands // non widget commands
if (token.equals("toast")) { if (token.equals("toast")) {
...@@ -683,6 +685,17 @@ public class StarwispBuilder ...@@ -683,6 +685,17 @@ public class StarwispBuilder
return; return;
} }
if (token.equals("play-sound")) {
MediaPlayer mp = MediaPlayer.create(ctx, R.raw.ping);
mp.start();
}
if (token.equals("vibrate")) {
Vibrator v = (Vibrator) ctx.getSystemService(Context.VIBRATOR_SERVICE);
v.vibrate(arr.getInt(3));
}
if (type.equals("replace-fragment")) { if (type.equals("replace-fragment")) {
int ID = arr.getInt(1);