Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
citizen-science
symbai
Commits
a955e206
Commit
a955e206
authored
Mar 27, 2014
by
Dave Griffiths
Browse files
photos integrated partially, db sync activity added
parent
91edfc64
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
145 additions
and
43 deletions
+145
-43
android/AndroidManifest.xml
android/AndroidManifest.xml
+1
-0
android/assets/dbsync.scm
android/assets/dbsync.scm
+20
-6
android/assets/lib.scm
android/assets/lib.scm
+3
-3
android/assets/starwisp.scm
android/assets/starwisp.scm
+120
-4
android/src/foam/symbai/SocialActivity.java
android/src/foam/symbai/SocialActivity.java
+0
-30
android/src/foam/symbai/starwisp.java
android/src/foam/symbai/starwisp.java
+1
-0
No files found.
android/AndroidManifest.xml
View file @
a955e206
...
...
@@ -29,6 +29,7 @@
<activity
android:name=
"foam.symbai.SocialActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.AgreementActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.IndividualChooserActivity"
android:configChanges=
"orientation"
></activity>
<activity
android:name=
"foam.symbai.SyncActivity"
android:configChanges=
"orientation"
></activity>
</application>
...
...
android/assets/dbsync.scm
View file @
a955e206
...
...
@@ -16,6 +16,7 @@
;; abstractions for synced databased
(
msg
"dbsync.scm"
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
...
...
@@ -136,6 +137,7 @@
((
and
unique-id
(
not
(
null?
values
)))
(
update-entity
db
table
(
entity-id-from-unique
db
table
unique-id
)
values
)
(
msg
"updated "
unique-id
)
(
msg
values
)
(
entity-reset!
))
(
else
(
msg
"no values or no id to update as entity:"
unique-id
"values:"
values
))))))
...
...
@@ -159,6 +161,8 @@
(
define
url
"http://192.168.2.1:8889/symbai?"
)
(
msg
"url"
)
(
define
(
build-url-from-ktv
ktv
)
(
string-append
"&"
(
ktv-key
ktv
)
":"
(
ktv-type
ktv
)
"="
(
stringify-value-url
ktv
)))
...
...
@@ -192,6 +196,9 @@
r
))
'
()
ktvlist
))
(
msg
"spit"
)
;; spit all dirty entities to server
(
define
(
spit
db
table
entities
)
(
foldl
...
...
@@ -216,17 +223,19 @@
(
update-entity-clean
db
table
(
cadr
v
))
(
append
(
send-files
e
)
(
debug!
(
string-append
"Updated changed "
(
car
(
car
e
)))))
(
debug!
(
string-append
"Updated changed "
(
car
(
car
e
)))))
)
(
else
(
debug!
(
string-append
"Problem uploading "
(
car
(
car
e
))
" : "
(
car
v
)))))
(
list
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
))))))
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
db
))))))
r
))
'
()
entities
))
(
msg
"request files"
)
;; todo fix all hardcoded paths here
(
define
(
request-files
ktvlist
)
(
foldl
...
...
@@ -240,6 +249,9 @@
r
))
'
()
ktvlist
))
(
msg
"suck ent"
)
(
define
(
suck-entity-from-server
db
table
unique-id
exists
)
;; ask for the current version
(
http-request
...
...
@@ -263,7 +275,7 @@
(
debug!
(
string-append
(
if
exists
"Got new: "
"Updated: "
)
(
ktv-get
ktvlist
"name"
)))
(
list
(
request-files
ktvlist
)
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
)))))))
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
db
)))))))
;; repeatedly read version and request updates
(
define
(
suck-new
db
table
)
...
...
@@ -307,12 +319,14 @@
(
play-sound
"active"
)
r
))))))))
(
define
(
build-dirty
)
(
msg
"build-dirty defined..."
)
(
define
(
build-dirty
db
)
(
let
((
sync
(
get-dirty-stats
db
"sync"
))
(
stream
(
get-dirty-stats
db
"stream"
)))
(
string-append
"
Pack
data: "
(
number->string
(
car
sync
))
"/"
(
number->string
(
cadr
sync
))
" "
"
Focal
data: "
(
number->string
(
car
stream
))
"/"
(
number->string
(
cadr
stream
)))))
"
Sync
data: "
(
number->string
(
car
sync
))
"/"
(
number->string
(
cadr
sync
))
" "
"
Stream
data: "
(
number->string
(
car
stream
))
"/"
(
number->string
(
cadr
stream
)))))
(
define
(
upload-dirty
db
)
(
let
((
r
(
append
...
...
android/assets/lib.scm
View file @
a955e206
...
...
@@ -548,11 +548,11 @@
(
id-map-get
name
))
(
define
(
make-id
name
)
(
msg
"making id for"
name
)
;;
(msg "making id for" name)
(
let
((
id
(
id-map-get
name
)))
(
cond
((
zero?
id
)
(
msg
"this is a new id"
)
;;
(msg "this is a new id")
; (prof-start "make-id")
(
id-map-add
name
current-id
)
(
set!
current-id
(
+
current-id
1
))
...
...
@@ -561,7 +561,7 @@
(
else
;; seems scheme is shut down while the id store keeps going?
(
when
(
>
id
current-id
)
(
set!
current-id
(
+
id
1
)))
(
msg
"we have seen this one before"
)
;;
(msg "we have seen this one before")
id
))))
(
define
prof-map
'
())
...
...
android/assets/starwisp.scm
View file @
a955e206
...
...
@@ -38,6 +38,8 @@
(
list
(
ktv
"user-id"
"varchar"
"No name yet..."
)))
(
define
entity-types
'
())
;;(display (db-all db "local" "app-settings"))(newline)
...
...
@@ -77,6 +79,17 @@
(
list
'delete-are-you-sure
(
list
"Are you sure you want to delete this?"
))
(
list
'save-are-you-sure
(
list
"Are you sure you want to save changes?"
))
;; sync
(
list
'sync-all
(
list
"Sync me!"
))
(
list
'sync-syncall
(
list
"Sync everything"
))
(
list
'export-data
(
list
"Exporting data"
))
(
list
'sync-download
(
list
"Download main DB"
))
(
list
'sync-export
(
list
"Email main DB"
))
(
list
'email-local
(
list
"Email local DB"
))
(
list
'debug
(
list
"Debug"
))
(
list
'sync-back
(
list
"Back"
))
(
list
'sync-prof
(
list
"Profile"
))
;; village screen
(
list
'village-name
(
list
"Village name"
"Village name"
"Village name"
))
(
list
'block
(
list
"Block"
"Block"
"Block"
))
...
...
@@ -341,6 +354,13 @@
((
eq?
widget-type
'toggle-button
)
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'selected
(
entity-get-value
key
)))
((
eq?
widget-type
'image-view
)
(
let
((
image-name
(
entity-get-value
key
)))
(
msg
"updating widget: "
image-name
)
(
if
(
equal?
image-name
"none"
)
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'image
"face"
)
(
update-widget
widget-type
(
get-symbol-id
id-symbol
)
'external-image
(
string-append
dirname
"files/"
image-name
)))))
(
else
(
msg
"mupdate-widget unhandled widget type"
widget-type
))))
;;;;
...
...
@@ -587,7 +607,7 @@
(
mtitle
'title
)
(
horiz
(
medit-text
'user-id
"normal"
(
lambda
()
(
list
)))
(
mbutton-scale
'sync
(
lambda
()
(
list
))))
(
mbutton-scale
'sync
(
lambda
()
(
list
(
start-activity
"sync"
0
""
)
))))
(
mspinner
'languages
(
list
'english
'khasi
'hindi
)
(
lambda
(
c
)
(
list
)))
(
mbutton
'test-upload
(
lambda
()
...
...
@@ -611,7 +631,8 @@
(
ktv
"name"
"varchar"
(
mtext-lookup
'default-village-name
))
(
ktv
"block"
"varchar"
""
)
(
ktv
"district"
"varchar"
"test"
)
(
ktv
"car"
"int"
0
))))
(
ktv
"car"
"int"
0
)
(
ktv
"photo"
"file"
"none"
))))
(
lambda
(
activity
arg
)
(
set-current!
'activity-title
"Main screen"
)
...
...
@@ -653,6 +674,18 @@
(
horiz
(
medit-text
'district
"normal"
(
lambda
()
'
()))
(
mtoggle-button-scale
'car
(
lambda
()
'
())))
(
vert
(
image-view
(
make-id
"photo"
)
"face"
(
layout
240
320
-1
'centre
10
))
(
mbutton
'change-photo
(
lambda
()
(
list
(
take-photo
(
string-append
dirname
"files/"
(
entity-get-value
"unique_id"
)
"-face.jpg"
)
photo-code
))
)))
(
mbutton
'household-list
(
lambda
()
(
list
(
start-activity
"household-list"
0
""
))))
(
mtitle
'amenities
)
(
place-widgets
'school
#t
)
...
...
@@ -669,6 +702,7 @@
(
set-current!
'activity-title
"Village"
)
(
activity-layout
activity
))
(
lambda
(
activity
arg
)
(
msg
"on start"
)
(
msg
"activity start - entity init"
)
(
entity-init!
db
"sync"
"village"
(
get-entity-by-unique
db
"sync"
arg
))
(
msg
"activity start - entity init done"
)
...
...
@@ -677,12 +711,25 @@
(
mupdate
'edit-text
'block
"block"
)
(
mupdate
'edit-text
'district
"district"
)
(
mupdate
'toggle-button
'car
"car"
)
(
mupdate
'image-view
'photo
"photo"
)
(
toast
arg
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
'
())
(
lambda
(
activity
requestcode
resultcode
)
'
()))
(
lambda
(
activity
requestcode
resultcode
)
(
msg
"back from camera"
)
(
cond
((
eqv?
requestcode
photo-code
)
;; todo: means we save when the camera happens
;; need to do this before init is called again in on-start,
;; which happens next
(
entity-set-value!
"photo"
"file"
(
string-append
(
entity-get-value
"unique_id"
)
"-face.jpg"
))
(
entity-update-values!
)
(
list
(
mupdate
'image-view
'photo
"photo"
)))
(
else
'
()))))
(
activity
...
...
@@ -976,6 +1023,72 @@
(
activity
"sync"
(
vert
(
text-view
(
make-id
"sync-title"
)
"Sync database"
40
fillwrap
)
(
mtext
'sync-dirty
"..."
)
(
horiz
(
mtoggle-button-scale
'sync-all
(
lambda
(
v
)
(
set-current!
'sync-on
v
)))
(
mbutton-scale
'sync-syncall
(
lambda
()
(
let
((
r
(
append
(
spit
db
"sync"
(
dirty-and-all-entities
db
"sync"
))
(
spit
db
"stream"
(
dirty-and-all-entities
db
"stream"
)))))
(
cons
(
toast
"Uploading data..."
)
r
)))))
(
mtitle
'export-data
)
(
horiz
(
mbutton-scale
'sync-download
(
lambda
()
(
debug!
(
string-append
"Downloading whole db"
))
(
append
(
foldl
(
lambda
(
e
r
)
(
debug!
(
string-append
"Downloading /sdcard/symbai/"
e
".csv"
))
(
cons
(
http-download
(
string-append
"getting-"
e
)
(
string-append
url
"fn=entity-csv&table=stream&type="
e
)
(
string-append
"/sdcard/mongoose/"
e
".csv"
))
r
))
(
list
(
http-download
"getting-db"
"http://192.168.2.1:8889/symbai.db"
(
string-append
"/sdcard/symbai/symbai.db"
))
)
entity-types
)
(
list
))))
(
mbutton-scale
'sync-export
(
lambda
()
(
debug!
"Sending mail"
)
(
list
(
send-mail
""
"From Symbai"
"Please find attached your mongoose data"
(
cons
"/sdcard/symbai/symbai.db"
(
map
(
lambda
(
e
)
(
string-append
"/sdcard/symbai/"
e
".csv"
))
entity-types
))))))
(
mbutton-scale
'email-local
(
lambda
()
(
debug!
"Sending mail"
)
(
list
(
send-mail
""
"From symbai"
"Please find attached your local data"
(
list
"/sdcard/symbai/local-symbai.db"
)))))
)
(
spacer
10
)
(
mtitle
'debug
)
(
scroll-view-vert
0
(
layout
'fill-parent
200
1
'left
0
)
(
list
(
vert
(
debug-text-view
(
make-id
"sync-debug"
)
"..."
15
(
layout
'fill-parent
400
1
'left
0
)))))
(
spacer
10
)
(
horiz
(
mbutton-scale
'sync-back
(
lambda
()
(
list
(
finish-activity
1
))))
(
mbutton-scale
'sync-prof
(
lambda
()
(
prof-print
)
(
list
))))
)
(
lambda
(
activity
arg
)
...
...
@@ -986,7 +1099,7 @@
(
debug-timer-cb
)
(
list
(
update-widget
'debug-text-view
(
get-id
"sync-debug"
)
'text
(
get-current
'debug-text
""
))
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
))
(
update-widget
'text-view
(
get-id
"sync-dirty"
)
'text
(
build-dirty
db
))
)))
(
lambda
(
activity
)
'
())
(
lambda
(
activity
)
(
list
(
delayed
"debug-timer"
1000
(
lambda
()
'
()))))
...
...
@@ -996,4 +1109,7 @@
)
android/src/foam/symbai/SocialActivity.java
deleted
100644 → 0
View file @
91edfc64
// Starwisp Copyright (C) 2013 Dave Griffiths
//
// This program is free software: you can redistribute it and/or modify
// it under the terms of the GNU Affero General Public License as
// published by the Free Software Foundation, either version 3 of the
// License, or (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU Affero General Public License for more details.
//
// You should have received a copy of the GNU Affero General Public License
// along with this program. If not, see <http://www.gnu.org/licenses/>.
package
foam.symbai
;
import
android.app.Activity
;
import
android.os.Bundle
;
import
android.content.Context
;
public
class
SocialActivity
extends
foam
.
starwisp
.
StarwispActivity
{
@Override
public
void
onCreate
(
Bundle
savedInstanceState
)
{
m_Name
=
"social"
;
super
.
onCreate
(
savedInstanceState
);
}
}
android/src/foam/symbai/starwisp.java
View file @
a955e206
...
...
@@ -73,6 +73,7 @@ public class starwisp extends StarwispActivity
ActivityManager
.
RegisterActivity
(
"geneaology"
,
GeneaologyActivity
.
class
);
ActivityManager
.
RegisterActivity
(
"social"
,
SocialActivity
.
class
);
ActivityManager
.
RegisterActivity
(
"individual-chooser"
,
IndividualChooserActivity
.
class
);
ActivityManager
.
RegisterActivity
(
"sync"
,
SyncActivity
.
class
);
};
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment