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

pack and individuals fed through to the focal exp

parent 12c758c4
......@@ -77,7 +77,6 @@
;; get the type from the attribute table with an entity/key
(define (get-attribute-type db table entity-type key)
(msg "get-attribute-type")
(let ((sql (string-append
"select attribute_type from " table
"_attribute where entity_type = ? and attribute_id = ?")))
......@@ -85,7 +84,6 @@
;; search for a type and add it if it doesn't exist
(define (find/add-attribute-type db table entity-type key type)
(msg "find/add-attribute")
(let ((t (get-attribute-type db table entity-type key)))
;; add and return passed in type if not exist
(cond
......@@ -107,7 +105,6 @@
;; low level insert of a ktv
(define (insert-value db table entity-id ktv)
(msg "insert-value")
;; use type to dispatch insert to correct value table
(db-insert db (string-append "insert into " table "_value_" (ktv-type ktv)
" values (null, ?, ?, ?, 0)")
......@@ -120,13 +117,10 @@
;; insert an entire entity
(define (insert-entity db table entity-type user ktvlist)
(msg "insert-entity")
(insert-entity-wholesale db table entity-type (get-unique user) 1 0 ktvlist))
;; all the parameters - for syncing purposes
(define (insert-entity-wholesale db table entity-type unique-id dirty version ktvlist)
(msg "insert-entity-w")
(msg table entity-type ktvlist)
(let ((id (db-insert
db (string-append
"insert into " table "_entity values (null, ?, ?, ?, ?)")
......@@ -139,20 +133,16 @@
;; add all the keys
(for-each
(lambda (ktv)
(msg (ktv-key ktv))
(insert-value db table id ktv))
ktvlist)
id))
;; update the value given an entity type, a attribute type and it's key (= attriute_id)
(define (update-value db table entity-id ktv)
(msg "update-value" table entity-id ktv)
(db-exec
db (string-append "update " table "_value_" (ktv-type ktv)
" set value=? where entity_id = ? and attribute_id = ?")
(ktv-value ktv) entity-id (ktv-key ktv))
(msg (db-status db)))
(ktv-value ktv) entity-id (ktv-key ktv)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; getting data out
......@@ -245,7 +235,7 @@
(if (equal? (ktv-get e (car clause)) (cadr clause))
(cons e r) r)))
'()
(all-entities db table type)))
(dbg (all-entities db table type))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; updating data
......
......@@ -430,14 +430,14 @@
(define (horiz . l)
(linear-layout
(make-id "h")
(make-id "xv")
'horizontal
(layout 'fill-parent 'fill-parent 1 'left)
l))
(define (vert . l)
(linear-layout
(make-id "v")
(make-id "xv")
'vertical
(layout 'fill-parent 'fill-parent 1 'left)
l))
......@@ -576,7 +576,7 @@
((equal? (widget-type widget) "button")
((button-listener widget)))
((equal? (widget-type widget) "toggle-button")
((button-listener widget (car args))))
((toggle-button-listener widget) (car args)))
((equal? (widget-type widget) "seek-bar")
((seek-bar-listener widget) (car args)))
((equal? (widget-type widget) "spinner")
......
......@@ -18,9 +18,6 @@
(define db "/sdcard/test.db")
(db-open db)
(display "hello one two three")(newline)
(setup db "local")
(setup db "sync")
(setup db "stream")
......@@ -30,15 +27,7 @@
(list
(ktv "user-id" "varchar" "No name yet...")))
(display "sonwassa")(newline)
(msg "001")
(display (db-all db "local" "app-settings"))(newline)
(msg "002")
(display (db-status db))(newline)
(msg "003")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stuff in memory
......@@ -95,7 +84,6 @@
;; spit all dirty entities to server
(define (spit-dirty db table)
(msg "hello")
(map
(lambda (e)
(http-request
......@@ -106,10 +94,9 @@
(if (equal? (car v) "inserted")
(update-entity-clean db table (cadr v))
(display "somefink went wrong")(newline)))))
(dbg (dirty-entities db table))))
(dirty-entities db table)))
(define (suck-entity-from-server db table unique-id exists)
(msg "suck-entity-from-server" unique-id)
;; ask for the current version
(http-request
(string-append unique-id "-update-new")
......@@ -119,11 +106,8 @@
;; check "sync-insert" in sync.ss raspberry pi-side for the contents of 'entity'
(let ((entity (list-ref data 0))
(ktvlist (list-ref data 1)))
(msg "1111" exists)
(if (not exists)
(begin
(msg entity)
(msg (string? (list-ref entity 2)))
(insert-entity-wholesale
db table
(list-ref entity 0) ;; entity-type
......@@ -134,39 +118,32 @@
(update-to-version
db table (get-entity-id db table unique-id)
(list-ref entity 4) ktvlist)))
(msg "2222" exists)
'())))
;; repeatedly read version and request updates
(define (suck-new db table)
(msg "suck-new")
(list
(http-request
"new-entities-req"
(dbg (string-append url "fn=entity-versions&table=" table))
(string-append url "fn=entity-versions&table=" table)
(lambda (data)
(msg data)
(dbg (foldl
(foldl
(lambda (i r)
(msg "inner loop" i)
(let* ((unique-id (car i))
(version (cadr i))
(exists (entity-exists? db table unique-id))
(old
(if exists
(> version (dbg (get-entity-version
db table
(get-entity-id db table unique-id))))
(> version (get-entity-version
db table
(get-entity-id db table unique-id)))
#f)))
;; if we don't have this entity or the version on the server is newer
(if (or (not exists) old)
(cons (suck-entity-from-server db table unique-id exists) r)
r)))
'()
data))))))
(msg "004")
data)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -176,6 +153,71 @@
(define (mtext id text)
(text-view (make-id id) text 20 fillwrap))
(define (xwise n l)
(define (_ c l)
(cond
((null? l) (if (null? c) '() (list c)))
((eqv? (length c) (- n 1))
(cons (append c (list (car l))) (_ '() (cdr l))))
(else
(_ (append c (list (car l))) (cdr l)))))
(_ '() l))
(define (build-pack-buttons act fn)
(map
(lambda (packs)
(apply
horiz
(map
(lambda (pack)
(let ((name (ktv-get pack "name")))
(button (make-id (string-append act "-pack-" name))
name 20 fillwrap
(lambda ()
(fn pack)))))
packs)))
(xwise 2 (db-all db "sync" "pack"))))
;(define (build-individual-buttons act fn)
; (map
; (lambda (individuals)
; (apply
; horiz
; (map
; (lambda (individual)
; (let ((name (ktv-get individual "name")))
; (button (make-id (string-append act "-ind-" name))
; name 20 fillwrap
; (lambda ()
; (fn individual)))))
; individuals)))
; (xwise
; 2 (db-all-where
; db "sync" "mongoose"
; (list "pack-id" (ktv-get (get-current 'pack '()) "unique_id"))))))
;(define (build-pack-buttons act fn)
; (map
; (lambda (pack)
; (let ((name (ktv-get pack "name")))
; (button (make-id (string-append act "-pack-" name))
; name 20 fillwrap
; (lambda ()
; (fn pack)))))
; (db-all db "sync" "pack")))
(define (build-individual-buttons act fn)
(map
(lambda (individual)
(let ((name (ktv-get individual "name")))
(button (make-id (string-append act "-ind-" name))
name 20 fillwrap
(lambda ()
(fn individual)))))
(db-all-where
db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))))
(define-activity-list
(activity
"splash"
......@@ -247,20 +289,22 @@
(vert
(text-view (make-id "title") "Select a Pack" 40 fillwrap)
(spacer 10)
(horiz
(button (make-id "pack-select-pack-0") "Pack 1" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 ""))))
(button (make-id "pack-select-pack-1") "Pack 2" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 "")))))
(horiz
(button (make-id "pack-select-pack-2") "Pack 3" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 ""))))
(button (make-id "pack-select-pack-3") "Pack 4" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 "")))))
(horiz
(button (make-id "pack-select-pack-4") "Pack 5" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 ""))))
(button (make-id "pack-select-pack-5") "Pack 6" 20 fillwrap (lambda () (list (start-activity "individual-select" 2 "")))))
(linear-layout
(make-id "pack-select-pack-list")
'vertical fill (list))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "pack-select-pack-list") 'contents
(build-pack-buttons
"pack-select"
(lambda (pack)
(set-current! 'pack pack)
(list (start-activity "individual-select" 2 "")))))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -272,19 +316,20 @@
(vert
(text-view (make-id "title") "Select an individual" 40 fillwrap)
(spacer 10)
(horiz
(button (make-id "individual-select-pack-0") "Mongoose 1" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 ""))))
(button (make-id "individual-select-pack-1") "Mongoose 2" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 "")))))
(horiz
(button (make-id "individual-select-pack-2") "Mongoose 3" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 ""))))
(button (make-id "individual-select-pack-3") "Mongoose 4" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 "")))))
(horiz
(button (make-id "individual-select-pack-4") "Mongoose 5" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 ""))))
(button (make-id "individual-select-pack-5") "Mongoose 6" 20 fillwrap (lambda () (list (start-activity "pup-focal" 2 "")))))
(linear-layout
(make-id "individual-select-list")
'vertical fill (list))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "individual-select-list") 'contents
(build-individual-buttons
"ind-select"
(lambda (individual)
(set-current! 'individual individual)
(list (start-activity "pup-focal" 2 "")))))))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -293,11 +338,15 @@
(let ((clear-focal-toggles
(lambda ()
(lambda (v but)
(list
(update-widget 'toggle-button (get-id "pup-focal-moving") 'checked 0)
(update-widget 'toggle-button (get-id "pup-focal-foraging") 'checked 0)
(update-widget 'toggle-button (get-id "pup-focal-resting") 'checked 0)))))
(update-widget 'toggle-button (get-id "pup-focal-moving") 'checked
(if (equal? but "pup-focal-moving") 1 0))
(update-widget 'toggle-button (get-id "pup-focal-foraging") 'checked
(if (equal? but "pup-focal-foraging") 1 0))
(update-widget 'toggle-button (get-id "pup-focal-resting") 'checked
(if (equal? but "pup-focal-resting") 1 0)))
)))
(activity
"pup-focal"
......@@ -307,20 +356,38 @@
(vert
(text-view (make-id "pup-focal-timer-text") "Time left" 20 fillwrap)
(text-view (make-id "pup-focal-timer") "30" 40 fillwrap)))
(text-view (make-id "pup-focal-name/pack") "" 25 fillwrap)
(text-view (make-id "pup-focal") "Current Activity" 20 fillwrap)
(horiz
(toggle-button (make-id "pup-focal-moving") "Moving" 20 fillwrap (lambda (v) (clear-focal-toggles)))
(toggle-button (make-id "pup-focal-foraging") "Foraging" 20 fillwrap (lambda (v) (clear-focal-toggles)))
(toggle-button (make-id "pup-focal-resting") "Resting" 20 fillwrap (lambda (v) (clear-focal-toggles))))
(toggle-button (make-id "pup-focal-moving") "Moving" 20 fillwrap (lambda (v) (clear-focal-toggles v "pup-focal-moving")))
(toggle-button (make-id "pup-focal-foraging") "Foraging" 20 fillwrap (lambda (v) (clear-focal-toggles v "pup-focal-foraging")))
(toggle-button (make-id "pup-focal-resting") "Resting" 20 fillwrap (lambda (v) (clear-focal-toggles v "pup-focal-resting"))))
(text-view (make-id "pup-focal-escort-text") "Current Escort" 20 fillwrap)
(spinner (make-id "pup-focal-escort") (list "Mongoose 1" "Mongoose 2" "Mongoose 3" "Mongoose 4") fillwrap (lambda (v) '()))
(spinner (make-id "pup-focal-escort") (list "mongoose1" "mongoose2")
fillwrap (lambda (v) '()))
(horiz
(button (make-id "pup-focal-event") "New event" 20 fillwrap (lambda () (list (start-activity "pup-focal-event" 2 ""))))
(toggle-button (make-id "pup-focal-pause") "Pause" 20 fillwrap (lambda (v) '()))
))
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(list
(update-widget 'text-view (get-id "pup-focal-name/pack") 'text
(string-append
"Pack: " (ktv-get (get-current 'pack '()) "name") " "
"Pup: " (ktv-get (get-current 'individual '()) "name")))
(update-widget 'spinner (get-id "pup-focal-escort") 'array
(foldl
(lambda (individual r)
(let ((name (ktv-get individual "name")))
(if (equal? name (ktv-get (get-current 'individual '()) "name"))
r (cons name r))))
'()
(dbg (db-all-where
db "sync" "mongoose"
(list "pack-id" (ktv-get (get-current 'pack '()) "unique_id"))))))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -438,24 +505,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ((build-pack-buttons
(lambda ()
(foldl
(lambda (pack r)
(let ((name (ktv-get pack "name")))
(msg name)
(if (not (null? name))
(cons (button (make-id (string-append "manage-packs-pack-" name))
name 20 fillwrap
(lambda ()
(msg "going to manage individuals")
(msg pack)
(set-current! 'pack pack)
(list (start-activity "manage-individual" 2 ""))))
r)
r)))
'()
(db-all db "sync" "pack")))))
(activity
"manage-packs"
(vert
......@@ -470,13 +519,17 @@
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-packs-pack-list") 'contents
(dbg (build-pack-buttons)))
(build-pack-buttons
"manage-packs"
(lambda (pack)
(set-current! 'pack pack)
(list (start-activity "manage-individual" 2 "")))))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity requestcode resultcode) '())))
(lambda (activity requestcode resultcode) '()))
(activity
"new-pack"
......@@ -485,7 +538,7 @@
(spacer 10)
(text-view (make-id "new-pack-name-text") "Pack name" 20 fillwrap)
(edit-text (make-id "new-pack-name") "" 30 fillwrap
(lambda (v) (msg "edit callback" v) (set-current! 'pack-name v) '()))
(lambda (v) (set-current! 'pack-name v) '()))
(spacer 10)
(horiz
(button (make-id "new-pack-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
......@@ -506,21 +559,6 @@
(lambda (activity) '())
(lambda (activity requestcode resultcode) '()))
(let ((build-individual-buttons
(lambda ()
(msg "building individual buttons")
(map
(lambda (individual)
(msg "hello")
(let ((name (ktv-get individual "name")))
(button (make-id (string-append "manage-individuals-ind-" name))
name 20 fillwrap
(lambda ()
(list (start-activity "manage-individual" 2 ""))))))
(dbg (db-all-where
db "sync" "mongoose"
(dbg (list "pack-id" (ktv-get (dbg (get-current 'pack '())) "unique_id")))))
))))
(activity
"manage-individual"
(vert
......@@ -536,7 +574,10 @@
(lambda (activity arg)
(list
(update-widget 'linear-layout (get-id "manage-individuals-list") 'contents
(build-individual-buttons))
(build-individual-buttons
"manage-ind"
(lambda (individual)
(list (start-activity "manage-individual" 2 "")))))
(update-widget 'text-view (get-id "manage-individual-pack-name") 'text
(string-append "Pack: " (ktv-get (get-current 'pack '()) "name")))
))
......@@ -544,7 +585,7 @@
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity requestcode resultcode) '())))
(lambda (activity requestcode resultcode) '()))
(activity
"new-individual"
......@@ -668,9 +709,9 @@
(let ((sync (get-dirty-stats db "sync"))
(stream (get-dirty-stats db "stream")))
(msg sync stream)
(dbg (string-append
"Pack data: " (number->string (car sync)) "/" (number->string (cadr sync)) " "
"Focal data: " (number->string (car stream)) "/" (number->string (cadr stream))))))))
(string-append
"Pack data: " (number->string (car sync)) "/" (number->string (cadr sync)) " "
"Focal data: " (number->string (car stream)) "/" (number->string (cadr stream)))))))
(activity
"sync"
(vert
......@@ -684,7 +725,6 @@
"network"
"mongoose-web"
(lambda (state)
(msg state)
(list
(update-widget 'text-view (get-id "sync-connect") 'text state)))))))
(mbutton "sync-sync" "Push"
......@@ -692,7 +732,7 @@
(spit-dirty db "sync")))
(mbutton "sync-pull" "Pull"
(lambda ()
(dbg (suck-new db "sync")))))
(suck-new db "sync"))))
(text-view (make-id "sync-console") "..." 15 (layout 300 'wrap-content 1 'left))
(mbutton "main-send" "Done" (lambda () (list (finish-activity 2)))))
......
android/res/drawable/logo.png

3.5 KB | W: | H:

android/res/drawable/logo.png

1.84 KB | W: | H:

android/res/drawable/logo.png
android/res/drawable/logo.png
android/res/drawable/logo.png
android/res/drawable/logo.png
  • 2-up
  • Swipe
  • Onion skin
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