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
nebogeo
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