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 @@
<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>
......@@ -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)
(msg "no values or no id to update as entity:" unique-id "values:" values))))))
......@@ -159,6 +161,8 @@
(define url "")
(msg "url")
(define (build-url-from-ktv ktv)
(string-append "&" (ktv-key ktv) ":" (ktv-type ktv) "=" (stringify-value-url ktv)))
......@@ -192,6 +196,9 @@
'() ktvlist))
(msg "spit")
;; spit all dirty entities to server
(define (spit db table entities)
......@@ -216,17 +223,19 @@
(update-entity-clean db table (cadr v))
(send-files e)
(debug! (string-append "Updated changed " (car (car e)))))
(debug! (string-append "Updated changed " (car (car e))))))
(debug! (string-append
"Problem uploading "
(car (car e)) " : " (car v)))))
(update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty))))))
(update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty db))))))
(msg "request files")
;; todo fix all hardcoded paths here
(define (request-files ktvlist)
......@@ -240,6 +249,9 @@
'() ktvlist))
(msg "suck ent")
(define (suck-entity-from-server db table unique-id exists)
;; ask for the current version
......@@ -263,7 +275,7 @@
(debug! (string-append (if exists "Got new: " "Updated: ") (ktv-get ktvlist "name")))
(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")
(define (build-dirty)
(msg "build-dirty defined...")
(define (build-dirty db)
(let ((sync (get-dirty-stats db "sync"))
(stream (get-dirty-stats db "stream")))
"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
......@@ -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)))
((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 @@
;; 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")
(define prof-map '())
......@@ -38,6 +38,8 @@
(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)
(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 @@
(medit-text 'district "normal" (lambda () '()))
(mtoggle-button-scale 'car (lambda () '())))
(image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
(lambda ()
(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")
((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"))
(mupdate 'image-view 'photo "photo")))
......@@ -976,6 +1023,72 @@
(text-view (make-id "sync-title") "Sync database" 40 fillwrap)
(mtext 'sync-dirty "...")
(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)
(mbutton-scale 'sync-download
(lambda ()
(debug! (string-append "Downloading whole db"))
(lambda (e r)
(debug! (string-append "Downloading /sdcard/symbai/" e ".csv"))
(string-append "getting-" e)
(string-append url "fn=entity-csv&table=stream&type=" e)
(string-append "/sdcard/mongoose/" e ".csv"))
(string-append "/sdcard/symbai/symbai.db"))
(mbutton-scale 'sync-export
(lambda ()
(debug! "Sending mail")
"From Symbai" "Please find attached your mongoose data"
(lambda (e)
(string-append "/sdcard/symbai/" e ".csv"))
(mbutton-scale 'email-local
(lambda ()
(debug! "Sending mail")
"From symbai" "Please find attached your local data"
(list "/sdcard/symbai/local-symbai.db")))))
(spacer 10)
(mtitle 'debug)
0 (layout 'fill-parent 200 1 'left 0)
(debug-text-view (make-id "sync-debug") "..." 15 (layout 'fill-parent 400 1 'left 0)))))
(spacer 10)
(mbutton-scale 'sync-back (lambda () (list (finish-activity 1))))
(mbutton-scale 'sync-prof (lambda () (prof-print) (list))))
(lambda (activity arg)
......@@ -986,7 +1099,7 @@
(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 @@
// 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
// 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 <>.
package foam.symbai;
import android.os.Bundle;
import android.content.Context;
public class SocialActivity extends foam.starwisp.StarwispActivity
public void onCreate(Bundle savedInstanceState)
m_Name = "social";
......@@ -73,6 +73,7 @@ public class starwisp extends StarwispActivity
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