starwisp.scm 39.2 KB
Newer Older
Dave Griffiths's avatar
Dave Griffiths committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
;; 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/>.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; strings


;; colours
21
(msg "starting up....")
Dave Griffiths's avatar
Dave Griffiths committed
22
23

(define trans-col (list 0 0 0 0))
24
25
(define colour-one (list 0 0 255 100))
(define colour-two (list  127 127 255 100))
Dave Griffiths's avatar
Dave Griffiths committed
26
27
28
29

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; persistent database

30
(define db "/sdcard/symbai/local-symbai.db")
Dave Griffiths's avatar
Dave Griffiths committed
31
32
33
34
35
36
37
38
39
40
(db-open db)
(setup db "local")
(setup db "sync")
(setup db "stream")

(insert-entity-if-not-exists
 db "local" "app-settings" "null" 1
 (list
  (ktv "user-id" "varchar" "No name yet...")))

Dave Griffiths's avatar
Dave Griffiths committed
41
(define entity-types (list "village"))
42

Dave Griffiths's avatar
Dave Griffiths committed
43
;;(display (db-all db "local" "app-settings"))(newline)
Dave Griffiths's avatar
Dave Griffiths committed
44

Dave Griffiths's avatar
Dave Griffiths committed
45
46
47
48
(define tribes-list '(khasi other))
(define subtribe-list '(khynriam pnar bhoi war other))
(define education-list   '(illiterate literate primary middle high secondary university))
(define married-list '(ever-married currently-married currently-single seperated))
Dave Griffiths's avatar
Dave Griffiths committed
49
50
51
52

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; user interface abstraction

53
54
55
56
57
;;;;;;;;;;;;; i18n ;;;;;;;;;;;;;;;;;;;;;;


(define i18n-text
  (list
Dave Griffiths's avatar
Dave Griffiths committed
58
   (list 'test-num (list "1.0000000" "1.0000000" "1.0000000"))
59
60
61
62
63
64
   (list 'test-text (list "I am test text" "I am test text" "I am test text"))
   (list 'one (list "one"))
   (list 'two (list "two"))
   (list 'three (list "three"))
   (list 'village (list "Village"))
   (list 'household (list "Household"))
65
   (list 'households (list "Households"))
66
   (list 'individual (list "Individual"))
67
   (list 'individuals (list "Individuals"))
68

69
   (list 'add-item-to-list (list "+"))
70
   (list 'default-village-name (list "New village"))
Dave Griffiths's avatar
Dave Griffiths committed
71

72
73
74
75
76
77
   (list 'title (list "Symbai" "Symbai" "Symbai"))
   (list 'sync (list "Sync" "Sync" "Sync"))
   (list 'languages (list "Choose language" "Choose language" "Choose language"))
   (list 'english (list "English" "English" "English"))
   (list 'khasi (list "Khasi" "Khasi" "Khasi"))
   (list 'hindi (list "Hindi" "Hindi" "Hindi"))
Dave Griffiths's avatar
Dave Griffiths committed
78
   (list 'user-id (list "Your user ID" "User ID" "User ID"))
79
80
81
   (list 'save (list "Save" "Save" "Save"))
   (list 'back (list "Back" "Back" "Back"))
   (list 'off (list "Off" "Off" "Off"))
Dave Griffiths's avatar
Dave Griffiths committed
82
   (list 'villages (list "Villages" "Villages" "Villages"))
83
84
85
86
   (list 'list-empty (list "List empty"))
   (list 'delete (list "Delete"))
   (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?"))
Dave Griffiths's avatar
Dave Griffiths committed
87

88
89
90
91
92
93
   ;; filter
   (list 'find-individual (list "Find individual"))
   (list 'filter (list "Filter"))
   (list 'off (list "Off" "Off" "Off"))
   (list 'name (list "Name"))

94
95
96
97
98
99
100
101
102
103
104
   ;; 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"))

Dave Griffiths's avatar
Dave Griffiths committed
105
   ;; village screen
106
   (list 'village-name (list "Village name" "Village name" "Village name"))
Dave Griffiths's avatar
Dave Griffiths committed
107
108
109
110
111
112
113
   (list 'block (list "Block" "Block" "Block"))
   (list 'district (list "District" "District" "District"))
   (list 'car (list "Accessible by car"))
   (list 'household-list (list "Household list"))
   (list 'amenities (list "Amenities"))
   (list 'school (list "School"))
   (list 'present (list "Present"))
Dave Griffiths's avatar
Dave Griffiths committed
114
   (list 'closest-access (list "Closest place of access"))
Dave Griffiths's avatar
Dave Griffiths committed
115
116
   (list 'house-gps (list "GPS"))
   (list 'toilet-gps (list "GPS"))
Dave Griffiths's avatar
Dave Griffiths committed
117
118
119
120
121
122
123
124
125
126
   (list 'school (list "School"))
   (list 'hospital (list "Hospital/Health care centre"))
   (list 'post-office (list "Post Office"))
   (list 'railway-station (list "Railway station"))
   (list 'state-bus-service (list "Inter-state bus service"))
   (list 'district-bus-service (list "Inter-village/district bus service"))
   (list 'panchayat (list "Village Panchayat Office"))
   (list 'NGO (list "Presence of NGO's working with them"))
   (list 'market (list "Market"))

127
   ;; household
Dave Griffiths's avatar
Dave Griffiths committed
128
129
   (list 'household-name (list "Household name"))
   (list 'default-household-name (list "A household"))
130
131
132
133
134
135
136
137
138
139
140
   (list 'location (list "House location"))
   (list 'elevation (list "Elevation"))
   (list 'toilet-location (list "Toilet location"))
   (list 'children (list "Children"))
   (list 'male (list "Male"))
   (list 'female (list "Female"))
   (list 'num-pots (list "Number of pots"))
   (list 'adults (list "Adults"))
   (list 'add-individual (list "Add individual"))

   ;; individual
Dave Griffiths's avatar
Dave Griffiths committed
141
142
143
   (list 'default-individual-name (list "A person"))
   (list 'default-family-name (list "A family"))
   (list 'default-photo-id (list "???"))
Dave Griffiths's avatar
Dave Griffiths committed
144
145
146
147
148
149
150
151
152
153
   (list 'name-display (list "Name"))
   (list 'photo-id-display (list "Photo ID"))
   (list 'family-display (list "Family"))
   (list 'details-button (list "Details"))
   (list 'family-button (list "Family"))
   (list 'migration-button (list "Migration"))
   (list 'income-button (list "Income"))
   (list 'geneaology-button (list "Geneaology"))
   (list 'social-button (list "Social"))
   (list 'agreement-button (list "Agreement"))
154
155
156

   ;; details
   (list 'change-photo (list "Change photo"))
Dave Griffiths's avatar
Dave Griffiths committed
157
158
159
   (list 'details-name (list "Name"))
   (list 'details-photo-id (list "Photo ID"))
   (list 'details-family (list "Family"))
160
161
   (list 'tribe (list "Tribe"))
   (list 'sub-tribe (list "Sub tribe"))
Dave Griffiths's avatar
Dave Griffiths committed
162
163
164
165
166
   (list 'khasi (list "Khasi"))
   (list 'khynriam (list "Khynriam"))
   (list 'pnar (list "Pnar"))
   (list 'bhoi (list "Bhoi"))
   (list 'war (list "War"))
167
168
169
170
   (list 'other (list "Other"))
   (list 'age (list "Age"))
   (list 'gender (list "Gender"))
   (list 'education (list "Education"))
Dave Griffiths's avatar
Dave Griffiths committed
171
172
173
174
175
176
177
178
   (list 'illiterate (list "Illiterate"))
   (list 'literate (list "Literate"))
   (list 'primary (list "Primary 1-5"))
   (list 'middle (list "Middle 6-8"))
   (list 'high (list "High 9-10"))
   (list 'secondary (list "Higher Secondary"))
   (list 'university (list "University"))

179
180
181
182
183
184
185
186
187
188
189

   ;; family
   (list 'spouse (list "Spouse"))
   (list 'head-of-house (list "Head of house"))
   (list 'marital-status (list "Marital status"))
   (list 'ever-married (list "Ever married"))
   (list 'currently-married (list "Currently married"))
   (list 'currently-single (list "Currently single"))
   (list 'seperated (list "Seperated/divorced"))
   (list 'times-married (list "How many times married"))
   (list 'change-spouse (list "Change/add spouse"))
Dave Griffiths's avatar
Dave Griffiths committed
190
191
192
193
   (list 'children-living (list "Living"))
   (list 'children-dead (list "Dead"))
   (list 'children-together (list "Living together"))
   (list 'children-apart (list "Living apart"))
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
   (list 'residence-after-marriage (list "Residence after marriage"))
   (list 'birthplace (list "Birthplace"))
   (list 'spouse-village (list "Spouses natal village"))
   (list 'num-siblings (list "Number of living siblings of the same sex born from same mother"))
   (list 'birth-order (list "Birth order amoung currently living same sex siblings born from same mother"))

   ;; migration
   (list 'length-time (list "Length of time lived in this village (years)"))
   (list 'place-of-birth (list "Place of birth"))
   (list 'num-residence-changes (list "Number of time place of residence changed since birth"))
   (list 'village-visits-month (list "Number of times you have visited another village in the last month"))
   (list 'village-visits-year (list "Number of times you have visited another village in the last year (i.e. betwen last summer and this summer)"))

   ;; income
   (list 'occupation (list "Occupation"))
   (list 'occupation (list "Occupation"))
   (list 'agriculture (list "Agriculture"))
   (list 'gathering (list "Gathering"))
   (list 'labour (list "Labour"))
   (list 'cows (list "Cows"))
   (list 'fishing (list "Fishing"))
Dave Griffiths's avatar
Dave Griffiths committed
215
216
217
218
219
   (list 'num-people-in-house (list "People living in house"))
   (list 'contribute (list "Contribute to family earnings?"))
   (list 'own-land (list "Own land?"))
   (list 'rent-land (list "Rent out your land?"))
   (list 'hire-land (list "Hire land?"))
220
221
222
223
224
225
226
227
228
229
230
   (list 'crops (list "Crops"))
   (list 'crop (list "Crop"))
   (list 'unit (list "Unit"))
   (list 'quantity (list "Quantity"))
   (list 'used-or-eaten (list "Used/Eaten"))
   (list 'sold (list "Sold"))
   (list 'seed (list "Seed (hybrid/local)"))
   (list 'house-type (list "House type"))
   (list 'concrete (list "Concrete"))
   (list 'tin (list "Tin"))
   (list 'thatched (list "Thatched"))
Dave Griffiths's avatar
Dave Griffiths committed
231
232
   (list 'loan (list "Outstanding loans"))
   (list 'earning (list "One day's earnings"))
233
234
235
236
   (list 'in-the-home (list "In the home"))
   (list 'radio (list "Radio"))
   (list 'tv (list "TV"))
   (list 'mobile (list "Mobile phone"))
Dave Griffiths's avatar
Dave Griffiths committed
237
238
   (list 'visit-market (list "Tribal market visits"))
   (list 'town-sell (list "Town or city visits"))
239
240
241
242
243
244
245
246
247

   ;; geneaology

   (list 'mother (list "Mother"))
   (list 'father (list "Father"))
   (list 'change-mother (list "Change mother"))
   (list 'change-father (list "Change father"))
   (list 'alive (list "Alive"))
   (list 'sex (list "Sex"))
248
249
   ))

Dave Griffiths's avatar
Dave Griffiths committed
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

(define (debug! txt)
  (set-current! 'debug-text (string-append txt "\n" (get-current 'debug-text ""))))

(define (update-debug)
  (update-widget 'debug-text-view (get-id "sync-debug") 'text
                 (get-current 'debug-text "")))

(define (debug-timer-cb)
  (append
   (cond
    ((get-current 'sync-on #f)
     (set-current! 'upload 0)
     (set-current! 'download 0)
     (connect-to-net
      (lambda ()
Dave Griffiths's avatar
Dave Griffiths committed
269
        (msg "connected, going in...")
Dave Griffiths's avatar
Dave Griffiths committed
270
271
272
273
274
275
        (append
         (list (toast "sync-cb"))
         (upload-dirty db)
         (suck-new db "sync")))))
    (else '()))
   (list
Dave Griffiths's avatar
Dave Griffiths committed
276
    (delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
Dave Griffiths's avatar
Dave Griffiths committed
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
    (update-debug))))


(define pf-length 20) ;; minutes...

(define (timer-cb)
  (set-current!
   'timer-seconds
   (- (get-current 'timer-seconds 59) 1))
  (append
   (cond
    ((< (get-current 'timer-seconds 59) 0)
     (set-current! 'timer-minutes (- (get-current 'timer-minutes pf-length) 1))
     (set-current! 'timer-seconds 59)
     (cond ((< (get-current 'timer-minutes pf-length) 1)
            (list
             (alert-dialog
              "pup-focal-end"
              "Pup focal time is up, have you finished?"
              (lambda (v)
                (cond
                 ((eqv? v 1)
                  (list (finish-activity 1)))
                 (else
                  (set-current! 'timer-minutes 1)
                  (list)))))))
           (else
            (list (replace-fragment (get-id "pf-top") "pf-scan1")))))
    (else '()))
   (list
    (delayed "timer" 1000 timer-cb)
    (update-widget
     'text-view (get-id "pf-timer-time-minutes") 'text
     (string-append (number->string (get-current 'timer-minutes pf-length))))
    (update-widget
     'text-view (get-id "pf-timer-time") 'text
     (string-append (number->string (get-current 'timer-seconds 59))))
    )))


(define (force-pause)
  (list
   (delayed "timer" 1000 (lambda () '()))
   (update-widget 'toggle-button (get-id "pf-pause") 'checked 1)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; fragments

(define-fragment-list

  (fragment
328
329
   "top"
   (horiz
Dave Griffiths's avatar
Dave Griffiths committed
330
    (image-view 0 "face" (layout 48 64 -1 'centre 0))
331
    (text-view (make-id "title") "" 30
332
333
334
335
               (layout 'fill-parent 'fill-parent 0.25 'centre 10))

    (linear-layout
     0 'vertical
Dave Griffiths's avatar
Dave Griffiths committed
336
     (layout 'fill-parent 'wrap-content 0.75 'centre 0)
337
338
339
340
     (list 0 0 0 0)

     (list
      (text-view (make-id "") 'name 20
Dave Griffiths's avatar
Dave Griffiths committed
341
                 (layout 'fill-parent 'wrap-content 1 'centre 0))
342
      (text-view (make-id "") 'photo-id 20
Dave Griffiths's avatar
Dave Griffiths committed
343
                 (layout 'fill-parent 'wrap-content 1 'centre 0)))))
Dave Griffiths's avatar
Dave Griffiths committed
344
345
346
   (lambda (fragment arg)
     (activity-layout fragment))
   (lambda (fragment arg)
347
348
349
     (list
      (update-widget 'text-view (get-id "title") 'text
                     (get-current 'activity-title "Title not set"))))
Dave Griffiths's avatar
Dave Griffiths committed
350
351
352
353
354
355
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '()))


356
357
358
359
  (fragment
   "bottom"
   (linear-layout
    0 'horizontal
Dave Griffiths's avatar
Dave Griffiths committed
360
    (layout 'fill-parent 'fill-parent 1 'centre 0)
361
362
    (list 0 0 0 0)
    (list
363
     (mbutton-scale
364
      'save
365
366
367
368
      (lambda ()
        (list
         (alert-dialog
          "ok-check"
369
          (mtext-lookup 'save-are-you-sure)
370
371
372
373
          (lambda (v)
            (cond
             ((eqv? v 1)
              (entity-update-values!)
374
              (list))
375
376
             (else
              (list))))))))
377
     (mbutton-scale 'back (lambda () (list (finish-activity 1))))))
378
379
380
381
382
383
384
385
   (lambda (fragment arg)
     (activity-layout fragment))
   (lambda (fragment arg)
     (list))
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '()))
Dave Griffiths's avatar
Dave Griffiths committed
386
387
388
389
390
391


  )

(msg "one")

Dave Griffiths's avatar
Dave Griffiths committed
392
393
394
395
(define (build-activity . contents)
  (vert-fill
   (relative
    '(("parent-top"))
396
    colour-one ;;(list 100 100 255 127)
Dave Griffiths's avatar
Dave Griffiths committed
397
398
399
400
401
402
403
404
405
    (build-fragment "top" (make-id "top") fillwrap))

   (scroll-view-vert
    0 (layout 'fill-parent 'fill-parent 1 'centre 0)
    (list
     (apply vert-fill contents)))

   (relative
    '(("parent-bottom"))
406
    colour-one
Dave Griffiths's avatar
Dave Griffiths committed
407
408
409
410
    (vert
     (spacer 5)
     (build-fragment "bottom" (make-id "bottom") fillwrap)))))

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471

(define (grid-ify widgets n)
  (map
   (lambda (w)
     (linear-layout
      0 'horizontal
      (layout 'wrap-content 'wrap-content 1 'left 0)
      (list 0 0 0 0)
      w))
   (chop widgets n)))

(define (filter-set! l)
  (set-current! 'individual-filter l))

(define (filter-clear!)
  (filter-set! '()))

(define (filter-add! f)
  (set-current!
   'individual-filter
   (merge-filter f (get-current 'individual-filter '()))))

(define (filter-remove! key)
  (set-current!
   'individual-filter
   (delete-filter key (get-current 'individual-filter '()))))

(define (filter-get)
  (get-current 'individual-filter '()))

(define button-size (list (inexact->exact (round (* 192 0.9)))
                          (inexact->exact (round (* 256 0.9)))))

(define (update-individual-filter)
  (update-widget
   'linear-layout (get-id "choose-pics") 'contents
   (grid-ify
    (map
     (lambda (e)
       (let* ((id (ktv-get e "unique_id"))
              (image-name (ktv-get e "photo"))
              (image (if (or (null? image-name)
                             (not image-name)
                             (equal? image-name "none"))
                         "face" (string-append "/sdcard/symbai/files/" image-name))))
         (if (equal? image "face")
             (button
              (make-id (string-append "chooser-" id))
              (ktv-get e "name") 30 (layout (car button-size) (cadr button-size) 1 'centre 5)
              (lambda ()
                (set-current! 'choose-result id)
                (list (finish-activity 0))))
             (image-button
              (make-id (string-append "chooser-" id))
              image (layout (car button-size) (cadr button-size) 1 'centre 5)
              (lambda ()
                (set-current! 'choose-result id)
                (list (finish-activity 0)))))))
     (db-filter db "sync" "individual" (filter-get)))
    3)))

Dave Griffiths's avatar
Dave Griffiths committed
472
473
474
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities

475
(define photo-code 999)
476
(define choose-code 998)
Dave Griffiths's avatar
Dave Griffiths committed
477
478
479
480
481

(define-activity-list

  (activity
   "main"
482
483
484
485
   (build-activity
    (mtitle 'title)
    (horiz
     (medit-text 'user-id "normal" (lambda () (list)))
486
     (mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 "")))))
487

488
489
490
    (horiz
     (mspinner 'languages (list 'english 'khasi 'hindi) (lambda (c) (list)))
     (mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
491
    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
492
     db "sync" 'villages "village" "village" (lambda () #f)
493
494
495
496
     (list
      (ktv "name" "varchar" (mtext-lookup 'default-village-name))
      (ktv "block" "varchar" "")
      (ktv "district" "varchar" "test")
Dave Griffiths's avatar
Dave Griffiths committed
497
      (ktv "car" "int" 0))))
498

499
   (lambda (activity arg)
500
     (set-current! 'activity-title "Main screen")
501
502
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
503
504
505
506
507
508
509
     (list
      (gps-start "gps" (lambda (loc)
                         (set-current! 'location loc)
                         (list (toast (string-append
                                       (number->string (car loc)) ", "
                                       (number->string (cadr loc)))))))
      (update-list-widget db "sync" "village" "village" #f)))
510
511
512
513
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
514
515
   (lambda (activity requestcode resultcode)
     (cond
516
517
      ((eqv? requestcode choose-code)
       (list (start-activity "individual" 0 (get-current 'choose-result 0))))
518
519
520
521
522
523
524
      ((eqv? requestcode photo-code)
       (msg "camera returned" resultcode)
       (list (update-widget
              'image-view (get-id "image")
              'external-image (string-append dirname "photo.jpg"))))
      (else
       '()))))
525
526
527
528


  (activity
   "village"
Dave Griffiths's avatar
Dave Griffiths committed
529
530
531
   (let ((place-widgets
          (lambda (id shade)
            (horiz-colour
532
             (if shade colour-one colour-two)
Dave Griffiths's avatar
Dave Griffiths committed
533
534
535
             (mtoggle-button-scale id (lambda (v) '()))
             (medit-text-scale 'closest-access "normal" (lambda (v) '()))
             (vert
Dave Griffiths's avatar
Dave Griffiths committed
536
              (mbutton-scale 'gps (lambda ()  '()))
537
538
              (mtext-small 'test-num)
              (mtext-small 'test-num))))))
Dave Griffiths's avatar
Dave Griffiths committed
539
540
     (build-activity
      (horiz
Dave Griffiths's avatar
Dave Griffiths committed
541
542
       (medit-text 'village-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
       (medit-text 'block "normal" (lambda (v) (entity-add-value! "block" "varchar" v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
543
      (horiz
Dave Griffiths's avatar
Dave Griffiths committed
544
545
       (medit-text 'district "normal" (lambda (v) (entity-add-value! "district" "varchar" v) '()))
       (mtoggle-button-scale 'car (lambda (v) (entity-add-value! "car" "int" v) '())))
546

Dave Griffiths's avatar
Dave Griffiths committed
547
548
549
550
      (mbutton 'household-list
               (lambda ()
                 (list (start-activity "household-list" 0
                                       (get-current 'village #f)))))
551

Dave Griffiths's avatar
Dave Griffiths committed
552
553
554
555
556
557
558
559
560
      (mtitle 'amenities)
      (place-widgets 'school #t)
      (place-widgets 'hospital #f)
      (place-widgets 'post-office #t)
      (place-widgets 'railway-station #f)
      (place-widgets 'state-bus-service #t)
      (place-widgets 'district-bus-service #f)
      (place-widgets 'panchayat #t)
      (place-widgets 'NGO #f)
561
562
      (place-widgets 'market #t)
      (delete-button)))
Dave Griffiths's avatar
Dave Griffiths committed
563
   (lambda (activity arg)
564
     (set-current! 'activity-title "Village")
Dave Griffiths's avatar
Dave Griffiths committed
565
566
     (activity-layout activity))
   (lambda (activity arg)
567
     (entity-init! db "sync" "village" (get-entity-by-unique db "sync" arg))
568
     (set-current! 'village arg)
569
570
571
572
     (list
      (mupdate 'edit-text 'village-name "name")
      (mupdate 'edit-text 'block "block")
      (mupdate 'edit-text 'district "district")
Dave Griffiths's avatar
Dave Griffiths committed
573
      (mupdate 'toggle-button 'car "car")))
Dave Griffiths's avatar
Dave Griffiths committed
574
575
576
577
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
Dave Griffiths's avatar
Dave Griffiths committed
578
   (lambda (activity requestcode resultcode) '()))
Dave Griffiths's avatar
Dave Griffiths committed
579

Dave Griffiths's avatar
Dave Griffiths committed
580
581
582
583

  (activity
   "household-list"
   (build-activity
584
    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
585
     db "sync" 'households "household" "household" (lambda () (get-current 'village #f))
586
587
588
589
590
591
     (list
      (ktv "name" "varchar" (mtext-lookup 'default-household-name))
      (ktv "num-pots" "int" 0)
      (ktv "house-lat" "real" 0) ;; get from current location?
      (ktv "house-lon" "real" 0)
      (ktv "toilet-lat" "real" 0)
Dave Griffiths's avatar
Dave Griffiths committed
592
      (ktv "toilet-lon" "real" 0))))
Dave Griffiths's avatar
Dave Griffiths committed
593
   (lambda (activity arg)
594
     (set-current! 'activity-title "Household List")
Dave Griffiths's avatar
Dave Griffiths committed
595
     (activity-layout activity))
596
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
597
     (msg "rebuilding household list with" arg)
Dave Griffiths's avatar
Dave Griffiths committed
598
599
     (list (update-list-widget
            db "sync" "household" "household" arg)))
Dave Griffiths's avatar
Dave Griffiths committed
600
601
602
603
604
605
606
607
608
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "household"
   (build-activity
609
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
610
611
     (medit-text 'household-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
     (medit-text 'num-pots "numeric" (lambda (v) (entity-add-value! "num-pots" "int" v) '())))
612
613
    (horiz
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
614
615
616
617
      (mtext 'location)
      (mbutton 'house-gps (lambda () (do-gps 'house "house")))
      (mtext-small 'house-lat)
      (mtext-small 'house-lon))
618
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
619
620
621
622
623
      (mtext 'toilet-location)
      (mbutton 'toilet-gps (lambda () (do-gps 'toilet "toilet")))
      (mtext-small 'toilet-lat)
      (mtext-small 'toilet-lon)))

624
625

    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
626
627
     db "sync" 'individuals "individual" "individual"
     (lambda () (get-current 'household #f))
628
     (list
Dave Griffiths's avatar
Dave Griffiths committed
629
      (ktv "name" "varchar" (mtext-lookup 'default-individual-name))
630
      (ktv "family" "varchar" (mtext-lookup 'default-family-name))
Dave Griffiths's avatar
Dave Griffiths committed
631
632
633
634
635
      (ktv "photo-id" "varchar" (mtext-lookup 'default-photo-id))
      (ktv "photo" "file" "none")
      (ktv "tribe" "varchar" "none")
      (ktv "subtribe" "varchar" "none")
      (ktv "age" "int" 0)
636
      (ktv "gender" "varchar" "Female")
Dave Griffiths's avatar
Dave Griffiths committed
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
      (ktv "education" "varchar" "none")
      (ktv "head-of-house" "varchar" "none")
      (ktv "marital-status" "varchar" "none")
      (ktv "times-married" "int" 0)
      (ktv "id-spouse" "varchar" "none")
      (ktv "children-living" "int" 0)
      (ktv "children-dead" "int" 0)
      (ktv "children-together" "int" 0)
      (ktv "children-apart" "int" 0)
      (ktv "residence-after-marriage" "varchar" "none")
      (ktv "num-siblings" "int" 0)
      (ktv "birth-order" "int" 0)
      (ktv "length-time" "int" 0)
      (ktv "place-of-birth" "varchar" "none")
      (ktv "num-residence-changes" "int" 0)
      (ktv "village-visits-month" "int" 0)
      (ktv "village-visits-year" "int" 0)
      (ktv "occupation" "varchar" "none")
      (ktv "contribute" "int" 0)
      (ktv "own-land" "int" 0)
      (ktv "rent-land" "int" 0)
      (ktv "hire-land" "int" 0)
      (ktv "house-type" "varchar" "none")
      (ktv "loan" "int" 0)
      (ktv "earning" "int" 0)
      (ktv "radio" "int" 0)
      (ktv "tv" "int" 0)
      (ktv "mobile" "int" 0)
      (ktv "visit-market" "int" 0)
      (ktv "town-sell" "int" 0)
      ))

Dave Griffiths's avatar
Dave Griffiths committed
669
    (delete-button))
Dave Griffiths's avatar
Dave Griffiths committed
670
   (lambda (activity arg)
671
     (set-current! 'activity-title "Household")
Dave Griffiths's avatar
Dave Griffiths committed
672
     (activity-layout activity))
673
674
675
   (lambda (activity arg)
     (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
     (set-current! 'household arg)
Dave Griffiths's avatar
Dave Griffiths committed
676
677
678
679
680
681
682
     (append
      (list
       (update-list-widget db "sync" "individual" "individual" arg)
       (mupdate 'edit-text 'household-name "name")
       (mupdate 'edit-text 'num-pots "num-pots"))
      (mupdate-gps 'house "house")
      (mupdate-gps 'toilet "toilet")))
683

Dave Griffiths's avatar
Dave Griffiths committed
684
685
686
687
688
689
690
691
692
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "individual"
   (build-activity
693
694
695
    (horiz
     (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
696
      (mtext 'name-display)
697
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
698
      (mtext 'family-display)
699
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
700
      (mtext 'photo-id-display)))
701
    (mbutton 'agreement-button (lambda () (list (start-activity "agreement" 0 ""))))
702
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
703
704
     (mbutton-scale 'details-button (lambda () (list (start-activity "details" 0 ""))))
     (mbutton-scale 'family-button (lambda () (list (start-activity "family" 0 "")))))
705
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
706
707
     (mbutton-scale 'migration-button (lambda () (list (start-activity "migration" 0 ""))))
     (mbutton-scale 'income-button (lambda () (list (start-activity "income" 0 "")))))
708
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
709
710
     (mbutton-scale 'geneaology-button (lambda () (list (start-activity "geneaology" 0 ""))))
     (mbutton-scale 'social-button (lambda () (list (start-activity "social" 0 "")))))
711
    (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
712
    (delete-button))
713

Dave Griffiths's avatar
Dave Griffiths committed
714
   (lambda (activity arg)
715
     (set-current! 'activity-title "Individual")
Dave Griffiths's avatar
Dave Griffiths committed
716
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
717
718
719
720
   (lambda (activity arg)
     (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg))
     (set-current! 'individual arg)
     (list
Dave Griffiths's avatar
Dave Griffiths committed
721
722
723
      (mupdate 'text-view 'name-display "name")
      (mupdate 'text-view 'family-display "family")
      (mupdate 'text-view 'photo-id-display "photo-id")
724
      (mupdate 'image-view 'photo "photo")))
Dave Griffiths's avatar
Dave Griffiths committed
725
726
727
728
729
730
731
732
733
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "details"
   (build-activity
734
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
735

736
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
737
      (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
738
739
740
      (mbutton
       'change-photo
       (lambda ()
741
742
         (set-current!
          'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
Dave Griffiths's avatar
Dave Griffiths committed
743
         (list
744
          (take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
Dave Griffiths's avatar
Dave Griffiths committed
745
746
         )))

747
     (vert
748
749
750
      (medit-text 'details-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
      (medit-text 'details-family "normal" (lambda (v) (entity-add-value! "family" "varchar" v) '()))
      (medit-text 'details-photo-id "normal" (lambda (v) (entity-add-value! "photo-id" "varchar" v) '()))))
Dave Griffiths's avatar
Dave Griffiths committed
751
752
    (mspinner-other 'tribe tribes-list (lambda (v) (msg "tribe now:" v) (entity-add-value! "tribe" "varchar" v) '()))
    (mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-add-value! "subtribe" "varchar" v) '()))
753
    (horiz
754
755
     (medit-text 'age "numeric" (lambda (v) (entity-add-value! "age" "int" v) '()))
     (mspinner 'gender '(male female) (lambda (v) (entity-add-value! "gender" "varchar" v) '()))
Dave Griffiths's avatar
Dave Griffiths committed
756
     (mspinner 'education education-list (lambda (v) (entity-add-value! "education" "varchar" v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
757
758
    )
   (lambda (activity arg)
759
     (set-current! 'activity-title "Individual details")
Dave Griffiths's avatar
Dave Griffiths committed
760
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
761
762
763
764
765
   (lambda (activity arg)
     (list
      (mupdate 'edit-text 'details-name "name")
      (mupdate 'edit-text 'details-family "family")
      (mupdate 'edit-text 'details-photo-id "photo-id")
766
      (mupdate 'image-view 'photo "photo")
Dave Griffiths's avatar
Dave Griffiths committed
767
768
      (mupdate-spinner-other 'tribe "tribe" tribes-list)
      (mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
769
770
      (mupdate 'edit-text 'age "age")
      (mupdate-spinner 'gender "gender" '(male female))
Dave Griffiths's avatar
Dave Griffiths committed
771
      (mupdate-spinner 'education "education" education-list)
Dave Griffiths's avatar
Dave Griffiths committed
772
      ))
Dave Griffiths's avatar
Dave Griffiths committed
773
774
775
776
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
Dave Griffiths's avatar
Dave Griffiths committed
777
778
779
780
781
782
783
   (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
784
       (let ((unique-id (entity-get-value "unique_id")))
785
         (entity-add-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
786
787
788
         (entity-update-values!)
         ;; need to reset the individual from the db now (as update reset it)
         (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" unique-id)))
Dave Griffiths's avatar
Dave Griffiths committed
789
790
791
792
       (list
        (mupdate 'image-view 'photo "photo")))
      (else
       '()))))
Dave Griffiths's avatar
Dave Griffiths committed
793
794
795
796

  (activity
   "family"
   (build-activity
797
798
    (horiz
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
799
800
801
      (mspinner 'head-of-house '(male female) (lambda (v) (entity-add-value! "head-of-house" "varchar" v) '()))
      (mspinner 'marital-status married-list (lambda (v) (entity-add-value! "marital-status" "varchar" v) '()))
      (medit-text 'times-married "numeric" (lambda (v) (entity-add-value! "times-married" "int" v) '())))
802
803
804
805
806
807
808
     (vert
      (mtitle 'spouse)
      (image-view (make-id "spouse-image") "face" (layout 240 320 -1 'centre 0))
      (mbutton 'change-spouse (lambda () '()))))

    (mtitle 'children)
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
809
810
     (medit-text 'children-living "numeric" (lambda (v) (entity-add-value! "children-living" "int" v) '()))
     (medit-text 'children-dead "numeric" (lambda (v) (entity-add-value! "children-dead" "int" v) '())))
811
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
812
813
     (medit-text 'children-together "numeric" (lambda (v) (entity-add-value! "children-together" "int" v) '()))
     (medit-text 'children-apart "numeric" (lambda (v) (entity-add-value! "children-apart" "int" v) '())))
814
    (mspinner-other 'residence-after-marriage '(birthplace spouse-village) (lambda (v) '()))
Dave Griffiths's avatar
Dave Griffiths committed
815
816
    (medit-text 'num-siblings "numeric" (lambda (v) (entity-add-value! "num-siblings" "int" v) '()))
    (medit-text 'birth-order "numeric" (lambda (v) (entity-add-value! "birth-order" "int" v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
817
   (lambda (activity arg)
818
     (set-current! 'activity-title "Individual family")
819
      (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
820
821
822
823
824
825
826
827
828
829
830
831
832
   (lambda (activity arg)
     (list
      (mupdate-spinner 'head-of-house "head-of-house" '(male female))
      (mupdate-spinner 'marital-status "marital-status" married-list)
      (mupdate 'edit-text 'times-married "times-married")
      ;;(mupdate 'id-spouse "id-spouse")
      (mupdate 'edit-text 'children-living "children-living")
      (mupdate 'edit-text 'children-dead "children-dead")
      (mupdate 'edit-text 'children-together "children-together")
      (mupdate 'edit-text 'children-apart "children-apart")
      (mupdate-spinner 'residence-after-marriage "residence-after-marriage" '(birthplace spouse-village))
      (mupdate 'edit-text 'num-siblings "num-siblings")
      (mupdate 'edit-text 'birth-order "birth-order")))
Dave Griffiths's avatar
Dave Griffiths committed
833
834
835
836
837
838
839
840
841
842
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))


  (activity
   "migration"
   (build-activity
Dave Griffiths's avatar
Dave Griffiths committed
843
844
845
846
847
    (medit-text 'length-time "numeric" (lambda (v) (entity-add-value! "length-time" "int" v) '()))
    (medit-text 'place-of-birth "normal" (lambda (v) (entity-add-value! "place-of-birth" "varchar" v) '()))
    (medit-text 'num-residence-changes "numeric" (lambda (v) (entity-add-value! "num-residence-changes" "int" v) '()))
    (medit-text 'village-visits-month "numeric" (lambda (v) (entity-add-value! "village-visits-month" "int" v) '()))
    (medit-text 'village-visits-year "numeric" (lambda (v) (entity-add-value! "village-visits-year" "int" v) '()))
Dave Griffiths's avatar
Dave Griffiths committed
848
849
    )
   (lambda (activity arg)
850
     (set-current! 'activity-title "Individual migration")
Dave Griffiths's avatar
Dave Griffiths committed
851
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
852
853
854
855
856
857
858
   (lambda (activity arg)
     (list
      (mupdate 'edit-text 'length-time "length-time")
      (mupdate 'edit-text 'place-of-birth "place-of-birth")
      (mupdate 'edit-text 'num-residence-changes "num-residence-changes")
      (mupdate 'edit-text 'village-visits-month "village-visits-month")
      (mupdate 'edit-text 'village-visits-year "village-visits-year")))
Dave Griffiths's avatar
Dave Griffiths committed
859
860
861
862
863
864
865
866
867
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "income"
   (build-activity
Dave Griffiths's avatar
Dave Griffiths committed
868
869
    (mspinner 'occupation '(agriculture gathering labour cows fishing other)
              (lambda (v) (entity-add-value! "occupation" "varchar" v) '()))
870
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
871
872
     (mtoggle-button-scale 'contribute (lambda (v) (entity-add-value! "contribute" "int" v) '()))
     (mtoggle-button-scale 'own-land (lambda (v) (entity-add-value! "own-land" "int" v) '())))
873
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
874
875
     (mtoggle-button-scale 'rent-land (lambda (v) (entity-add-value! "rent-land" "int" v) '()))
     (mtoggle-button-scale 'hire-land (lambda (v) (entity-add-value! "hire-land" "int" v) '())))
876
    (mtitle 'crops)
Dave Griffiths's avatar
Dave Griffiths committed
877
878
879
880
    ;; todo ->
    ;;    (horiz
    ;;     (mtext-scale 'crop) (mtext-scale 'unit) (mtext-scale 'quantity)
    ;;     (mtext-scale 'used-or-eaten) (mtext-scale 'sold) (mtext-scale 'seed))
881
882
    (mspinner-other 'house-type '(concrete tin thatched) (lambda (v) '()))
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
883
884
     (medit-text 'loan "numeric" (lambda (v) (entity-add-value! "loan" "int" v) '()))
     (medit-text 'earning "numeric" (lambda (v) (entity-add-value! "earning" "int" v) '())))
885
886
    (mtext 'in-the-home)
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
887
888
889
     (mtoggle-button-scale 'radio (lambda (v) (entity-add-value! "radio" "int" v) '()))
     (mtoggle-button-scale 'tv (lambda (v) (entity-add-value! "tv" "int" v) '()))
     (mtoggle-button-scale 'mobile (lambda (v) (entity-add-value! "mobile" "int" v) '())))
890
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
891
892
     (medit-text 'visit-market "numeric" (lambda (v) (entity-add-value! "visit-market" "int" v) '()))
     (medit-text 'town-sell "numeric" (lambda (v) (entity-add-value! "town-sell" "int" v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
893
894
    )
   (lambda (activity arg)
895
     (set-current! 'activity-title "Individual income")
Dave Griffiths's avatar
Dave Griffiths committed
896
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
   (lambda (activity arg)
     (list
      (mupdate-spinner 'occupation "occupation" '(agriculture gathering labour cows fishing other))
      (mupdate 'toggle-button 'contribute "contribute")
      (mupdate 'toggle-button 'own-land "own-land")
      (mupdate 'toggle-button 'rent-land "rent-land")
      (mupdate 'toggle-button 'hire-land "hire-land")
      (mupdate-spinner-other 'house-type "house-type" '(concrete tin thatched))
      (mupdate 'edit-text 'loan "loan")
      (mupdate 'edit-text 'earning "earning")
      (mupdate 'toggle-button 'radio "radio")
      (mupdate 'toggle-button 'tv "tv")
      (mupdate 'toggle-button 'mobile "mobile")
      (mupdate 'edit-text 'visit-market "visit-market")
      (mupdate 'edit-text 'town-sell "town-sell")))
Dave Griffiths's avatar
Dave Griffiths committed
912
913
914
915
916
917
918
919
920
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "geneaology"
   (build-activity
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
    (horiz
     (vert
      (mtitle 'mother)
      (image-view (make-id "image") "face" (layout 240 320 -1 'centre 0))
      (mbutton 'change-mother (lambda () '())))
     (vert
      (mtitle 'father)
      (image-view (make-id "image") "face" (layout 240 320 -1 'centre 0))
      (mbutton 'change-father (lambda () '()))))
    (mtitle 'children)
    (horiz
     (medit-text 'name "normal" (lambda (v) '()))
     (mtoggle-button-scale 'alive (lambda (v) '()))
     (mspinner 'sex '(female male) (lambda (v) '()))
     (medit-text 'age "numeric" (lambda (v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
936
937
    )
   (lambda (activity arg)
938
     (set-current! 'activity-title "Individual geneaology")
Dave Griffiths's avatar
Dave Griffiths committed
939
940
941
942
943
944
945
946
947
948
949
950
951
     (activity-layout activity))
   (lambda (activity arg) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "social"
   (build-activity
    )
   (lambda (activity arg)
952
     (set-current! 'activity-title "Individual social network")
Dave Griffiths's avatar
Dave Griffiths committed
953
954
955
956
957
958
959
960
961
962
963
964
965
     (activity-layout activity))
   (lambda (activity arg) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "agreement"
   (build-activity
    )
   (lambda (activity arg)
966
     (set-current! 'activity-title "Individual agreement")
Dave Griffiths's avatar
Dave Griffiths committed
967
968
969
970
971
972
973
974
975
976
977
     (activity-layout activity))
   (lambda (activity arg) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "individual-chooser"
   (build-activity
978
979
980
981
982
983
    (vert
     (linear-layout
      (make-id "choose-pics") 'vertical
      (layout 'fill-parent 'wrap-content 0.75 'centre 0)
      (list 0 0 0 0)
      (list))
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
     (mtitle 'filter)
     (horiz
      (mspinner 'gender '(off female male)
                (lambda (v)
                  (if (equal? v (mtext-lookup 'off))
                      (filter-remove! "gender")
                      (filter-add! (make-filter "gender" "varchar" "=" v)))
                  (list (update-individual-filter))
                  ))
      (medit-text
       'name "normal"
       (lambda (v)
         (if (equal? v "")
             (filter-remove! "name")
             (filter-add! (make-filter "name" "varchar" "like" (string-append v "%"))))
         (list (update-individual-filter))
         ))
      )))
Dave Griffiths's avatar
Dave Griffiths committed
1002
   (lambda (activity arg)
1003
     (set-current! 'activity-title "Individual chooser")
Dave Griffiths's avatar
Dave Griffiths committed
1004
     (activity-layout activity))
1005
   (lambda (activity arg)
1006
     (list (update-individual-filter (list))))
Dave Griffiths's avatar
Dave Griffiths committed
1007
1008
1009
1010
1011
1012
1013
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))


1014
1015
1016
  (activity
   "sync"
   (vert
1017
1018
1019
    (text-view (make-id "sync-title") "Sync database" 40 fillwrap)
    (mtext 'sync-dirty "...")
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1020
     (mtoggle-button-scale 'sync-all (lambda (v) (set-current! 'sync-on v) '()))
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
     (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))))
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
    )

   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
     (set-current! 'sync-on #f)
     (append
      (debug-timer-cb)
      (list
       (update-widget 'debug-text-view (get-id "sync-debug") 'text (get-current 'debug-text ""))
1093
       (update-widget 'text-view (get-id "sync-dirty") 'text (build-dirty db))
1094
1095
1096
1097
1098
1099
       )))
   (lambda (activity) '())
   (lambda (activity) (list (delayed "debug-timer" 1000 (lambda () '()))))
   (lambda (activity) (list (delayed "debug-timer" 1000 (lambda () '()))))
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))
Dave Griffiths's avatar
Dave Griffiths committed
1100

Dave Griffiths's avatar
Dave Griffiths committed
1101
1102


1103
1104
1105



Dave Griffiths's avatar
Dave Griffiths committed
1106
  )