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

added gps properly

parent e7421339
...@@ -570,3 +570,30 @@ ...@@ -570,3 +570,30 @@
(list-ref d 3) (list-ref d 3)
(list-ref d 4) (list-ref d 4)
(list-ref d 5))))) (list-ref d 5)))))
(define (do-gps display-id key-prepend)
(let ((loc (get-current 'location '(0 0))))
(entity-add-value! (string-append key-prepend "-lat") "real" (car loc))
(entity-add-value! (string-append key-prepend "-lon") "real" (cadr loc))
(get-id (string-append (symbol->string display-id) "-lat"))
(number->string (car loc)))
(get-id (string-append (symbol->string display-id) "-lon"))
(number->string (cadr loc))))))
(define (mupdate-gps display-id key-prepend)
'text-view (get-id (string-append (symbol->string display-id) "-lat"))
'text (number->string
(entity-get-value (string-append key-prepend "-lat")) "real" 0))
'text-view (get-id (string-append (symbol->string display-id) "-lon"))
'text (number->string
(entity-get-value (string-append key-prepend "-lon")) "real" 0))))
...@@ -101,7 +101,8 @@ ...@@ -101,7 +101,8 @@
(list 'school (list "School")) (list 'school (list "School"))
(list 'present (list "Present")) (list 'present (list "Present"))
(list 'closest-access (list "Closest place of access")) (list 'closest-access (list "Closest place of access"))
(list 'gps (list "GPS")) (list 'house-gps (list "GPS"))
(list 'toilet-gps (list "GPS"))
(list 'school (list "School")) (list 'school (list "School"))
(list 'hospital (list "Hospital/Health care centre")) (list 'hospital (list "Hospital/Health care centre"))
(list 'post-office (list "Post Office")) (list 'post-office (list "Post Office"))
...@@ -441,7 +442,7 @@ ...@@ -441,7 +442,7 @@
(lambda (v) (lambda (v)
(cond (cond
((eqv? v 1) ((eqv? v 1)
(entity-set-value! "deleted" "int" 1) (entity-add-value! "deleted" "int" 1)
(entity-update-values!) (entity-update-values!)
(list (finish-activity 1))) (list (finish-activity 1)))
(else (else
...@@ -484,14 +485,19 @@ ...@@ -484,14 +485,19 @@
(ktv "name" "varchar" (mtext-lookup 'default-village-name)) (ktv "name" "varchar" (mtext-lookup 'default-village-name))
(ktv "block" "varchar" "") (ktv "block" "varchar" "")
(ktv "district" "varchar" "test") (ktv "district" "varchar" "test")
(ktv "car" "int" 0) (ktv "car" "int" 0))))
(ktv "photo" "file" "none"))))
(lambda (activity arg) (lambda (activity arg)
(set-current! 'activity-title "Main screen") (set-current! 'activity-title "Main screen")
(activity-layout activity)) (activity-layout activity))
(lambda (activity arg) (lambda (activity arg)
(list (update-list-widget db "sync" "village" "village" #f))) (list
(gps-start "gps" (lambda (loc)
(set-current! 'location loc)
(list (toast (string-append
(number->string (car loc)) ", "
(number->string (cadr loc)))))))
(update-list-widget db "sync" "village" "village" #f)))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
...@@ -516,17 +522,16 @@ ...@@ -516,17 +522,16 @@
(mtoggle-button-scale id (lambda (v) '())) (mtoggle-button-scale id (lambda (v) '()))
(medit-text-scale 'closest-access "normal" (lambda (v) '())) (medit-text-scale 'closest-access "normal" (lambda (v) '()))
(vert (vert
(mbutton-scale 'gps (lambda () '())) (mbutton-scale 'gps (lambda () '()))
(mtext-small 'test-num) (mtext-small 'test-num)
(mtext-small 'test-num)))))) (mtext-small 'test-num))))))
(build-activity (build-activity
(horiz (horiz
(medit-text 'village-name "normal" (medit-text 'village-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(lambda (v) (entity-set-value! "name" "varchar" v) '())) (medit-text 'block "normal" (lambda (v) (entity-add-value! "block" "varchar" v) '())))
(medit-text 'block "normal" (lambda () '())))
(horiz (horiz
(medit-text 'district "normal" (lambda () '())) (medit-text 'district "normal" (lambda (v) (entity-add-value! "district" "varchar" v) '()))
(mtoggle-button-scale 'car (lambda () '()))) (mtoggle-button-scale 'car (lambda (v) (entity-add-value! "car" "int" v) '())))
(mbutton 'household-list (mbutton 'household-list
(lambda () (lambda ()
...@@ -591,22 +596,20 @@ ...@@ -591,22 +596,20 @@
"household" "household"
(build-activity (build-activity
(horiz (horiz
(medit-text 'household-name "normal" (lambda (v) '())) (medit-text 'household-name "normal" (lambda (v) (entity-add-value! "name" "varchar" v) '()))
(medit-text 'num-pots "numeric" (lambda (v) '()))) (medit-text 'num-pots "numeric" (lambda (v) (entity-add-value! "num-pots" "int" v) '())))
(horiz (horiz
(mtext 'location)
(vert (vert
(mbutton 'GPS (lambda () '())) (mtext 'location)
(mtext-small 'test-num) (mbutton 'house-gps (lambda () (do-gps 'house "house")))
(mtext-small 'test-num)) (mtext-small 'house-lat)
(medit-text 'elevation "numeric" (lambda (v) '()))) (mtext-small 'house-lon))
(mtext 'toilet-location)
(vert (vert
(mbutton 'GPS (lambda () '())) (mtext 'toilet-location)
(mtext-small 'test-num) (mbutton 'toilet-gps (lambda () (do-gps 'toilet "toilet")))
(mtext-small 'test-num)) (mtext-small 'toilet-lat)
(medit-text 'elevation "numeric" (lambda (v) '()))) (mtext-small 'toilet-lon)))
(build-list-widget (build-list-widget
db "sync" 'individuals "individual" "individual" (lambda () (get-current 'household #f)) db "sync" 'individuals "individual" "individual" (lambda () (get-current 'household #f))
...@@ -627,10 +630,13 @@ ...@@ -627,10 +630,13 @@
(lambda (activity arg) (lambda (activity arg)
(entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg)) (entity-init! db "sync" "household" (get-entity-by-unique db "sync" arg))
(set-current! 'household arg) (set-current! 'household arg)
(list (append
(update-list-widget db "sync" "individual" "individual" arg) (list
(mupdate 'edit-text 'household-name "name") (update-list-widget db "sync" "individual" "individual" arg)
(mupdate 'edit-text 'num-pots "num-pots"))) (mupdate 'edit-text 'household-name "name")
(mupdate 'edit-text 'num-pots "num-pots"))
(mupdate-gps 'house "house")
(mupdate-gps 'toilet "toilet")))
(lambda (activity) '()) (lambda (activity) '())
(lambda (activity) '()) (lambda (activity) '())
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment