starwisp.scm 63.5 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
(define entity-types (list "village" "household" "individual"))
Dave Griffiths's avatar
Dave Griffiths committed
23
24

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

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

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

Dave Griffiths's avatar
Dave Griffiths committed
37
38
(define settings-entity-id-version 2)

Dave Griffiths's avatar
Dave Griffiths committed
39
(insert-entity-if-not-exists
Dave Griffiths's avatar
Dave Griffiths committed
40
 db "local" "app-settings" "null" settings-entity-id-version
Dave Griffiths's avatar
Dave Griffiths committed
41
 (list
Dave Griffiths's avatar
Dave Griffiths committed
42
  (ktv "user-id" "varchar" "not set")
43
  (ktv "language" "int" 0)
Dave Griffiths's avatar
Dave Griffiths committed
44
  (ktv "house-id" "int" 0)
Dave Griffiths's avatar
Dave Griffiths committed
45
46
  (ktv "photo-id" "int" 0)
  (ktv "current-village" "varchar" "none")))
Dave Griffiths's avatar
Dave Griffiths committed
47

Dave Griffiths's avatar
Dave Griffiths committed
48
(define (get-setting-value name)
Dave Griffiths's avatar
Dave Griffiths committed
49
  (ktv-get (get-entity db "local" settings-entity-id-version) name))
Dave Griffiths's avatar
Dave Griffiths committed
50
51
52

(define (set-setting! key type value)
  (update-entity
Dave Griffiths's avatar
Dave Griffiths committed
53
   db "local" settings-entity-id-version (list (ktv key type value))))
Dave Griffiths's avatar
Dave Griffiths committed
54
55
56
57
58
59

(define (get/inc-setting key)
  (let ((r (get-setting-value key)))
    (set-setting! key "int" (+ r 1))
    r))

Dave Griffiths's avatar
Dave Griffiths committed
60
(set-current! 'user-id (get-setting-value "user-id"))
Dave Griffiths's avatar
Dave Griffiths committed
61
62
(set! i18n-lang (get-setting-value "language"))

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

Dave Griffiths's avatar
Dave Griffiths committed
65
66
(define tribes-list '(khasi other))
(define subtribe-list '(khynriam pnar bhoi war other))
67
(define education-list   '(primary middle high secondary university))
68
(define married-list '(currently-married currently-single seperated))
69
70
(define residence-list '(birthplace spouse-village))
(define gender-list '(male female))
Dave Griffiths's avatar
Dave Griffiths committed
71
(define house-type-list '(concrete tin thatched other))
Dave Griffiths's avatar
Dave Griffiths committed
72

Dave Griffiths's avatar
Dave Griffiths committed
73
(define social-types-list '(knowledge prestige))
Dave Griffiths's avatar
Dave Griffiths committed
74
75
76
77
(define social-relationship-list '(mother father sister brother spouse children co-wife spouse-mother spouse-father spouse-brother-wife spouse-sister-husband friend neighbour other))
(define social-residence-list '(same other))
(define social-strength-list '(daily weekly monthly less))

Dave Griffiths's avatar
Dave Griffiths committed
78
79
(define village-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
80
81
   (ktv "name" "varchar" (mtext-lookup 'default-village-name))
   (ktv "block" "varchar" "")
82
83
84
85
86
87
88
89
90
91
   (ktv "district" "varchar" "")
   (ktv "school-closest-access" "varchar" "")
   (ktv "hospital-closest-access" "varchar" "")
   (ktv "post-office-closest-access" "varchar" "")
   (ktv "railway-station-closest-access" "varchar" "")
   (ktv "state-bus-service-closest-access" "varchar" "")
   (ktv "district-bus-service-closest-access" "varchar" "")
   (ktv "panchayat-closest-access" "varchar" "")
   (ktv "NGO-closest-access" "varchar" "")
   (ktv "market-closest-access" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
92
   (ktv "car" "int" 0)))
Dave Griffiths's avatar
Dave Griffiths committed
93
94
95

(define household-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
96
   (ktv "name" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
97
   (ktv "num-pots" "int" 0)
98
   (ktv "num-children" "int" 0)
Dave Griffiths's avatar
Dave Griffiths committed
99
100
101
102
   (ktv "house-lat" "real" 0) ;; get from current location?
   (ktv "house-lon" "real" 0)
   (ktv "toilet-lat" "real" 0)
   (ktv "toilet-lon" "real" 0)))
Dave Griffiths's avatar
Dave Griffiths committed
103

104
105
(define individual-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
106
107
108
109
   (ktv "name" "varchar" "")
   (ktv "first-name" "varchar" "")
   (ktv "family" "varchar" "")
   (ktv "photo-id" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
110
111
112
   (ktv "photo" "file" "")
   (ktv "tribe" "varchar" "")
   (ktv "subtribe" "varchar" "")
113
114
   (ktv "child" "int" -1)
   (ktv "age" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
115
   (ktv "gender" "varchar" "")
116
   (ktv "literate" "int" 0)
Dave Griffiths's avatar
Dave Griffiths committed
117
118
119
   (ktv "education" "varchar" "")
   (ktv "head-of-house" "varchar" "")
   (ktv "marital-status" "varchar" "")
120
   (ktv "times-married" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
121
   (ktv "id-spouse" "varchar" "")
122
123
124
125
   (ktv "children-living" "int" -1)
   (ktv "children-dead" "int" -1)
   (ktv "children-together" "int" -1)
   (ktv "children-apart" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
126
   (ktv "residence-after-marriage" "varchar" "")
127
128
129
   (ktv "num-siblings" "int" -1)
   (ktv "birth-order" "int" -1)
   (ktv "length-time" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
130
   (ktv "place-of-birth" "varchar" "")
131
132
133
   (ktv "num-residence-changes" "int" -1)
   (ktv "village-visits-month" "int" -1)
   (ktv "village-visits-year" "int" -1)
134
135
136
137
138
139
   (ktv "occupation-agriculture" "int" 0)
   (ktv "occupation-gathering" "int" 0)
   (ktv "occupation-labour" "int" 0)
   (ktv "occupation-cows" "int" 0)
   (ktv "occupation-fishing" "int" 0)
   (ktv "occupation-other" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
140
141
142
143
144
145
146
147
148
149
   (ktv "contribute" "int" 0)
   (ktv "own-land" "int" 0)
   (ktv "rent-land" "int" 0)
   (ktv "hire-land" "int" 0)
   (ktv "house-type" "varchar" "")
   (ktv "loan" "int" 0)
   (ktv "earning" "int" 0)
   (ktv "radio" "int" 0)
   (ktv "tv" "int" 0)
   (ktv "mobile" "int" 0)
150
151
   (ktv "visit-market" "int" -1)
   (ktv "town-sell" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
   (ktv "social-one" "varchar" "")
   (ktv "social-one-nickname" "varchar" "")
   (ktv "social-one-relationship" "varchar" "")
   (ktv "social-one-residence" "varchar" "")
   (ktv "social-one-strength" "varchar" "")
   (ktv "social-two" "varchar" "")
   (ktv "social-two-nickname" "varchar" "")
   (ktv "social-two-relationship" "varchar" "")
   (ktv "social-two-residence" "varchar" "")
   (ktv "social-two-strength" "varchar" "")
   (ktv "social-three" "varchar" "")
   (ktv "social-three-nickname" "varchar" "")
   (ktv "social-three-relationship" "varchar" "")
   (ktv "social-three-residence" "varchar" "")
   (ktv "social-three-strength" "varchar" "")
   (ktv "social-four" "varchar" "")
   (ktv "social-four-nickname" "varchar" "")
   (ktv "social-four-relationship" "varchar" "")
   (ktv "social-four-residence" "varchar" "")
   (ktv "social-four-strength" "varchar" "")
   (ktv "social-five" "varchar" "")
   (ktv "social-five-nickname" "varchar" "")
   (ktv "social-five-relationship" "varchar" "")
   (ktv "social-five-residence" "varchar" "")
   (ktv "social-five-strength" "varchar" "")
   (ktv "friendship-one" "varchar" "")
   (ktv "friendship-one-nickname" "varchar" "")
   (ktv "friendship-one-relationship" "varchar" "")
   (ktv "friendship-one-residence" "varchar" "")
   (ktv "friendship-one-strength" "varchar" "")
   (ktv "friendship-two" "varchar" "")
   (ktv "friendship-two-nickname" "varchar" "")
   (ktv "friendship-two-relationship" "varchar" "")
   (ktv "friendship-two-residence" "varchar" "")
   (ktv "friendship-two-strength" "varchar" "")
   (ktv "friendship-three" "varchar" "")
   (ktv "friendship-three-nickname" "varchar" "")
   (ktv "friendship-three-relationship" "varchar" "")
   (ktv "friendship-three-residence" "varchar" "")
   (ktv "friendship-three-strength" "varchar" "")
   (ktv "friendship-four" "varchar" "")
   (ktv "friendship-four-nickname" "varchar" "")
   (ktv "friendship-four-relationship" "varchar" "")
   (ktv "friendship-four-residence" "varchar" "")
   (ktv "friendship-four-strength" "varchar" "")
   (ktv "friendship-five" "varchar" "")
   (ktv "friendship-five-nickname" "varchar" "")
   (ktv "friendship-five-relationship" "varchar" "")
   (ktv "friendship-five-residence" "varchar" "")
   (ktv "friendship-five-strength" "varchar" "")
202
   ))
Dave Griffiths's avatar
Dave Griffiths committed
203

204
205
(define crop-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
206
207
   (ktv "name" "varchar" (mtext-lookup 'default-crop-name))
   (ktv "unit" "varchar" "unit")
208
209
   (ktv "used" "real" -1)
   (ktv "sold" "real" -1)
Dave Griffiths's avatar
Dave Griffiths committed
210
   (ktv "seed" "varchar" "")))
211

212
213
(define child-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
214
215
216
   (ktv "name" "varchar" (mtext-lookup 'default-child-name))
   (ktv "alive" "int" 1)
   (ktv "gender" "varchar" "")
217
   (ktv "age" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
218
   (ktv "living-at-home" "int" 0)))
219
220


Dave Griffiths's avatar
Dave Griffiths committed
221
222
223
224
225
226
227
228
229
230
231
232
233
234
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

(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)
235
236
237
     ;(when (zero? (random 10))
     ;      (msg "mangling...")
     ;      (mangle-test! db "sync" entity-types))
Dave Griffiths's avatar
Dave Griffiths committed
238
     (msg "one")
Dave Griffiths's avatar
Dave Griffiths committed
239
240
241
242
     (set-current! 'upload 0)
     (set-current! 'download 0)
     (connect-to-net
      (lambda ()
Dave Griffiths's avatar
Dave Griffiths committed
243
        (msg "connected, going in...")
Dave Griffiths's avatar
Dave Griffiths committed
244
245
246
        (append
         (list (toast "sync-cb"))
         (upload-dirty db)
Dave Griffiths's avatar
Dave Griffiths committed
247
248
249
250
251
         ;; important - don't receive until all are sent...
         (if (have-dirty? db "sync") '()
             (append
              (suck-new db "sync")
              (start-sync-files)))))))
Dave Griffiths's avatar
Dave Griffiths committed
252
253
    (else '()))
   (list
Dave Griffiths's avatar
Dave Griffiths committed
254
    (delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
Dave Griffiths's avatar
Dave Griffiths committed
255
256
257
258
259
260
261
262
263
264
265
    (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)
Dave Griffiths's avatar
Dave Griffiths committed
266

Dave Griffiths's avatar
Dave Griffiths committed
267
268
269
270
271
272
273
274
275
276
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
     (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

Dave Griffiths's avatar
Dave Griffiths committed
303

Dave Griffiths's avatar
Dave Griffiths committed
304
305
306
(define-fragment-list

  (fragment
307
308
   "top"
   (horiz
Dave Griffiths's avatar
Dave Griffiths committed
309
310
    (image-button (make-id "top-icon") "logo" (layout 48 64 -1 'centre 0)
                  (lambda () (list (start-activity-goto "main2" 0 ""))))
311
    (text-view (make-id "title") "" 30
Dave Griffiths's avatar
Dave Griffiths committed
312
               (layout 'fill-parent 'fill-parent 0.5 'centre 10))
313
314
315

    (linear-layout
     0 'vertical
Dave Griffiths's avatar
Dave Griffiths committed
316
     (layout 'fill-parent 'wrap-content 0.5 'centre 0)
317
318
319
     (list 0 0 0 0)

     (list
Dave Griffiths's avatar
Dave Griffiths committed
320
321
322
323
      (text-view (make-id "top-village") 'name 20
                 (layout 'wrap-content 'wrap-content 1 'right 0))
      (text-view (make-id "top-household") 'name 20
                 (layout 'wrap-content 'wrap-content 1 'right 0))
Dave Griffiths's avatar
Dave Griffiths committed
324
      (text-view (make-id "top-photo-id") 'photo-id 20
Dave Griffiths's avatar
Dave Griffiths committed
325
                 (layout 'wrap-content 'wrap-content 1 'right 0)))))
Dave Griffiths's avatar
Dave Griffiths committed
326
327
   (lambda (fragment arg)
     (activity-layout fragment))
Dave Griffiths's avatar
Dave Griffiths committed
328
   (lambda (fragment arg) '())
Dave Griffiths's avatar
Dave Griffiths committed
329
330
331
332
333
334
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '()))


335
336
337
338
  (fragment
   "bottom"
   (linear-layout
    0 'horizontal
Dave Griffiths's avatar
Dave Griffiths committed
339
    (layout 'fill-parent 'fill-parent 1 'centre 0)
340
341
    (list 0 0 0 0)
    (list
342
343
344
345
346
347
348
349
350
351
352
353
354
355
;     (mbutton-scale
;      'save
;      (lambda ()
;        (list
;         (alert-dialog
;          "ok-check"
;          (mtext-lookup 'save-are-you-sure)
;          (lambda (v)
;            (cond
;             ((eqv? v 1)
;              (entity-update-values!)
;              (list))
;             (else
;              (list))))))))
356
     (mbutton-scale 'back (lambda () (list (finish-activity 1))))))
357
358
359
360
361
362
363
364
   (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
365
366
367
368


  )

Dave Griffiths's avatar
Dave Griffiths committed
369
370
371
372
373
374
375
376
377
378
379
380
381
(define (update-top-bar)
  (let ((village (get-entity-name db "sync" (get-current 'village #f)))
        (household (get-entity-name db "sync" (get-current 'household #f)))
        (individual (get-entity-name db "sync" (get-current 'individual #f))))
    (list
     (update-widget 'text-view (get-id "title") 'text
                    (get-current 'activity-title "Title not set"))
     (update-widget 'text-view (get-id "top-village") 'text (if village (string-append "Village: " village) ""))
     (update-widget 'text-view (get-id "top-household") 'text (if household (string-append "Household: " household) ""))
     (update-widget 'text-view (get-id "top-photo-id") 'text (if individual (string-append "Individual: " individual) "")))))



Dave Griffiths's avatar
Dave Griffiths committed
382
383
384
385
(define (build-activity . contents)
  (vert-fill
   (relative
    '(("parent-top"))
386
    colour-one ;;(list 100 100 255 127)
Dave Griffiths's avatar
Dave Griffiths committed
387
388
389
390
391
392
393
394
395
    (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"))
396
    colour-one
Dave Griffiths's avatar
Dave Griffiths committed
397
398
399
400
    (vert
     (spacer 5)
     (build-fragment "bottom" (make-id "bottom") fillwrap)))))

401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433

(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)))))

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
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
(define (build-photo-buttons search)
  (grid-ify
   (map
    (lambda (e)
      (let* ((id (ktv-get e "unique_id"))
             (image-name (ktv-get e "photo"))
             (image (if (image-invalid? image-name)
                        "face" (string-append "/sdcard/symbai/files/" image-name))))
        (cond
         ((> (length search) 50)
          (button
           (make-id (string-append "chooser-" id))
           (ktv-get e "name") 30 (layout (car button-size) (/ (cadr button-size) 3) 1 'centre 5)
           (lambda ()
             (set-current! 'choose-result id)
             (list (finish-activity 0)))))

         ((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)))))

         (else
          (vert
           (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))))
           (text-view 0 (ktv-get e "name") 20 (layout 'wrap-content 'wrap-content -1 'centre 0)))
          ))))
    search)
   3))


(define (update-individual-filter-inner households)
  (map
   (lambda (household)
     (let ((search (db-filter-only db "sync" "individual"
                                   (append (filter-get)
                                           (list (list "parent" "varchar" "="
                                                       (ktv-get household "unique_id"))))
                                   (list
                                    (list "photo" "file")
                                    (list "name" "varchar")))))
       (apply vert
              (cons (text-view 0 (ktv-get household "name") 20 fillwrap)
                    (build-photo-buttons search)))
       ))
   households))

490
(define (update-individual-filter)
491
492
493
494
495
  (msg "update if")
  (let ((households (db-filter-only db "sync" "household"
                                    (list (list "parent" "varchar" "=" (get-setting-value "current-village")))
                                    (list (list "name" "varchar")))))
    (msg households)
Dave Griffiths's avatar
Dave Griffiths committed
496
497
    (update-widget
     'linear-layout (get-id "choose-pics") 'contents
498
     (update-individual-filter-inner  households))))
Dave Griffiths's avatar
Dave Griffiths committed
499
500

(define (image/name-from-unique-id db table unique-id)
501
  (let ((e (get-entity-by-unique db table unique-id)))
Dave Griffiths's avatar
Dave Griffiths committed
502
503
504
    (list
     (ktv-get e "name")
     (ktv-get e "photo"))))
505
506
507
508
509
510

(define (build-person-selector id key filter request-code)
  (vert
   (mtitle id)
   (image-view (make-id (string-append (symbol->string id) "-image"))
               "face" (layout 240 320 -1 'centre 0))
Dave Griffiths's avatar
Dave Griffiths committed
511
   (mtext-small (string->symbol (string-append (symbol->string id) "-text")))
512
513
514
515
516
517
518
519
   (button
    (make-id (string-append "change-" (symbol->string id)))
    (mtext-lookup 'change-id)
    40 (layout 'fill-parent 'wrap-content -1 'centre 5)
    (lambda ()
      (filter-set! filter)
      (list (start-activity "individual-chooser" request-code ""))))))

Dave Griffiths's avatar
Dave Griffiths committed
520
(define (build-small-person-selector id key filter request-code)
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
  (linear-layout
   0 'vertical
   (layout 300 'wrap-content 1 'centre 10)
   (list 0 0 0 0)
   (list
    (mtitle id)
    (image-view (make-id (string-append (symbol->string id) "-image"))
                "face" (layout 120 160 -1 'centre 0))
    (mtext-small (string->symbol (string-append (symbol->string id) "-text")))
    (button
     (make-id (string-append "change-" (symbol->string id)))
     (mtext-lookup 'change-id)
     40 (layout 'wrap-content 'wrap-content -1 'centre 5)
     (lambda ()
       (filter-set! filter)
       (list (start-activity "individual-chooser" request-code "")))))))
Dave Griffiths's avatar
Dave Griffiths committed
537
538


539
540
541
542
;; from activity on result with request id: choose-code
;; todo determine *which* selector this came from...
(define (person-selector-return request-code key choose-code)
  (when (eqv? request-code choose-code)
Dave Griffiths's avatar
Dave Griffiths committed
543
544
        (entity-set-value! key "varchar" (get-current 'choose-result "not set"))
        (entity-update-values!)))
545
546
547
548

;; need to load from across entities, so need db, table
(define (update-person-selector db table id key)
  (let ((entity-id (entity-get-value key)))
Dave Griffiths's avatar
Dave Griffiths committed
549
550
551
552
553
554
    (let ((image-name (image/name-from-unique-id db table entity-id))
          (id (get-id (string-append (symbol->string id) "-image")))
          (text-id (get-id (string-append (symbol->string id) "-text"))))
      (if (image-invalid? (cadr image-name))
          (list
           (update-widget 'image-view id 'image "face")
Dave Griffiths's avatar
Dave Griffiths committed
555
           (update-widget 'text-view text-id 'text (or (car image-name) "")))
Dave Griffiths's avatar
Dave Griffiths committed
556
          (list
Dave Griffiths's avatar
Dave Griffiths committed
557
           (update-widget 'text-view text-id 'text (or (car image-name) ""))
Dave Griffiths's avatar
Dave Griffiths committed
558
559
           (update-widget 'image-view id 'external-image
                          (string-append dirname "files/" (cadr image-name))))))))
560

561
(define (build-social-connection id key type request-code shade)
Dave Griffiths's avatar
Dave Griffiths committed
562
  (let ((id-text (string-append (symbol->string id))))
563
564
565
566
567
568
569
570
    (linear-layout
     0 'horizontal
     (layout 'wrap-content 'wrap-content 1 'centre 20)
     (if shade colour-one colour-two)
     (list
      (build-small-person-selector id key (list) request-code)
      (vert
       (horiz
Dave Griffiths's avatar
Dave Griffiths committed
571
572
573
574
575
576
577
578
579
580
581
        (linear-layout
         0 'vertical (layout 'fill-parent 'wrap-content 1 'centre 20) (list 0 0 0 0)
         (list
          (text-view 0 (mtext-lookup 'social-nickname)
                     30 (layout 'wrap-content 'wrap-content 1 'centre 0))
          (edit-text (make-id (string-append id-text "-nickname")) "" 30 "normal"
                     (layout 'fill-parent 'wrap-content 1 'centre 0)
                     (lambda (v)
                       (entity-set-value! (string-append key "-nickname") "varchar" v)
                       '()))))

582
583
584
585
586
587
588
        (mspinner-other-vert
         (string->symbol (string-append id-text "-relationship"))
         'social-relationship
         social-relationship-list
         (lambda (v)
           (entity-set-value! (string-append key "-relationship") "varchar"
                              (spinner-choice social-relationship-list v))
Dave Griffiths's avatar
Dave Griffiths committed
589
590
591
           '())))

       (horiz
592
593
594
595
596
597
        (mspinner-other-vert
         (string->symbol (string-append id-text "-residence"))
         'social-residence
         social-residence-list
         (lambda (v)
           (entity-set-value! (string-append key "-residence") "varchar"
Dave Griffiths's avatar
Dave Griffiths committed
598
599
600
601
602
603
604
605
606
607
608
                              (spinner-choice social-residence-list v)) '()))
        (vert
         (text-view 0 (mtext-lookup 'social-strength)
                    30 (layout 'wrap-content 'wrap-content 1 'centre 10))
         (spinner
          (make-id (string-append id-text "-strength-spinner"))
          (map mtext-lookup social-strength-list)
          (layout 'wrap-content 'wrap-content 1 'centre 0)
          (lambda (v)
            (entity-set-value! (string-append key "-strength") "varchar"
                               (spinner-choice social-strength-list v)) '())))))))))
Dave Griffiths's avatar
Dave Griffiths committed
609
610
611
612
613
614
615

(define (social-connection-return request-code key choose-code)
  (when (eqv? request-code choose-code)
        (entity-set-value! key "varchar" (get-current 'choose-result "not set"))))

(define (update-social-connection db table id key type request-code)
  (let ((id-text (string-append (symbol->string id))))
Dave Griffiths's avatar
Dave Griffiths committed
616
    (append
617
     (update-person-selector db table id key)
Dave Griffiths's avatar
Dave Griffiths committed
618
619
620
621
622
623
624
625
     (mupdate-spinner-other
      (string->symbol (string-append id-text "-relationship"))
      (string-append key "-relationship")
      social-relationship-list)
     (mupdate-spinner-other
      (string->symbol (string-append id-text "-residence"))
      (string-append key "-residence")
      social-residence-list)
Dave Griffiths's avatar
Dave Griffiths committed
626
     (list
Dave Griffiths's avatar
Dave Griffiths committed
627
628
629
630
      (mupdate
       'edit-text
       (string->symbol (string-append id-text "-nickname"))
       (string-append key "-nickname"))
Dave Griffiths's avatar
Dave Griffiths committed
631
      (mupdate-spinner
Dave Griffiths's avatar
Dave Griffiths committed
632
       (string->symbol (string-append id-text "-strength"))
Dave Griffiths's avatar
Dave Griffiths committed
633
634
       (string-append key "-strength")
       social-strength-list))
Dave Griffiths's avatar
Dave Griffiths committed
635
636
     )))

Dave Griffiths's avatar
Dave Griffiths committed
637
638
639
640
(define (build-amenity-widgets id shade)
  (let ((id-text (symbol->string id)))
    (horiz-colour
     (if shade colour-one colour-two)
Dave Griffiths's avatar
Dave Griffiths committed
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
     (linear-layout
      0 'vertical (layout 200 'wrap-content -1 'left 0)
      (list 0 0 0 0)
      (list
       (text-view (symbol->id id)
                  (mtext-lookup id)
                  30 (layout 'wrap-content 'wrap-content -1 'left 0))
       (mtoggle-button-scale
        (string->symbol (string-append id-text "-in-village"))
        (lambda (v)
          (entity-set-value! id-text "int" v)
          (list (update-widget
                 'edit-text
                 (get-id (string-append id-text "-closest-access-container"))
                 (if (eqv? v 1) 'hide 'show) 0))))))
Dave Griffiths's avatar
Dave Griffiths committed
656
657
658
659
660
661
662
663
664
665
666
     (medit-text-scale
      (string->symbol (string-append id-text "-closest-access"))
      "normal" (lambda (v) (entity-set-value!
                            (string-append id-text "-closest-access")
                            "varchar" v) '()))
     (vert
      (mbutton-scale
       (string->symbol (string-append id-text "-gps"))
       (lambda ()  (do-gps
                    (string->symbol (string-append id-text "-gps"))
                    (string-append id-text "-gps"))))
Dave Griffiths's avatar
Dave Griffiths committed
667
668
      (mtext-small (string->symbol (string-append id-text "-gps-lat")))
      (mtext-small (string->symbol (string-append id-text "-gps-lon")))))))
Dave Griffiths's avatar
Dave Griffiths committed
669
670
671
672
673

(define (update-amenity-widgets id)
  (let ((id-text (symbol->string id)))
    (append
     (list
Dave Griffiths's avatar
Dave Griffiths committed
674
      (mupdate 'toggle-button (string->symbol (string-append id-text "-in-village")) id-text)
Dave Griffiths's avatar
Dave Griffiths committed
675
676
      (mupdate 'edit-text
               (string->symbol (string-append id-text "-closest-access"))
Dave Griffiths's avatar
Dave Griffiths committed
677
678
679
680
681
682
               (string-append id-text "-closest-access"))
      (update-widget
       'edit-text
       (get-id (string-append id-text "-closest-access-container"))
       (if (eqv? (entity-get-value id-text) 1)
           'hide 'show) 0))
Dave Griffiths's avatar
Dave Griffiths committed
683
684
685
686
687
     (mupdate-gps
      (string->symbol (string-append id-text "-gps"))
      (string-append id-text "-gps")))))


Dave Griffiths's avatar
Dave Griffiths committed
688
689
690
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities

691
(define photo-code 999)
692
(define choose-code 998)
693
694
695
(define spouse-request-code 997)
(define mother-request-code 996)
(define father-request-code 995)
Dave Griffiths's avatar
Dave Griffiths committed
696

Dave Griffiths's avatar
Dave Griffiths committed
697
698
699
700
701
702
(define social-request-code-one 994)
(define social-request-code-two 993)
(define social-request-code-three 992)
(define social-request-code-four 991)
(define social-request-code-five 990)

Dave Griffiths's avatar
Dave Griffiths committed
703
704
705
706
(define-activity-list

  (activity
   "main"
Dave Griffiths's avatar
Dave Griffiths committed
707
708
709
710
711
712
713
714
715
716
717
718
719
   (vert
    (mbutton 'start (lambda () (list (start-activity-goto "main2" 0 "")))))
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "main2"
720
721
722
   (build-activity
    (mtitle 'title)
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
723
724
725
726
727
     (medit-text 'user-id "normal"
                 (lambda (v)
                   (set-setting! "user-id" "varchar" v)
                   (set-current! 'user-id v)
                   (list)))
728

Dave Griffiths's avatar
Dave Griffiths committed
729
730
     (mspinner 'languages (list 'english 'khasi 'hindi)
               (lambda (c)
731
732
                 (set-setting! "language" "int" c)
                 (set! i18n-lang c)
Dave Griffiths's avatar
Dave Griffiths committed
733
                 (list)))
734
     (mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
Dave Griffiths's avatar
Dave Griffiths committed
735

736
    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
737
738
     db "sync" 'households "household" "household" (lambda () (get-setting-value "current-village"))
     (lambda ()
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
       (let ((name
              ;; if it's the first household - change the id...
              (if (zero? (length (db-filter-only
                                  db "sync" "household"
                                  (list (list "parent" "varchar" "="
                                              (get-setting-value "current-village")))
                                  (list (list "name" "varchar")))))
                  (string-append
                   (ktv-get (get-entity-by-unique db "sync" (get-setting-value "current-village")) "name")
                   (get-setting-value "user-id")
                   "gamehousehold")
                  (string-append
                   (ktv-get (get-entity-by-unique db "sync" (get-setting-value "current-village")) "name")
                   (get-setting-value "user-id")
                   (number->string (get/inc-setting "house-id"))))))
         ;; autogenerate the name from the current ID
         (ktvlist-merge
          household-ktvlist
          (list (ktv "name" "varchar" name))))))
Dave Griffiths's avatar
Dave Griffiths committed
758

Dave Griffiths's avatar
Dave Griffiths committed
759
760
761
762
763
764
765
766
    (mbutton 'villages (lambda () (list (start-activity "villages" 0 ""))))

    (mbutton 'sync (lambda () (list (start-activity "sync" 0 ""))))

    (horiz
     (medit-text 'house-id "numeric" (lambda (v) (set-setting! "house-id" "int" (string->number v)) (list)))
     (medit-text 'photo-id "numeric" (lambda (v) (set-setting! "photo-id" "int" (string->number v)) (list))))
    )
767

768
769
770
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
771
     (alog "start main start")
Dave Griffiths's avatar
Dave Griffiths committed
772
773
774
775
     (set-current! 'activity-title "Main screen")
     (set-current! 'village (get-setting-value "current-village"))
     (set-current! 'household #f)
     (set-current! 'individual #f)
Dave Griffiths's avatar
Dave Griffiths committed
776
     (let ((r (append
Dave Griffiths's avatar
Dave Griffiths committed
777
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
778
779
780
781
782
783
784
785
786
787
788
      (list
       (update-widget 'edit-text (get-id "user-id") 'text (get-setting-value "user-id"))
       (update-widget 'edit-text (get-id "house-id") 'text (get-setting-value "house-id"))
       (update-widget 'edit-text (get-id "photo-id") 'text (get-setting-value "photo-id"))
       (update-widget 'spinner (get-id "languages-spinner") 'selection
                      (get-setting-value "language"))
       (gps-start "gps" (lambda (loc)
                          (set-current! 'location loc)
                          (list (toast (string-append
                                        (number->string (car loc)) ", "
                                        (number->string (cadr loc)))))))
Dave Griffiths's avatar
Dave Griffiths committed
789
       (update-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
790
791
        db "sync" "household" "household" (get-setting-value "current-village"))))))
       (alog "end main start") r))
792
793
794
795
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
796
797
   (lambda (activity requestcode resultcode)
     (cond
Dave Griffiths's avatar
Dave Griffiths committed
798
799
      ((and (eqv? requestcode choose-code)
            (get-current 'choose-result 0))
800
       (list (start-activity "individual" 0 (get-current 'choose-result 0))))
801
802
803
804
805
806
      ((eqv? requestcode photo-code)
       (list (update-widget
              'image-view (get-id "image")
              'external-image (string-append dirname "photo.jpg"))))
      (else
       '()))))
807

Dave Griffiths's avatar
Dave Griffiths committed
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
  (activity
   "villages"
   (build-activity
    (mspinner 'current-village '()
              (lambda (v)
                (set-setting! "current-village" "varchar"
                              (cadr (list-ref (get-current 'villages-list '()) v)))
                '()))
    (build-list-widget
     db "sync" 'villages "village" "village" (lambda () #f)
     (lambda () village-ktvlist)))


   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
     (set-current! 'activity-title "Villages")
     (set-current! 'villages-list (build-array-from-names db "sync" "village"))
     (append
      (update-top-bar)
      (list
       (update-widget 'spinner (get-id "current-village-spinner") 'array
                      (map car (get-current 'villages-list '())))
       (update-widget 'spinner (get-id "current-village-spinner") 'selection
                      (find-index-from-name-array
                       (get-current 'villages-list '())
                       (get-current 'village #f)))
       (update-list-widget db "sync" "village" "village" #f))))
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))


843
844
845

  (activity
   "village"
Dave Griffiths's avatar
Dave Griffiths committed
846
847
     (build-activity
      (horiz
848
849
       (medit-text 'village-name "normal" (lambda (v) (entity-set-value! "name" "varchar" v) '()))
       (medit-text 'block "normal" (lambda (v) (entity-set-value! "block" "varchar" v) '())))
Dave Griffiths's avatar
Dave Griffiths committed
850
      (horiz
851
852
       (medit-text 'district "normal" (lambda (v) (entity-set-value! "district" "varchar" v) '()))
       (mtoggle-button-scale 'car (lambda (v) (entity-set-value! "car" "int" v) '())))
853

Dave Griffiths's avatar
Dave Griffiths committed
854
855
856
857
      (mbutton 'household-list
               (lambda ()
                 (list (start-activity "household-list" 0
                                       (get-current 'village #f)))))
858

Dave Griffiths's avatar
Dave Griffiths committed
859
      (mtitle 'amenities)
Dave Griffiths's avatar
Dave Griffiths committed
860
861
862
863
864
865
866
867
868
869
      (build-amenity-widgets 'school #t)
      (build-amenity-widgets 'hospital #f)
      (build-amenity-widgets 'post-office #t)
      (build-amenity-widgets 'railway-station #f)
      (build-amenity-widgets 'state-bus-service #t)
      (build-amenity-widgets 'district-bus-service #f)
      (build-amenity-widgets 'panchayat #t)
      (build-amenity-widgets 'NGO #f)
      (build-amenity-widgets 'market #t)
      (delete-button))
Dave Griffiths's avatar
Dave Griffiths committed
870
871
872
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
873
     (set-current! 'activity-title "Village")
874
     (entity-init! db "sync" "village" (get-entity-by-unique db "sync" arg))
875
     (set-current! 'village arg)
Dave Griffiths's avatar
Dave Griffiths committed
876
877
     (set-current! 'household #f)
     (set-current! 'individual #f)
Dave Griffiths's avatar
Dave Griffiths committed
878
     (append
Dave Griffiths's avatar
Dave Griffiths committed
879
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
      (list
       (mupdate 'edit-text 'village-name "name")
       (mupdate 'edit-text 'block "block")
       (mupdate 'edit-text 'district "district")
       (mupdate 'toggle-button 'car "car"))
      (update-amenity-widgets 'school)
      (update-amenity-widgets 'hospital)
      (update-amenity-widgets 'post-office)
      (update-amenity-widgets 'railway-station)
      (update-amenity-widgets 'state-bus-service)
      (update-amenity-widgets 'district-bus-service)
      (update-amenity-widgets 'panchayat)
      (update-amenity-widgets 'NGO)
      (update-amenity-widgets 'market)))

Dave Griffiths's avatar
Dave Griffiths committed
895
896
897
898
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
Dave Griffiths's avatar
Dave Griffiths committed
899
   (lambda (activity requestcode resultcode) '()))
Dave Griffiths's avatar
Dave Griffiths committed
900

Dave Griffiths's avatar
Dave Griffiths committed
901
902
903
904

  (activity
   "household-list"
   (build-activity
905
    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
906
     db "sync" 'households "household" "household" (lambda () (get-current 'village #f))
Dave Griffiths's avatar
Dave Griffiths committed
907
908
909
910
911
912
     (lambda ()
       ;; autogenerate the name from the current ID
       (ktvlist-merge
        household-ktvlist
        (list (ktv "name" "varchar"
                   (string-append
Dave Griffiths's avatar
Dave Griffiths committed
913
914
                    (ktv-get (get-entity-by-unique db "sync" (get-setting-value "current-village")) "name")
                    (get-setting-value "user-id")
Dave Griffiths's avatar
Dave Griffiths committed
915
                    (number->string (get/inc-setting "house-id")))))))))
Dave Griffiths's avatar
Dave Griffiths committed
916
917
   (lambda (activity arg)
     (activity-layout activity))
918
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
919
     (set-current! 'activity-title "Households")
Dave Griffiths's avatar
Dave Griffiths committed
920
921
922
923
     (append
      (update-top-bar)
      (list (update-list-widget
             db "sync" "household" "household" arg))))
Dave Griffiths's avatar
Dave Griffiths committed
924
925
926
927
928
929
930
931
932
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "household"
   (build-activity
933
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
934
935
     (medit-text 'num-pots "numeric" (lambda (v) (entity-set-value! "num-pots" "int" v) '()))
     (medit-text 'num-children "numeric" (lambda (v) (entity-set-value! "num-children" "int" v) '())))
936
937
    (horiz
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
938
939
940
941
      (mtext 'location)
      (mbutton 'house-gps (lambda () (do-gps 'house "house")))
      (mtext-small 'house-lat)
      (mtext-small 'house-lon))
942
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
943
944
945
946
947
      (mtext 'toilet-location)
      (mbutton 'toilet-gps (lambda () (do-gps 'toilet "toilet")))
      (mtext-small 'toilet-lat)
      (mtext-small 'toilet-lon)))

948
949

    (build-list-widget
Dave Griffiths's avatar
Dave Griffiths committed
950
951
     db "sync" 'individuals "individual" "individual"
     (lambda () (get-current 'household #f))
Dave Griffiths's avatar
Dave Griffiths committed
952
     (lambda ()
Dave Griffiths's avatar
Dave Griffiths committed
953
954
955
       (let ((photo-id (get/inc-setting "photo-id"))
             (household-name (ktv-get (dbg (get-entity-by-unique db "sync" (dbg (get-current 'household #f)))) "name")))
         (msg household-name)
956
957
958
         (ktvlist-merge
          individual-ktvlist
          (list
Dave Griffiths's avatar
Dave Griffiths committed
959
           (ktv "name" "varchar"
960
                (string-append
Dave Griffiths's avatar
Dave Griffiths committed
961
                 household-name ":"
962
                 (number->string photo-id)))
Dave Griffiths's avatar
Dave Griffiths committed
963
964
           (ktv "photo-id" "varchar"
                (number->string photo-id))
965
966
967
968
969
           (ktv "social-type" "varchar"
                (symbol->string
                 (list-ref social-types-list
                           (modulo photo-id (length social-types-list)))))
         )))))
Dave Griffiths's avatar
Dave Griffiths committed
970

Dave Griffiths's avatar
Dave Griffiths committed
971

Dave Griffiths's avatar
Dave Griffiths committed
972
    (delete-button))
Dave Griffiths's avatar
Dave Griffiths committed
973
974
   (lambda (activity arg)
     (activity-layout activity))
975
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
976
     (set-current! 'activity-title "Household")
977
978
     (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
     (set-current! 'household arg)
Dave Griffiths's avatar
Dave Griffiths committed
979
     (set-current! 'individual #f)
Dave Griffiths's avatar
Dave Griffiths committed
980
     (append
Dave Griffiths's avatar
Dave Griffiths committed
981
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
982
983
      (list
       (update-list-widget db "sync" "individual" "individual" arg)
984
985
       (mupdate 'edit-text 'num-pots "num-pots")
       (mupdate 'edit-text 'num-children "num-children"))
Dave Griffiths's avatar
Dave Griffiths committed
986
987
      (mupdate-gps 'house "house")
      (mupdate-gps 'toilet "toilet")))
988

Dave Griffiths's avatar
Dave Griffiths committed
989
990
991
992
993
994
995
996
997
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "individual"
   (build-activity
998
999
1000
    (horiz
     (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1001
      (mtext 'name-display)
1002
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1003
1004
      (mtext 'first-name-display)
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1005
      (mtext 'family-display)
1006
      (spacer 20)
1007
1008
      (mtext 'photo-id-display)
      ))
1009
    (mbutton 'agreement-button (lambda () (list (start-activity "agreement" 0 ""))))
1010
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1011
1012
     (mbutton-scale 'details-button (lambda () (list (start-activity "details" 0 ""))))
     (mbutton-scale 'family-button (lambda () (list (start-activity "family" 0 "")))))
1013
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1014
1015
     (mbutton-scale 'migration-button (lambda () (list (start-activity "migration" 0 ""))))
     (mbutton-scale 'income-button (lambda () (list (start-activity "income" 0 "")))))
1016
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1017
     (mbutton-scale 'geneaology-button (lambda () (list (start-activity "geneaology" 0 ""))))
Dave Griffiths's avatar
Dave Griffiths committed
1018
1019
1020
1021
     (mbutton-scale 'friendship-button (lambda () (list (start-activity "friendship" 0 "")))))
    (horiz
     (mbutton-scale 'social-button (lambda () (list (start-activity "social" 0 ""))))
     (mbutton-scale 'move-button (lambda () (list (start-activity "move" 0 "")))))
1022
    (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1023
    (delete-button))
1024

Dave Griffiths's avatar
Dave Griffiths committed
1025
1026
   (lambda (activity arg)
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
1027
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1028
     (set-current! 'activity-title "Individual")
Dave Griffiths's avatar
Dave Griffiths committed
1029
1030
     (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg))
     (set-current! 'individual arg)
Dave Griffiths's avatar
Dave Griffiths committed
1031
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1032
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
1033
1034
      (list
       (mupdate 'text-view 'name-display "name")
Dave Griffiths's avatar
Dave Griffiths committed
1035
       (mupdate 'text-view 'first-name-display "first-name")
Dave Griffiths's avatar
Dave Griffiths committed
1036
1037
1038
       (mupdate 'text-view 'family-display "family")
       (mupdate 'text-view 'photo-id-display "photo-id")
       (mupdate 'image-view 'photo "photo"))))
Dave Griffiths's avatar
Dave Griffiths committed
1039
1040
1041
1042
1043
1044
1045
1046
1047
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "details"
   (build-activity
1048
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1049

1050
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1051
      (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
1052
1053
1054
      (mbutton
       'change-photo
       (lambda ()
1055
1056
         (set-current!
          'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
Dave Griffiths's avatar
Dave Griffiths committed
1057
         (list
1058
          (take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
Dave Griffiths's avatar
Dave Griffiths committed
1059
1060
         )))

1061
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1062
1063
      (medit-text 'details-first-name "normal" (lambda (v) (entity-set-value! "first-name" "varchar" v) '()))
      (medit-text 'details-family "normal" (lambda (v) (entity-set-value! "family" "varchar" v) '()))))
Dave Griffiths's avatar
Dave Griffiths committed
1064
    (mspinner-other 'tribe tribes-list (lambda (v) (entity-set-value! "tribe" "varchar" (spinner-choice tribes-list v)) '()))
1065
    (mspinner-other 'sub-tribe subtribe-list (lambda (v) (entity-set-value! "subtribe" "varchar" (spinner-choice subtribe-list v)) '()))
1066
    (horiz
1067
     (medit-text 'age "numeric" (lambda (v) (entity-set-value! "age" "int" v) '()))
1068
1069
1070
     (mspinner 'gender gender-list (lambda (v) (entity-set-value! "gender" "varchar" (spinner-choice gender-list v)) '())))
    (horiz
     (mtoggle-button-scale 'literate (lambda (v) (entity-set-value! "literate" "int" v) '()))
1071
     (mspinner 'education education-list (lambda (v) (entity-set-value! "education" "varchar" v) '())))
1072
1073
1074

    (mbutton 'next (lambda () (list (start-activity "family" 0 ""))))
    (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1075
1076
1077
    )
   (lambda (activity arg)
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
1078
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1079
     (set-current! 'activity-title "Details")
Dave Griffiths's avatar
Dave Griffiths committed
1080
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1081
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
1082
1083
      (mupdate-spinner-other 'tribe "tribe" tribes-list)
      (mupdate-spinner-other 'sub-tribe "subtribe" subtribe-list)
Dave Griffiths's avatar
Dave Griffiths committed
1084
      (list
Dave Griffiths's avatar
Dave Griffiths committed
1085
       (mupdate 'edit-text 'details-first-name "first-name")
Dave Griffiths's avatar
Dave Griffiths committed
1086
1087
1088
1089
       (mupdate 'edit-text 'details-family "family")
       (mupdate 'image-view 'photo "photo")
       (mupdate 'edit-text 'age "age")
       (mupdate-spinner 'gender "gender" gender-list)
1090
       (mupdate 'toggle-button 'literate "literate")
Dave Griffiths's avatar
Dave Griffiths committed
1091
1092
       (mupdate-spinner 'education "education" education-list)
       )))
Dave Griffiths's avatar
Dave Griffiths committed
1093
1094
1095
1096
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
Dave Griffiths's avatar
Dave Griffiths committed
1097
1098
1099
1100
1101
1102
   (lambda (activity requestcode resultcode)
     (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
1103
       (let ((unique-id (entity-get-value "unique_id")))
1104
         (entity-set-value! "photo" "file" (get-current 'photo-name "error no photo name!!"))
1105
1106
1107
         (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
1108
1109
1110
1111
       (list
        (mupdate 'image-view 'photo "photo")))
      (else
       '()))))
Dave Griffiths's avatar
Dave Griffiths committed
1112
1113
1114
1115

  (activity
   "family"
   (build-activity
1116
1117
    (horiz
     (vert
1118
1119
      (mspinner 'head-of-house gender-list (lambda (v) (entity-set-value! "head-of-house" "varchar" (spinner-choice gender-list v)) '()))
      (mspinner 'marital-status married-list (lambda (v) (entity-set-value! "marital-status" "varchar" (spinner-choice married-list v)) '()))
1120
1121
1122
1123
1124
1125
      (medit-text 'times-married "numeric"
                  (lambda (v)
                    (entity-set-value! "times-married" "int" v)
                    (list
                     (update-widget 'linear-layout (get-id "residence-after-marriage-container")
                                    (if (equal? v "0") 'hide 'show) 0)))))
1126
1127
1128

     (build-person-selector 'spouse "id-spouse" (list) spouse-request-code)
     )
1129

1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
;;    (mtitle 'children)
;;    (horiz
;;     (medit-text 'children-living "numeric" (lambda (v) (entity-set-value! "children-living" "int" v) '()))
;;     (medit-text 'children-dead "numeric" (lambda (v) (entity-set-value! "children-dead" "int" v) '())))
;;    (horiz
;;     (medit-text 'children-together "numeric" (lambda (v) (entity-set-value! "children-together" "int" v) '()))
;;     (medit-text 'children-apart "numeric" (lambda (v) (entity-set-value! "children-apart" "int" v) '())))

    (mspinner-other 'residence-after-marriage residence-list (lambda (v) (entity-set-value!
                                                                          "residence-after-marriage" "varchar"
                                                                          (spinner-choice residence-list v)) '()))
1141
    (medit-text 'num-siblings "numeric" (lambda (v) (entity-set-value! "num-siblings" "int" v) '()))
1142
1143
1144
1145
    (medit-text 'birth-order "numeric" (lambda (v) (entity-set-value! "birth-order" "int" v) '()))
    (mbutton 'next (lambda () (list (start-activity "migration" 0 ""))))
    (spacer 20)
    )
Dave Griffiths's avatar
Dave Griffiths committed
1146
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1147
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
1148
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1149
     (set-current! 'activity-title "Family")
Dave Griffiths's avatar
Dave Griffiths committed
1150
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1151
      (update-top-bar)
1152
      (update-person-selector db "sync" 'spouse "id-spouse")
Dave Griffiths's avatar
Dave Griffiths committed
1153
      (list
1154
       (mupdate-spinner 'head-of-house "head-of-house" gender-list)
Dave Griffiths's avatar
Dave Griffiths committed
1155
1156
1157
       (mupdate-spinner 'marital-status "marital-status" married-list)
       (mupdate 'edit-text 'times-married "times-married")
       ;;(mupdate 'id-spouse "id-spouse")
1158
1159
1160
1161
1162
;;       (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" residence-list)
Dave Griffiths's avatar
Dave Griffiths committed
1163
1164
       (mupdate 'edit-text 'num-siblings "num-siblings")
       (mupdate 'edit-text 'birth-order "birth-order"))))
Dave Griffiths's avatar
Dave Griffiths committed
1165
1166
1167
1168
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
1169
1170
   (lambda (activity requestcode resultcode)
     (person-selector-return requestcode "id-spouse" spouse-request-code)
1171
1172
1173
1174
1175

     ;; intercept a spouse setting and set the other individual
     ;; BIDIRECTIONAL AUTOSPOUSE
     (when (and (eqv? requestcode spouse-request-code)
                (get-current 'choose-result #f))
Dave Griffiths's avatar
Dave Griffiths committed
1176
           (update-entity db "sync" (entity-id-from-unique db "sync" (get-current 'choose-result #f))
Dave Griffiths's avatar
Dave Griffiths committed
1177
                          (list (ktv "id-spouse" "varchar" (entity-get-value "unique_id")))))
1178
1179
1180
1181
1182
1183
1184

     ;; save and reinit otherwise we can get out of sync here with the spouse :/
     (let ((unique-id (entity-get-value "unique_id")))
       (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)))

1185
     '()))
Dave Griffiths's avatar
Dave Griffiths committed
1186

1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
  (activity
   "move"
   (build-activity
    (mspinner 'move-household '()
              (lambda (v)
                (entity-set-value!
                 "parent" "varchar"
                 (cadr (list-ref (get-current 'move-household-list '()) v)))
                '())))
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1199
     (set-current! 'activity-title "Move")
1200
     (set-current! 'move-household-list (build-array-from-names db "sync" "household"))
Dave Griffiths's avatar
Dave Griffiths committed
1201
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1202
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
1203
1204
1205
      (list
       (update-widget 'spinner (get-id "move-household-spinner") 'array
                      (map car (get-current 'move-household-list '()))))))
1206
1207
1208
1209
1210
1211
1212
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))


Dave Griffiths's avatar
Dave Griffiths committed
1213
1214
1215
1216

  (activity
   "migration"
   (build-activity
1217
1218
1219
1220
1221
    (medit-text 'length-time "numeric" (lambda (v) (entity-set-value! "length-time" "int" v) '()))
    (medit-text 'place-of-birth "normal" (lambda (v) (entity-set-value! "place-of-birth" "varchar" v) '()))
    (medit-text 'num-residence-changes "numeric" (lambda (v) (entity-set-value! "num-residence-changes" "int" v) '()))
    (medit-text 'village-visits-month "numeric" (lambda (v) (entity-set-value! "village-visits-month" "int" v) '()))
    (medit-text 'village-visits-year "numeric" (lambda (v) (entity-set-value! "village-visits-year" "int" v) '()))
1222
1223
    (mbutton 'next (lambda () (list (start-activity "income" 0 ""))))
    (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1224
1225
1226
    )
   (lambda (activity arg)
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
1227
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1228
     (set-current! 'activity-title "Migration")
Dave Griffiths's avatar
Dave Griffiths committed
1229
     (append
Dave Griffiths's avatar