starwisp.scm 73.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....")
22
(define entity-types (list "village" "household" "individual" "child" "crop"))
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 "current-village" "varchar" "none")))
Dave Griffiths's avatar
Dave Griffiths committed
45

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

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

(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
58
(set-current! 'user-id (get-setting-value "user-id"))
Dave Griffiths's avatar
Dave Griffiths committed
59
60
(set! i18n-lang (get-setting-value "language"))

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

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

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

Dave Griffiths's avatar
Dave Griffiths committed
77
78
(define village-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
79
   (ktv "name" "varchar" (mtext-lookup 'default-village-name))
Dave Griffiths's avatar
Dave Griffiths committed
80
   (ktv "notes" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
81
   (ktv "block" "varchar" "")
82
83
84
85
86
87
88
89
   (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" "")
90
   (ktv "ngo-closest-access" "varchar" "")
91
   (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 "notes" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
98
   (ktv "num-pots" "int" 0)
99
   (ktv "num-children" "int" 0)
Dave Griffiths's avatar
Dave Griffiths committed
100
101
102
103
   (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
104

105
106
(define individual-ktvlist
  (list
107
108
   (ktv "edit-history" "varchar" "")
   (ktv "social-edit-history" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
109
   (ktv "name" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
110
   (ktv "notes" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
111
112
113
   (ktv "first-name" "varchar" "")
   (ktv "family" "varchar" "")
   (ktv "photo-id" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
114
   (ktv "photo" "file" "")
Dave Griffiths's avatar
Dave Griffiths committed
115
116
   (ktv "agreement-photo" "file" "")
   (ktv "agreement-general" "file" "")
117
118
   (ktv "tribe" "varchar" "not-set")
   (ktv "subtribe" "varchar" "not-set")
119
120
   (ktv "child" "int" -1)
   (ktv "age" "int" -1)
121
122
123
   (ktv "gender" "varchar" "not-set")
   (ktv "literate" "varchar" "not-set")
   (ktv "education" "varchar" "not-set")
Dave Griffiths's avatar
Dave Griffiths committed
124
   (ktv "head-of-house" "varchar" "")
125
   (ktv "marital-status" "varchar" "not-set")
126
   (ktv "times-married" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
127
   (ktv "id-spouse" "varchar" "")
128
129
130
131
   (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
132
   (ktv "residence-after-marriage" "varchar" "")
133
134
135
   (ktv "num-siblings" "int" -1)
   (ktv "birth-order" "int" -1)
   (ktv "length-time" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
136
   (ktv "place-of-birth" "varchar" "")
137
138
139
   (ktv "num-residence-changes" "int" -1)
   (ktv "village-visits-month" "int" -1)
   (ktv "village-visits-year" "int" -1)
140
141
142
143
144
   (ktv "occupation-agriculture" "varchar" "not-set")
   (ktv "occupation-gathering" "varchar" "not-set")
   (ktv "occupation-labour" "varchar" "not-set")
   (ktv "occupation-cows" "varchar" "not-set")
   (ktv "occupation-fishing" "varchar" "not-set")
145
   (ktv "occupation-other" "varchar" "")
146
147
148
149
150
   (ktv "contribute" "varchar" "not-set")
   (ktv "own-land" "varchar" "not-set")
   (ktv "rent-land" "varchar" "not-set")
   (ktv "hire-land" "varchar" "not-set")
   (ktv "house-type" "varchar" "not-set")
151
152
   (ktv "loan" "int" -1)
   (ktv "earning" "int" -1)
153
154
155
   (ktv "radio" "varchar" "not-set")
   (ktv "tv" "varchar" "not-set")
   (ktv "mobile" "varchar" "not-set")
156
157
   (ktv "visit-market" "int" -1)
   (ktv "town-sell" "int" -1)
Dave Griffiths's avatar
Dave Griffiths committed
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
202
203
204
205
206
207
   (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" "")
208
   ))
Dave Griffiths's avatar
Dave Griffiths committed
209

210
211
(define crop-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
212
   (ktv "name" "varchar" (mtext-lookup 'default-crop-name))
Dave Griffiths's avatar
Dave Griffiths committed
213
   (ktv "notes" "varchar" "")
Dave Griffiths's avatar
Dave Griffiths committed
214
   (ktv "unit" "varchar" "unit")
215
216
   (ktv "used" "real" -1)
   (ktv "sold" "real" -1)
Dave Griffiths's avatar
Dave Griffiths committed
217
   (ktv "seed" "varchar" "")))
218

219
220
(define child-ktvlist
  (list
Dave Griffiths's avatar
Dave Griffiths committed
221
   (ktv "name" "varchar" (mtext-lookup 'default-child-name))
Dave Griffiths's avatar
Dave Griffiths committed
222
   (ktv "notes" "varchar" "")
223
224
   (ktv "alive" "varchar" "varchar" "not-set")
   (ktv "gender" "varchar" "not-set")
225
   (ktv "age" "int" -1)
226
   (ktv "living-at-home" "varchar" "not-set")))
227
228


Dave Griffiths's avatar
Dave Griffiths committed
229
230
231
232
233
234
235
236
237
238
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

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

239
240
241

;; return last element from comma seperated list
(define (history-get-last txt)
Dave Griffiths's avatar
Dave Griffiths committed
242
  (let ((l (string-split txt '(#\:))))
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
    (if (null? l) ""
        (car (reverse l)))))

(define (contains-social? ktv-list)
  (foldl
   (lambda (ktv r)
     (if (and
          (not r)
          (> (string-length (ktv-key ktv)) 5)
          (or
           (equal? (substring (ktv-key ktv) 0 6) "friend")
           (equal? (substring (ktv-key ktv) 0 6) "social")))
         #t r))
   #f ktv-list))

Dave Griffiths's avatar
Dave Griffiths committed
258
259
;; go through each dirty entity and stick the user id
;; on the end of the edit history lists - only for individuals
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
(define (update-edit-history db table user-id)
  ;; get dirty individual entities
  (let ((de (db-select
             db (string-append
                 "select entity_id from "
                 table "_entity where dirty=1 and entity_type='individual';"))))
    (when (not (null? de))
          (for-each
           (lambda (i)
             (let* ((entity-id (vector-ref i 0))
                    (dirty-items (dbg (get-entity-plain-for-sync db table entity-id))))
               (when (not (null? dirty-items))
                     ;; check if social change
                     (let ((type (if (contains-social? dirty-items) "social-edit-history" "edit-history")))
                       ;; check if last editor is different
                       (let ((editors (car (get-value db table entity-id (list type "varchar")))))
                         (when (or (equal? editors "") (not (equal? (history-get-last editors) user-id)))
                               ;; append user id
                               (msg "history - setting" type)
                               (if (equal? editors "")
                                   (update-value db table entity-id (ktv type "varchar" (dbg user-id)))
Dave Griffiths's avatar
Dave Griffiths committed
281
                                   (update-value db table entity-id (ktv type "varchar" (dbg (string-append editors ":" user-id)))))))))))
282
283
           (cdr de)))))

Dave Griffiths's avatar
Dave Griffiths committed
284
(define (debug-timer-cb)
285
  (alog "debug timer cb")
Dave Griffiths's avatar
Dave Griffiths committed
286
287
288
  (append
   (cond
    ((get-current 'sync-on #f)
289
290
291
     ;(when (zero? (random 10))
     ;      (msg "mangling...")
     ;      (mangle-test! db "sync" entity-types))
Dave Griffiths's avatar
Dave Griffiths committed
292
293
294
295
     (set-current! 'upload 0)
     (set-current! 'download 0)
     (connect-to-net
      (lambda ()
Dave Griffiths's avatar
Dave Griffiths committed
296
        (msg "connected, going in...")
297
        (alog "got here...")
298
        (update-edit-history db "sync" (get-current 'user-id "no id"))
Dave Griffiths's avatar
Dave Griffiths committed
299
        (append
300
         (list (toast "Syncing"))
Dave Griffiths's avatar
Dave Griffiths committed
301
         (upload-dirty db)
Dave Griffiths's avatar
Dave Griffiths committed
302
303
304
305
306
         ;; 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
307
308
    (else '()))
   (list
Dave Griffiths's avatar
Dave Griffiths committed
309
    (delayed "debug-timer" (+ 10000 (random 5000)) debug-timer-cb)
Dave Griffiths's avatar
Dave Griffiths committed
310
311
312
313
314
315
316
317
318
319
320
    (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
321

Dave Griffiths's avatar
Dave Griffiths committed
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
     (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
358

Dave Griffiths's avatar
Dave Griffiths committed
359
360
361
(define-fragment-list

  (fragment
362
363
   "top"
   (horiz
Dave Griffiths's avatar
Dave Griffiths committed
364
365
    (image-button (make-id "top-icon") "logo" (layout 48 64 -1 'centre 0)
                  (lambda () (list (start-activity-goto "main2" 0 ""))))
366
    (text-view (make-id "title") "" 30
Dave Griffiths's avatar
Dave Griffiths committed
367
               (layout 'fill-parent 'fill-parent 0.5 'centre 10))
368
369
370

    (linear-layout
     0 'vertical
Dave Griffiths's avatar
Dave Griffiths committed
371
     (layout 'fill-parent 'wrap-content 0.5 'centre 0)
372
373
374
     (list 0 0 0 0)

     (list
Dave Griffiths's avatar
Dave Griffiths committed
375
376
377
378
      (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
379
      (text-view (make-id "top-photo-id") 'photo-id 20
Dave Griffiths's avatar
Dave Griffiths committed
380
                 (layout 'wrap-content 'wrap-content 1 'right 0)))))
Dave Griffiths's avatar
Dave Griffiths committed
381
382
   (lambda (fragment arg)
     (activity-layout fragment))
Dave Griffiths's avatar
Dave Griffiths committed
383
   (lambda (fragment arg) '())
Dave Griffiths's avatar
Dave Griffiths committed
384
385
386
387
388
389
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '())
   (lambda (fragment) '()))


390
391
392
393
  (fragment
   "bottom"
   (linear-layout
    0 'horizontal
Dave Griffiths's avatar
Dave Griffiths committed
394
    (layout 'fill-parent 'fill-parent 1 'centre 0)
395
396
    (list 0 0 0 0)
    (list
397
398
399
400
401
402
403
404
405
406
407
408
409
410
;     (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))))))))
411
     (mbutton-scale 'back (lambda () (list (finish-activity 1))))))
412
413
414
415
416
417
418
419
   (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
420
421
422
423


  )

Dave Griffiths's avatar
Dave Griffiths committed
424
425
426
427
428
429
430
431
432
433
434
435
436
(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
437
438
439
440
(define (build-activity . contents)
  (vert-fill
   (relative
    '(("parent-top"))
441
    colour-one ;;(list 100 100 255 127)
Dave Griffiths's avatar
Dave Griffiths committed
442
443
444
445
446
447
448
449
450
    (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"))
451
    colour-one
Dave Griffiths's avatar
Dave Griffiths committed
452
453
454
455
    (vert
     (spacer 5)
     (build-fragment "bottom" (make-id "bottom") fillwrap)))))

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

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

Dave Griffiths's avatar
Dave Griffiths committed
489
490
491
492
493
(define (get-next-id db table type parent)
  (+ 1 (length (filter-entities-inc-deleted
                db table type
                (list (list "parent" "varchar" "=" parent))))))

494

495
496
497
498
(define (make-photo-button-title e)
  (string-append
   (ktv-get e "name") "\n" (ktv-get e "first-name") " " (ktv-get e "family")))

499
500
501
502
503
504
505
506
507
(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
508
         ((> (length search) 500)
509
510
          (button
           (make-id (string-append "chooser-" id))
511
           (make-photo-button-title e) 20 (layout (car button-size) (/ (cadr button-size) 3) 1 'centre 5)
512
513
514
515
516
517
518
           (lambda ()
             (set-current! 'choose-result id)
             (list (finish-activity 0)))))

         ((equal? image "face")
          (button
           (make-id (string-append "chooser-" id))
519
           (make-photo-button-title e) 20 (layout (car button-size) (cadr button-size) 1 'centre 5)
520
521
522
523
524
525
526
527
528
529
530
531
           (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))))
532
           (text-view 0 (make-photo-button-title e) 20 (layout 'wrap-content 'wrap-content -1 'centre 0)))
533
534
535
536
          ))))
    search)
   3))

537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
;; getting late in the day...
(define filter-index 0)
(define filter-households '())

(define (gradual-build)
  (if (or (null? filter-households)
          (> filter-index (- (length filter-households) 1)))
      '()
      (let ((household (list-ref filter-households filter-index)))
        (set! filter-index (+ filter-index 1))
        (let ((search (db-filter-only db "sync" "individual"
                                      (append (filter-get)
                                              (list (list "parent" "varchar" "="
                                                          (ktv-get household "unique_id"))))
                                      (list
                                       (list "photo" "file")
553
554
555
556
                                       (list "name" "varchar")
                                       (list "first-name" "varchar")
                                       (list "family" "varchar")
                                       ))))
557
558
559
560
561
562
563
564
565
566
567
          (list
           (delayed "filter-delayed" 100 gradual-build)
           (update-widget
            'linear-layout (get-id "choose-pics") 'contents-add
            (list
             (apply vert
                    (cons (text-view 0 (ktv-get household "name") 40 fillwrap)
                          (build-photo-buttons search)))))
           )))))


568
569

(define (update-individual-filter-inner households)
570
  (set! filter-households households)
Dave Griffiths's avatar
Dave Griffiths committed
571
  (set! filter-index 0)
572
  (delayed "filter-delayed" 100 gradual-build))
573

574
(define (update-individual-filter)
575
576
577
  (let ((households (db-filter-only db "sync" "household"
                                    (list (list "parent" "varchar" "=" (get-setting-value "current-village")))
                                    (list (list "name" "varchar")))))
Dave Griffiths's avatar
Dave Griffiths committed
578
    (msg "UIF" households)
Dave Griffiths's avatar
Dave Griffiths committed
579
580
581
582
    (list
     ;; clear contents...
     (update-widget 'linear-layout (get-id "choose-pics") 'contents '())
     (update-individual-filter-inner households))))
583
584
585
586
587
588
589
590
591
592


(define (update-individual-filter2)
  (alog "uif-inner")
  (let ((search (db-filter-only db "sync" "individual"
                                (filter-get)
                                (list
                                 (list "photo" "file")
                                 (list "name" "varchar")))))
    (alog "uif-house-search end")
Dave Griffiths's avatar
Dave Griffiths committed
593
594
    (update-widget
     'linear-layout (get-id "choose-pics") 'contents
595
596
597
598
     (build-photo-buttons search))
    ))


Dave Griffiths's avatar
Dave Griffiths committed
599
600

(define (image/name-from-unique-id db table unique-id)
601
  (let ((e (get-entity-by-unique db table unique-id)))
Dave Griffiths's avatar
Dave Griffiths committed
602
603
604
    (list
     (ktv-get e "name")
     (ktv-get e "photo"))))
605
606
607
608
609
610

(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
611
   (mtext-small (string->symbol (string-append (symbol->string id) "-text")))
612
613
614
615
616
617
618
619
   (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
620
(define (build-small-person-selector id key filter request-code)
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
  (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
637
638


639
640
641
;; 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)
Dave Griffiths's avatar
Dave Griffiths committed
642
643
  (when (and (eqv? request-code choose-code)
             (get-current 'choose-result #f))
Dave Griffiths's avatar
Dave Griffiths committed
644
645
        (entity-set-value! key "varchar" (get-current 'choose-result "not set"))
        (entity-update-values!)))
646
647
648
649

;; 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
650
651
652
653
654
655
    (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
656
           (update-widget 'text-view text-id 'text (or (car image-name) "")))
Dave Griffiths's avatar
Dave Griffiths committed
657
          (list
Dave Griffiths's avatar
Dave Griffiths committed
658
           (update-widget 'text-view text-id 'text (or (car image-name) ""))
Dave Griffiths's avatar
Dave Griffiths committed
659
660
           (update-widget 'image-view id 'external-image
                          (string-append dirname "files/" (cadr image-name))))))))
661

662
(define (build-social-connection id key type request-code shade)
Dave Griffiths's avatar
Dave Griffiths committed
663
  (let ((id-text (string-append (symbol->string id))))
664
665
666
667
668
669
670
671
    (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
672
673
674
675
676
677
678
679
680
681
682
        (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)
                       '()))))

683
684
685
686
687
688
689
        (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
690
691
692
           '())))

       (horiz
693
694
695
696
697
698
        (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
699
700
701
702
703
704
705
706
707
708
709
                              (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
710
711
712
713
714
715
716

(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
717
    (append
718
     (update-person-selector db table id key)
Dave Griffiths's avatar
Dave Griffiths committed
719
720
721
722
723
724
725
726
     (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
727
     (list
Dave Griffiths's avatar
Dave Griffiths committed
728
729
730
731
      (mupdate
       'edit-text
       (string->symbol (string-append id-text "-nickname"))
       (string-append key "-nickname"))
Dave Griffiths's avatar
Dave Griffiths committed
732
      (mupdate-spinner
Dave Griffiths's avatar
Dave Griffiths committed
733
       (string->symbol (string-append id-text "-strength"))
Dave Griffiths's avatar
Dave Griffiths committed
734
735
       (string-append key "-strength")
       social-strength-list))
Dave Griffiths's avatar
Dave Griffiths committed
736
737
     )))

Dave Griffiths's avatar
Dave Griffiths committed
738
739
(define (build-amenity-widgets id shade)
  (let ((id-text (symbol->string id)))
740

Dave Griffiths's avatar
Dave Griffiths committed
741
742
    (horiz-colour
     (if shade colour-one colour-two)
Dave Griffiths's avatar
Dave Griffiths committed
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
     (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
758
759
760
761
762
763
764
765
766
767
768
     (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
769
770
      (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
771
772
773
774
775

(define (update-amenity-widgets id)
  (let ((id-text (symbol->string id)))
    (append
     (list
Dave Griffiths's avatar
Dave Griffiths committed
776
      (mupdate 'toggle-button (string->symbol (string-append id-text "-in-village")) id-text)
Dave Griffiths's avatar
Dave Griffiths committed
777
778
      (mupdate 'edit-text
               (string->symbol (string-append id-text "-closest-access"))
Dave Griffiths's avatar
Dave Griffiths committed
779
780
781
782
783
784
               (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
785
786
787
788
789
     (mupdate-gps
      (string->symbol (string-append id-text "-gps"))
      (string-append id-text "-gps")))))


Dave Griffiths's avatar
Dave Griffiths committed
790
791
792
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; activities

793
(define photo-code 999)
794
(define choose-code 998)
795
796
797
(define spouse-request-code 997)
(define mother-request-code 996)
(define father-request-code 995)
Dave Griffiths's avatar
Dave Griffiths committed
798

Dave Griffiths's avatar
Dave Griffiths committed
799
800
801
802
803
804
(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
805
806
807
808
(define-activity-list

  (activity
   "main"
Dave Griffiths's avatar
Dave Griffiths committed
809
   (vert
810
811
812
813
814
    (image-view 0 "logo" (layout 'wrap-content 'wrap-content -1 'centre 0))
    (button (make-id "main-start")
            "Symbai"
            40 (layout 'wrap-content 'wrap-content -1 'centre 5)
            (lambda () (list (start-activity-goto "main2" 0 "")))))
Dave Griffiths's avatar
Dave Griffiths committed
815
816
817
818
819
820
821
822
823
824
825
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "main2"
826
827
828
   (build-activity
    (mtitle 'title)
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
829
830
831
832
833
     (medit-text 'user-id "normal"
                 (lambda (v)
                   (set-setting! "user-id" "varchar" v)
                   (set-current! 'user-id v)
                   (list)))
834

Dave Griffiths's avatar
Dave Griffiths committed
835
836
     (mspinner 'languages (list 'english 'khasi 'hindi)
               (lambda (c)
837
838
                 (set-setting! "language" "int" c)
                 (set! i18n-lang c)
Dave Griffiths's avatar
Dave Griffiths committed
839
                 (list)))
840
     (mbutton-scale 'find-individual (lambda () (list (start-activity "individual-chooser" choose-code "")))))
Dave Griffiths's avatar
Dave Griffiths committed
841

842
    (build-list-widget
843
     db "sync" 'households (list "name") "household" "household" (lambda () (get-setting-value "current-village"))
Dave Griffiths's avatar
Dave Griffiths committed
844
     (lambda ()
845
846
847
848
849
850
851
852
853
       (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")
854
                   ":"
855
                   (get-setting-value "user-id")
856
                   ":gamehousehold")
857
858
                  (string-append
                   (ktv-get (get-entity-by-unique db "sync" (get-setting-value "current-village")) "name")
859
860
                   ":"
                   (get-setting-value "user-id") ":"
Dave Griffiths's avatar
Dave Griffiths committed
861
                   (number->string (get-next-id db "sync" "household" (get-setting-value "current-village")))))))
862
863
864
865
         ;; autogenerate the name from the current ID
         (ktvlist-merge
          household-ktvlist
          (list (ktv "name" "varchar" name))))))
Dave Griffiths's avatar
Dave Griffiths committed
866

Dave Griffiths's avatar
Dave Griffiths committed
867
868
869
    (horiz
     (mbutton-scale 'villages (lambda () (list (start-activity "villages" 0 ""))))
     (mbutton-scale 'sync (lambda () (list (start-activity "sync" 0 "")))))
Dave Griffiths's avatar
Dave Griffiths committed
870
    )
871

872
873
874
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
875
     (alog "start main start")
Dave Griffiths's avatar
Dave Griffiths committed
876
877
878
879
     (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
880
     (let ((r (append
Dave Griffiths's avatar
Dave Griffiths committed
881
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
882
883
884
885
886
887
888
889
890
      (list
       (update-widget 'edit-text (get-id "user-id") 'text (get-setting-value "user-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
891
       (update-list-widget
892
        db "sync" (list "name") "household" "household" (get-setting-value "current-village"))))))
Dave Griffiths's avatar
Dave Griffiths committed
893
       (alog "end main start") r))
894
895
896
897
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
898
899
   (lambda (activity requestcode resultcode)
     (cond
Dave Griffiths's avatar
Dave Griffiths committed
900
901
      ((and (eqv? requestcode choose-code)
            (get-current 'choose-result 0))
902
       (list (start-activity "individual" 0 (get-current 'choose-result 0))))
903
904
905
906
907
908
      ((eqv? requestcode photo-code)
       (list (update-widget
              'image-view (get-id "image")
              'external-image (string-append dirname "photo.jpg"))))
      (else
       '()))))
909

Dave Griffiths's avatar
Dave Griffiths committed
910
911
912
913
914
915
916
917
918
  (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
919
     db "sync" 'villages (list "name") "village" "village" (lambda () #f)
Dave Griffiths's avatar
Dave Griffiths committed
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
     (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)))
937
       (update-list-widget db "sync" (list "name") "village" "village" #f))))
Dave Griffiths's avatar
Dave Griffiths committed
938
939
940
941
942
943
944
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))


945
946
947

  (activity
   "village"
Dave Griffiths's avatar
Dave Griffiths committed
948
   (build-activity
Dave Griffiths's avatar
Dave Griffiths committed
949
      (horiz
950
951
       (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
952
      (horiz
953
954
       (medit-text 'district "normal" (lambda (v) (entity-set-value! "district" "varchar" v) '()))
       (mtoggle-button-scale 'car (lambda (v) (entity-set-value! "car" "int" v) '())))
955

Dave Griffiths's avatar
Dave Griffiths committed
956
957
958
959
      (mbutton 'household-list
               (lambda ()
                 (list (start-activity "household-list" 0
                                       (get-current 'village #f)))))
960

Dave Griffiths's avatar
Dave Griffiths committed
961
962
      (medit-text-large 'village-notes "normal" (lambda (v) (entity-set-value! "notes" "varchar" v) '()))

Dave Griffiths's avatar
Dave Griffiths committed
963
      (mtitle 'amenities)
Dave Griffiths's avatar
Dave Griffiths committed
964
965
966
967
968
969
970
971
972
973
      (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
974
975
976
   (lambda (activity arg)
     (activity-layout activity))
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
977
     (set-current! 'activity-title "Village")
978
     (entity-init! db "sync" "village" (get-entity-by-unique db "sync" arg))
979
     (set-current! 'village arg)
Dave Griffiths's avatar
Dave Griffiths committed
980
981
     (set-current! 'household #f)
     (set-current! 'individual #f)
Dave Griffiths's avatar
Dave Griffiths committed
982
     (append
Dave Griffiths's avatar
Dave Griffiths committed
983
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
984
985
986
      (list
       (mupdate 'edit-text 'village-name "name")
       (mupdate 'edit-text 'block "block")
Dave Griffiths's avatar
Dave Griffiths committed
987
       (mupdate 'edit-text 'village-notes "notes")
Dave Griffiths's avatar
Dave Griffiths committed
988
989
990
991
992
993
994
995
996
997
998
999
       (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
1000
1001
1002
1003
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
Dave Griffiths's avatar
Dave Griffiths committed
1004
   (lambda (activity requestcode resultcode) '()))
Dave Griffiths's avatar
Dave Griffiths committed
1005

Dave Griffiths's avatar
Dave Griffiths committed
1006
1007
1008
1009

  (activity
   "household-list"
   (build-activity
1010
    (build-list-widget
1011
     db "sync" 'households (list "name") "household" "household" (lambda () (get-current 'village #f))
Dave Griffiths's avatar
Dave Griffiths committed
1012
1013
1014
1015
1016
1017
     (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
1018
1019
                    (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
1020
                    (number->string (get-next-id db "sync" "household" (get-setting-value "current-village"))))))))))
Dave Griffiths's avatar
Dave Griffiths committed
1021
1022
   (lambda (activity arg)
     (activity-layout activity))
1023
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1024
     (set-current! 'activity-title "Households")
Dave Griffiths's avatar
Dave Griffiths committed
1025
1026
1027
     (append
      (update-top-bar)
      (list (update-list-widget
1028
             db "sync" (list "name") "household" "household" arg))))
Dave Griffiths's avatar
Dave Griffiths committed
1029
1030
1031
1032
1033
1034
1035
1036
1037
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "household"
   (build-activity
1038
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1039
1040
     (medit-text 'num-pots "numeric" (lambda (v) (entity-set-value! "num-pots" "int" (string->number v)) '()))
     (medit-text 'num-children "numeric" (lambda (v) (entity-set-value! "num-children" "int" (string->number v)) '())))
1041
1042
    (horiz
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1043
1044
1045
1046
      (mtext 'location)
      (mbutton 'house-gps (lambda () (do-gps 'house "house")))
      (mtext-small 'house-lat)
      (mtext-small 'house-lon))
1047
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1048
1049
1050
1051
1052
      (mtext 'toilet-location)
      (mbutton 'toilet-gps (lambda () (do-gps 'toilet "toilet")))
      (mtext-small 'toilet-lat)
      (mtext-small 'toilet-lon)))

1053
1054

    (build-list-widget
1055
     db "sync" 'individuals (list "name" "first-name" "family") "individual" "individual"
Dave Griffiths's avatar
Dave Griffiths committed
1056
     (lambda () (get-current 'household #f))
Dave Griffiths's avatar
Dave Griffiths committed
1057
     (lambda ()
Dave Griffiths's avatar
Dave Griffiths committed
1058
       (let ((photo-id (get-next-id db "sync" "individual" (get-current 'household #f)))
1059
             (household-name (ktv-get (get-entity-by-unique db "sync" (get-current 'household #f)) "name")))
1060
1061
1062
         (ktvlist-merge
          individual-ktvlist
          (list
Dave Griffiths's avatar
Dave Griffiths committed
1063
           (ktv "name" "varchar"
1064
                (string-append
Dave Griffiths's avatar
Dave Griffiths committed
1065
                 household-name ":"
1066
                 (get-current 'user-id "no id") ":"
1067
                 (number->string photo-id)))
Dave Griffiths's avatar
Dave Griffiths committed
1068
1069
           (ktv "photo-id" "varchar"
                (number->string photo-id))
1070
1071
1072
1073
1074
           (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
1075

Dave Griffiths's avatar
Dave Griffiths committed
1076
    (medit-text-large 'household-notes "normal" (lambda (v) (entity-set-value! "notes" "varchar" v) '()))
Dave Griffiths's avatar
Dave Griffiths committed
1077

Dave Griffiths's avatar
Dave Griffiths committed
1078
    (delete-button))
Dave Griffiths's avatar
Dave Griffiths committed
1079
1080
   (lambda (activity arg)
     (activity-layout activity))
1081
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1082
     (set-current! 'activity-title "Household")
1083
1084
     (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
     (set-current! 'household arg)
Dave Griffiths's avatar
Dave Griffiths committed
1085
     (set-current! 'individual #f)
Dave Griffiths's avatar
Dave Griffiths committed
1086
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1087
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
1088
      (list
1089
       (update-list-widget db "sync" (list "name" "first-name" "family") "individual" "individual" arg)
Dave Griffiths's avatar
Dave Griffiths committed
1090
       (mupdate 'edit-text 'household-notes "notes")
1091
1092
       (mupdate 'edit-text 'num-pots "num-pots")
       (mupdate 'edit-text 'num-children "num-children"))
Dave Griffiths's avatar
Dave Griffiths committed
1093
1094
      (mupdate-gps 'house "house")
      (mupdate-gps 'toilet "toilet")))
1095

Dave Griffiths's avatar
Dave Griffiths committed
1096
1097
1098
1099
1100
1101
1102
1103
1104
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity) '())
   (lambda (activity requestcode resultcode) '()))

  (activity
   "individual"
   (build-activity
1105
    (horiz
Dave Griffiths's avatar
Dave Griffiths committed
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
     (vert
      (image-view (make-id "photo") "face" (layout 240 320 -1 'centre 10))
      (mbutton
       'change-photo
       (lambda ()
         (set-current!
          'photo-name (string-append (entity-get-value "unique_id") "-" (get-unique "p") "-face.jpg"))
         (list
          (take-photo (string-append dirname "files/" (get-current 'photo-name "")) photo-code))
         )))

1117
     (vert
Dave Griffiths's avatar
Dave Griffiths committed
1118
      (mtext 'name-display)
1119
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1120
1121
      (mtext 'first-name-display)
      (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1122
      (mtext 'family-display)
1123
      (spacer 20)
1124
1125
      (mtext 'photo-id-display)
      ))
1126
    (mtext 'last-editor)
1127
    (horiz
1128
1129
     (mbutton-scale 'agreement-button (lambda () (list (start-activity "agreement" 0 ""))))
     (mbutton-scale 'details-button (lambda () (list (start-activity "details" 0 "")))))
1130
    (horiz
1131
1132
     (mbutton-scale 'family-button (lambda () (list (start-activity "family" 0 ""))))
     (mbutton-scale 'migration-button (lambda () (list (start-activity "migration" 0 "")))))
1133
    (horiz
1134
1135
1136
1137
     (mbutton-scale 'income-button (lambda () (list (start-activity "income" 0 ""))))
     (mbutton-scale 'genealogy-button (lambda () (list (start-activity "genealogy" 0 "")))))
    (spacer 20)
    (mtext 'last-social-editor)
Dave Griffiths's avatar
Dave Griffiths committed
1138
    (horiz
1139
1140
     (mbutton-scale 'friendship-button (lambda () (list (start-activity "friendship" 0 ""))))
     (mbutton-scale 'social-button (lambda () (list (start-activity "social" 0 "")))))
1141
    (spacer 20)
Dave Griffiths's avatar
Dave Griffiths committed
1142
1143
    (medit-text-large 'individual-notes "normal" (lambda (v) (entity-set-value! "notes" "varchar" v) '()))
    (spacer 20)
1144
    (mbutton-scale 'move-button (lambda () (list (start-activity "move" 0 ""))))
Dave Griffiths's avatar
Dave Griffiths committed
1145
    (delete-button))
1146

Dave Griffiths's avatar
Dave Griffiths committed
1147
1148
   (lambda (activity arg)
     (activity-layout activity))
Dave Griffiths's avatar
Dave Griffiths committed
1149
   (lambda (activity arg)
Dave Griffiths's avatar
Dave Griffiths committed
1150
     (set-current! 'activity-title "Individual")
Dave Griffiths's avatar
Dave Griffiths committed
1151
1152
     (entity-init! db "sync" "individual" (get-entity-by-unique db "sync" arg))
     (set-current! 'individual arg)
Dave Griffiths's avatar
Dave Griffiths committed
1153
     (msg "individual on create")
Dave Griffiths's avatar
Dave Griffiths committed
1154
     (append
Dave Griffiths's avatar
Dave Griffiths committed
1155
      (update-top-bar)
Dave Griffiths's avatar
Dave Griffiths committed
1156
      (list
Dave Griffiths's avatar
Dave Griffiths committed
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
       (update-widget 'button (get-id "details-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "family-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "migration-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "income-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "genealogy-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "friendship-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))
       (update-widget 'button (get-id "social-button") 'set-enabled
                      (if (equal? (entity-get-value "agreement-general") "") 0 1))

       (update-widget 'button (get-id "change-photo") 'set-enabled
                      (if (equal? (entity-get-value "agreement-photo") "") 0 1))

1175
1176
1177
1178
       (update-widget 'text-view (get-id "last-editor") 'text
                      (string-append "Last edit by " (history-get-last (entity-get-value "edit-history"))))
       (update-widget 'text-view (get-id "last-social-editor") 'text
                      (string-append "Last edit by " (history-get-last (entity-get-value "social-edit-history"))))
Dave Griffiths's avatar
Dave Griffiths committed
1179
       (mupdate 'edit-text 'individual-notes "notes")
Dave Griffiths's avatar
Dave Griffiths committed
1180
       (mupdate 'text-view 'name-display "name")
Dave Griffiths's avatar
Dave Griffiths committed
1181
       (mupdate 'text-view 'first-name-display "first-name")
Dave Griffiths's avatar
Dave Griffiths committed
1182
1183
1184
       (mupdate 'text-view 'family-display "family")
       (mupdate 'text-view 'photo-id-display "photo-id")
       (mupdate 'image-view 'photo "photo"))))