Skip to content

GitLab

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

vibrate, sound, filtering, sorting, notes added

parent 3002c8f9
Show whitespace changes
Inline Side-by-side
Showing with 195 additions and 55 deletions
android/AndroidManifest.xml
View file @ 864e89a8
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android"
package="foam.mongoose"
android:versionCode="4"
android:versionCode="5"
android:versionName="1.0">
<application android:label="@string/app_name"
android:icon="@drawable/logo"
......@@ -36,6 +36,7 @@
<uses-permission android:name="android.permission.CHANGE_WIFI_STATE" />
<uses-permission android:name="android.permission.ACCESS_WIFI_STATE" />
<uses-permission android:name="android.permission.INTERNET"/>
<uses-permission android:name="android.permission.VIBRATE"/>
<uses-sdk android:minSdkVersion="8" />
<supports-screens
......
android/assets/eavdb.scm
View file @ 864e89a8
......@@ -215,8 +215,12 @@
(define (all-entities db table type)
(let ((s (db-select
db (string-append "select entity_id from " table "_entity where entity_type = ?")
type)))
db (string-append "select e.entity_id from " table "_entity as e "
"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)
'()
(map
......@@ -230,8 +234,11 @@
"select e.entity_id from " table "_entity as e "
"join " table "_value_" (ktv-type ktv)
" as a on a.entity_id = e.entity_id "
"where e.entity_type = ? and a.attribute_id = ? and a.value = ?")
type (ktv-key ktv) (ktv-value ktv))))
"join " table "_value_varchar "
" 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))
(if (null? s)
'()
......@@ -240,6 +247,41 @@
(vector-ref i 0))
(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)
;; check attribute for duplicate entity-id/attribute-ids
......@@ -272,27 +314,46 @@
(prof-end "db-all")
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")
(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))))
(let ((r (map
(lambda (i)
(get-entity db table i))
(all-entities-where db table type ktv))))
(prof-end "db-all-where")
r))
(define (db-all-where2 db table type ktv)
(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-where db table type ktv))))
(all-entities-where2 db table type ktv ktv2))))
(prof-end "db-all-where2")
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
......
android/assets/lib.scm
View file @ 864e89a8
......@@ -461,9 +461,9 @@
(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 (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))
;; treat this like a dialog so the callback fires
(define (list-files name path fn) (list "list-files" 0 "list-files" name fn path))
......@@ -618,14 +618,14 @@
(define (horiz . l)
(linear-layout
0 'horizontal
(layout 'fill-parent 'fill-parent 1 'left 0)
(layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0)
l))
(define (vert . l)
(linear-layout
0 'vertical
(layout 'fill-parent 'fill-parent 1 'left 0)
(layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0)
l))
......
android/assets/starwisp.scm
View file @ 864e89a8
......@@ -149,7 +149,7 @@
(define (entity-record-values db table type)
;; standard bits
(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! "lon" "real" 0)
(let ((values (get-current 'entity-values '())))
......@@ -367,11 +367,15 @@
;;;;
(define (build-grid-selector name type title)
(vert
(linear-layout
0 'vertical
(layout 'fill-parent 'wrap-content 1 'left 0)
(list 0 0 0 0)
(list
(mtext "title" title)
(linear-layout
0 'horizontal
(layout 'fill-parent 'fill-parent 1 'left 2) trans-col
(layout 'fill-parent 'wrap-content 1 'left 2) trans-col
(list
(image-view (make-id "im") "arrow_left" (layout 100 'fill-parent 1 'left 0))
(scroll-view
......@@ -384,7 +388,7 @@
(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))))))
(image-view (make-id "im") "arrow_right" (layout 100 'fill-parent 1 'right 0)))))))
;; assumes grid selectors on mongeese only
(define (fast-get-name item)
......@@ -432,10 +436,42 @@
r)))
(define (db-mongooses-by-pack)
(db-all-where2
(db-all-where
db "sync" "mongoose"
(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 @@
(horiz
(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-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)
(activity-layout fragment))
(lambda (fragment arg)
......@@ -548,6 +585,8 @@
(activity-layout fragment))
(lambda (fragment arg)
(list
(play-sound "ping")
(vibrate 300)
(populate-grid-selector
"pf-scan-nearest" "single"
(db-mongooses-by-pack)
......@@ -718,7 +757,7 @@
(linear-layout
(make-id "") 'vertical fillwrap gp-col
(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-leader" "single" "Leader")
(linear-layout
......@@ -842,6 +881,33 @@
(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 @@
(fragment
"gc-start"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtitle "title" "Start")
(mtoggle-button "gc-start-main-obs" "Main observer" (lambda (v) '()))
......@@ -878,7 +944,7 @@
(fragment
"gc-weights"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtitle "title" "Weights")
(build-grid-selector "gc-weigh-choose" "toggle" "Choose mongoose")
......@@ -903,7 +969,7 @@
(fragment
"gc-preg"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtitle "title" "Pregnant females")
(build-grid-selector "gc-preg-choose" "toggle" "Choose")))
......@@ -914,7 +980,7 @@
(list
(populate-grid-selector
"gc-preg-choose" "toggle"
(db-mongooses-by-pack)
(db-mongooses-by-pack-female)
(lambda (individual)
(list)))
))
......@@ -927,7 +993,7 @@
(fragment
"gc-pup-assoc"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtitle "title" "Pup Associations")
(build-grid-selector "gc-pup-choose" "toggle" "Choose pup")
......@@ -956,7 +1022,7 @@
(fragment
"gc-oestrus"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtext "" "Oestrus...")))
(lambda (fragment arg)
......@@ -971,7 +1037,7 @@
(fragment
"gc-babysitting"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtext "" "Babysittings...")))
(lambda (fragment arg)
......@@ -986,7 +1052,7 @@
(fragment
"gc-end"
(linear-layout
(make-id "") 'vertical fillwrap gc-col
(make-id "") 'vertical fill gc-col
(list
(mtext "" "end!...")))
(lambda (fragment arg)
......@@ -1142,8 +1208,8 @@
(text-view (make-id "obs-title") "" 40 fillwrap)
(linear-layout
(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 "events" (make-id "event-holder") (layout 595 450 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 'fill-parent 450 1 'left 0))
(mbutton "gc-done" "Done" (lambda () (list (finish-activity 0))))))
(lambda (activity arg)
(activity-layout activity))
......
android/src/foam/mongoose/Scheme.java
View file @ 864e89a8
......@@ -46,11 +46,11 @@ public class Scheme
}
public String eval(String code) {
Log.i("starwisp","eval on");
//Log.i("starwisp","eval on");
synchronized (mLock)
{
String ret=nativeEval(code);
Log.i("starwisp","eval done: "+ret.length());
//Log.i("starwisp","eval done: "+ret.length());
//Log.i("starwisp",ret);
return ret;
}
......
android/src/foam/mongoose/StarwispBuilder.java
View file @ 864e89a8
......@@ -24,6 +24,8 @@ import android.support.v4.app.FragmentTransaction;
import android.support.v4.app.FragmentManager;
import android.support.v4.app.FragmentPagerAdapter;
import android.support.v4.view.ViewPager;
import android.media.MediaPlayer;
import android.os.Vibrator;
// removed due to various aggravating factors
//import android.support.v7.widget.GridLayout;
......@@ -674,7 +676,7 @@ public class StarwispBuilder
final Integer id = arr.getInt(1);
String token = arr.getString(2);
Log.i("starwisp", "Update: "+type+" "+id+" "+token);
//Log.i("starwisp", "Update: "+type+" "+id+" "+token);
// non widget commands
if (token.equals("toast")) {
......@@ -683,6 +685,17 @@ public class StarwispBuilder
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")) {
int ID = arr.getInt(1);
String name = arr.getString(2);
......@@ -1101,7 +1114,6 @@ public class StarwispBuilder
}
if (type.equals("text-view") || type.equals("debug-text-view")) {
Log.i("starwisp","text-view...");
TextView v = (TextView)vv;
if (token.equals("text")) {
if (type.equals("debug-text-view")) {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment