Commit a955e206 authored by Dave Griffiths's avatar Dave Griffiths
Browse files

photos integrated partially, db sync activity added

parent 91edfc64
...@@ -29,6 +29,7 @@ ...@@ -29,6 +29,7 @@
<activity android:name="foam.symbai.SocialActivity" android:configChanges="orientation"></activity> <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.AgreementActivity" android:configChanges="orientation"></activity>
<activity android:name="foam.symbai.IndividualChooserActivity" 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> </application>
......
...@@ -16,6 +16,7 @@ ...@@ -16,6 +16,7 @@
;; abstractions for synced databased ;; abstractions for synced databased
(msg "dbsync.scm")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory ;; stuff in memory
...@@ -136,6 +137,7 @@ ...@@ -136,6 +137,7 @@
((and unique-id (not (null? values))) ((and unique-id (not (null? values)))
(update-entity db table (entity-id-from-unique db table unique-id) values) (update-entity db table (entity-id-from-unique db table unique-id) values)
(msg "updated " unique-id) (msg "updated " unique-id)
(msg values)
(entity-reset!)) (entity-reset!))
(else (else
(msg "no values or no id to update as entity:" unique-id "values:" values)))))) (msg "no values or no id to update as entity:" unique-id "values:" values))))))
...@@ -159,6 +161,8 @@ ...@@ -159,6 +161,8 @@
(define url "http://192.168.2.1:8889/symbai?") (define url "http://192.168.2.1:8889/symbai?")
(msg "url")
(define (build-url-from-ktv ktv) (define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv))) (string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
...@@ -192,6 +196,9 @@ ...@@ -192,6 +196,9 @@
r)) r))
'() ktvlist)) '() ktvlist))
(msg "spit")
;; spit all dirty entities to server ;; spit all dirty entities to server
(define (spit db table entities) (define (spit db table entities)
(foldl (foldl
...@@ -216,17 +223,19 @@ ...@@ -216,17 +223,19 @@
(update-entity-clean db table (cadr v)) (update-entity-clean db table (cadr v))
(append (append
(send-files e) (send-files e)
(debug! (string-append "Updated changed " (car (car e))))) (debug! (string-append "Updated changed " (car (car e))))))
(else (else
(debug! (string-append (debug! (string-append
"Problem uploading " "Problem uploading "
(car (car e)) " : " (car v))))) (car (car e)) " : " (car v)))))
(list (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)) r))
'() '()
entities)) entities))
(msg "request files")
;; todo fix all hardcoded paths here ;; todo fix all hardcoded paths here
(define (request-files ktvlist) (define (request-files ktvlist)
(foldl (foldl
...@@ -240,6 +249,9 @@ ...@@ -240,6 +249,9 @@
r)) r))
'() ktvlist)) '() ktvlist))
(msg "suck ent")
(define (suck-entity-from-server db table unique-id exists) (define (suck-entity-from-server db table unique-id exists)
;; ask for the current version ;; ask for the current version
(http-request (http-request
...@@ -263,7 +275,7 @@ ...@@ -263,7 +275,7 @@
(debug! (string-append (if exists "Got new: " "Updated: ") (ktv-get ktvlist "name"))) (debug! (string-append (if exists "Got new: " "Updated: ") (ktv-get ktvlist "name")))
(list (list
(request-files ktvlist) (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 ;; repeatedly read version and request updates
(define (suck-new db table) (define (suck-new db table)
...@@ -307,12 +319,14 @@ ...@@ -307,12 +319,14 @@
(play-sound "active") (play-sound "active")
r)))))))) r))))))))
(define (build-dirty) (msg "build-dirty defined...")
(define (build-dirty db)
(let ((sync (get-dirty-stats db "sync")) (let ((sync (get-dirty-stats db "sync"))
(stream (get-dirty-stats db "stream"))) (stream (get-dirty-stats db "stream")))
(string-append (string-append
"Pack data: " (number->string (car sync)) "/" (number->string (cadr sync)) " " "Sync data: " (number->string (car sync)) "/" (number->string (cadr sync)) " "
"Focal data: " (number->string (car stream)) "/" (number->string (cadr stream))))) "Stream data: " (number->string (car stream)) "/" (number->string (cadr stream)))))
(define (upload-dirty db) (define (upload-dirty db)
(let ((r (append (let ((r (append
......
...@@ -548,11 +548,11 @@ ...@@ -548,11 +548,11 @@
(id-map-get name)) (id-map-get name))
(define (make-id name) (define (make-id name)
(msg "making id for" name) ;;(msg "making id for" name)
(let ((id (id-map-get name))) (let ((id (id-map-get name)))
(cond (cond
((zero? id) ((zero? id)
(msg "this is a new id") ;;(msg "this is a new id")
; (prof-start "make-id") ; (prof-start "make-id")
(id-map-add name current-id) (id-map-add name current-id)
(set! current-id (+ current-id 1)) (set! current-id (+ current-id 1))
...@@ -561,7 +561,7 @@ ...@@ -561,7 +561,7 @@
(else (else
;; seems scheme is shut down while the id store keeps going? ;; seems scheme is shut down while the id store keeps going?
(when (> id current-id) (set! current-id (+ id 1))) (when (> id current-id) (set! current-id (+ id 1)))
(msg "we have seen this one before") ;;(msg "we have seen this one before")
id)))) id))))
(define prof-map '()) (define prof-map '())
......
...@@ -38,6 +38,8 @@ ...@@ -38,6 +38,8 @@
(list (list
(ktv "user-id" "varchar" "No name yet..."))) (ktv "user-id" "varchar" "No name yet...")))
(define entity-types '())
;;(display (db-all db "local" "app-settings"))(newline) ;;(display (db-all db "local" "app-settings"))(newline)
...@@ -77,6 +79,17 @@ ...@@ -77,6 +79,17 @@
(list 'delete-are-you-sure (list "Are you sure you want to delete this?")) (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?")) (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 ;; village screen
(list 'village-name (list "Village name" "Village name" "Village name")) (list 'village-name (list "Village name" "Village name" "Village name"))
(list 'block (list "Block" "Block" "Block")) (list 'block (list "Block" "Block" "Block"))
...@@ -341,6 +354,13 @@ ...@@ -341,6 +354,13 @@
((eq? widget-type 'toggle-button) ((eq? widget-type 'toggle-button)
(update-widget widget-type (get-symbol-id id-symbol) 'selected (update-widget widget-type (get-symbol-id id-symbol) 'selected
(entity-get-value key))) (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)))) (else (msg "mupdate-widget unhandled widget type" widget-type))))
;;;; ;;;;
...@@ -587,7 +607,7 @@ ...@@ -587,7 +607,7 @@
(mtitle 'title) (mtitle 'title)
(horiz (horiz
(medit-text 'user-id "normal" (lambda () (list))) (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))) (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
(mbutton 'test-upload (lambda () (mbutton 'test-upload (lambda ()
...@@ -611,7 +631,8 @@ ...@@ -611,7 +631,8 @@
(ktv "name" "varchar" (mtext-lookup 'default-village-name)) (ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "block" "varchar" "") (ktv "block" "varchar" "")
(ktv "district" "varchar" "test") (ktv "district" "varchar" "test")
(ktv "car" "int" 0)))) (ktv "car" "int" 0)
(ktv "photo" "file" "none"))))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Main screen") (set-current! 'activity-title "Main screen")
...@@ -653,6 +674,18 @@ ...@@ -653,6 +674,18 @@
(horiz (horiz
(medit-text 'district "normal" (lambda () '())) (medit-text 'district "normal" (lambda () '()))
(mtoggle-button-scale 'car (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 "")))) (mbutton 'household-list (lambda () (list (start-activity "household-list" 0 ""))))
(mtitle 'amenities) (mtitle 'amenities)
(place-widgets 'school #t) (place-widgets 'school #t)
...@@ -669,6 +702,7 @@ ...@@ -669,6 +702,7 @@
(set-current! 'activity-title "Village") (set-current! 'activity-title "Village")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(msg "on start")
(msg "activity start - entity init") (msg "activity start - entity init")
(entity-init! db "sync" "village" (get-entity-by-unique db "sync" arg)) (entity-init! db "sync" "village" (get-entity-by-unique db "sync" arg))
(msg "activity start - entity init done") (msg "activity start - entity init done")
...@@ -677,12 +711,25 @@ ...@@ -677,12 +711,25 @@
(mupdate 'edit-text 'block "block") (mupdate 'edit-text 'block "block")
(mupdate 'edit-text 'district "district") (mupdate 'edit-text 'district "district")
(mupdate 'toggle-button 'car "car") (mupdate 'toggle-button 'car "car")
(mupdate 'image-view 'photo "photo")
(toast arg))) (toast arg)))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(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 (activity
...@@ -976,6 +1023,72 @@ ...@@ -976,6 +1023,72 @@
(activity (activity
"sync" "sync"
(vert (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) (lambda (activity arg)
...@@ -986,7 +1099,7 @@ ...@@ -986,7 +1099,7 @@
(debug-timer-cb) (debug-timer-cb)
(list (list
(update-widget 'debug-text-view (get-id "sync-debug") 'text (get-current 'debug-text "")) (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) '())
(lambda (activity) (list (delayed "debug-timer" 1000 (lambda () '())))) (lambda (activity) (list (delayed "debug-timer" 1000 (lambda () '()))))
...@@ -996,4 +1109,7 @@ ...@@ -996,4 +1109,7 @@
) )
// 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);
}
}
...@@ -73,6 +73,7 @@ public class starwisp extends StarwispActivity ...@@ -73,6 +73,7 @@ public class starwisp extends StarwispActivity
ActivityManager.RegisterActivity("geneaology",GeneaologyActivity.class); ActivityManager.RegisterActivity("geneaology",GeneaologyActivity.class);
ActivityManager.RegisterActivity("social",SocialActivity.class); ActivityManager.RegisterActivity("social",SocialActivity.class);
ActivityManager.RegisterActivity("individual-chooser",IndividualChooserActivity.class); ActivityManager.RegisterActivity("individual-chooser",IndividualChooserActivity.class);
ActivityManager.RegisterActivity("sync",SyncActivity.class);
}; };
......
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