Skip to content

GitLab

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

update individuals works

parent 24965f30
Hide whitespace changes
Inline Side-by-side
android/assets/lib.scm
View file @ e63ac83a
......@@ -422,112 +422,45 @@
(define (widget-type w) (list-ref w 0))
(define (widget-id w) (list-ref w 1))
;; all the widgets!
(define (linear-layout id orientation layout colour children)
(list "linear-layout" id orientation layout colour children))
(define (linear-layout-id t) (list-ref t 1))
(define (linear-layout-orientation t) (list-ref t 2))
(define (linear-layout-layout t) (list-ref t 3))
(define (linear-layout-colour t) (list-ref t 4))
(define (linear-layout-children t) (list-ref t 5))
;;(define (grid-layout id cols orientation layout children)
;; (list "grid-layout" id cols orientation layout children))
;;(define (grid-layout-id t) (list-ref t 1))
;;(define (grid-layout-cols t) (list-ref t 2))
;;(define (grid-layout-orientation t) (list-ref t 3))
;;(define (grid-layout-layout t) (list-ref t 4))
;;(define (grid-layout-children t) (list-ref t 5))
(define (frame-layout id layout children)
(list "frame-layout" id layout children))
(define (frame-layout-id t) (list-ref t 1))
(define (frame-layout-layout t) (list-ref t 2))
(define (frame-layout-children t) (list-ref t 3))
(define (scroll-view id layout children)
(list "scroll-view" id layout children))
(define (scroll-view-id t) (list-ref t 1))
(define (scroll-view-layout t) (list-ref t 2))
(define (scroll-view-children t) (list-ref t 3))
(define (view-pager id layout fragment-list)
(list "view-pager" id layout fragment-list))
(define (space layout) (list "space" "999" layout))
(define (space-view-layout t) (list-ref t 2))
(define (image-view id image layout) (list "image-view" id image layout))
(define (image-view-id t) (list-ref t 1))
(define (image-view-image t) (list-ref t 2))
(define (image-view-layout t) (list-ref t 3))
(define (camera-preview id layout) (list "camera-preview" id layout))
(define (camera-preview-id t) (list-ref t 1))
(define (camera-preview-layout t) (list-ref t 2))
(define (text-view id text size layout) (list "text-view" id text size layout))
(define (text-view-left id text size layout) (list "text-view" id text size layout "left"))
(define (text-view-id t) (list-ref t 1))
(define (text-view-text t) (list-ref t 2))
(define (text-view-modify-text t v) (list-replace t 2 v))
(define (text-view-size t) (list-ref t 3))
(define (text-view-layout t) (list-ref t 4))
(define (debug-text-view id text size layout) (list "debug-text-view" id text size layout))
(define (web-view id data layout) (list "web-view" id data layout))
(define (web-view-id t) (list-ref t 1))
(define (web-view-text t) (list-ref t 2))
(define (web-view-modify-text t v) (list-replace t 2 v))
(define (web-view-layout t) (list-ref t 3))
(define (edit-text id text size type layout listener) (list "edit-text" id text size type layout listener))
(define (edit-text-id t) (list-ref t 1))
(define (edit-text-text t) (list-ref t 2))
(define (edit-text-modify-text t v) (list-replace t 2 v))
(define (edit-text-size t) (list-ref t 3))
(define (edit-text-type t) (list-ref t 4))
(define (edit-text-layout t) (list-ref t 5))
(define (edit-text-listener t) (list-ref t 6))
(define (button id text text-size layout listener) (list "button" id text text-size layout listener))
(define (button-id t) (list-ref t 1))
(define (button-text t) (list-ref t 2))
(define (button-modify-text t v) (list-replace t 2 v))
(define (button-text-size t) (list-ref t 3))
(define (button-layout t) (list-ref t 4))
(define (button-listener t) (list-ref t 5))
(define (toggle-button id text text-size layout listener) (list "toggle-button" id text text-size layout listener))
(define (toggle-button-id t) (list-ref t 1))
(define (toggle-button-text t) (list-ref t 2))
(define (toggle-button-modify-text t v) (list-replace t 2 v))
(define (toggle-button-text-size t) (list-ref t 3))
(define (toggle-button-layout t) (list-ref t 4))
(define (toggle-button-listener t) (list-ref t 5))
(define (seek-bar id max layout listener) (list "seek-bar" id max layout listener))
(define (seek-bar-id t) (list-ref t 1))
(define (seek-bar-max t) (list-ref t 2))
(define (seek-bar-layout t) (list-ref t 3))
(define (seek-bar-listener t) (list-ref t 4))
(define (spinner id items layout listener) (list "spinner" id items layout listener))
(define (spinner-id t) (list-ref t 1))
(define (spinner-items t) (list-ref t 2))
(define (spinner-layout t) (list-ref t 3))
(define (spinner-listener t) (list-ref t 4))
(define (canvas id layout drawlist) (list "canvas" id layout drawlist))
(define (canvas-id t) (list-ref t 1))
(define (canvas-layout t) (list-ref t 2))
(define (canvas-drawlist t) (list-ref t 3))
(define (button-grid id type height textsize layout buttons listener)
(list "button-grid" id type height textsize layout buttons listener))
(define (button-grid-listener b) (list-ref b 7))
(define (drawlist-line colour width points) (list "line" colour width points))
(define (drawlist-text text x y colour size align) (list "text" text x y colour size align))
(define (toast msg) (list "toast" 0 "toast" msg))
(define (make-directory name) (list "make-directory" 0 "make-directory" name))
;; treat this like a dialog so the callback fires
......@@ -760,7 +693,7 @@
(if (not (null? c))
(update-callbacks! c)
(let ((cb (widget-get-callback w)))
(when cb (add-callback! (callback (edit-text-id w) (widget-type w) cb))))))
(when cb (add-callback! (callback (widget-id w) (widget-type w) cb))))))
(update-callbacks! (cdr widget-list)))))
;; walk through update stripping callbacks
......
android/assets/starwisp.scm
View file @ e63ac83a
......@@ -133,6 +133,9 @@
(get-current 'entity-values '())
(ktv key type value))))
(define (entity-set! ktv-list)
(set-current! 'entity-values ktv-list))
(define (dt->string dt)
(string-append
(number->string (list-ref dt 0)) "-"
......@@ -161,6 +164,18 @@
(else
(msg "no values to add as entity!") #f))))
(define (entity-update-values db table)
;; standard bits
(let ((values (get-current 'entity-values '()))
(unique-id (ktv-get (get-current 'entity-values '()) "unique_id")))
(cond
((and unique-id (not (null? values)))
(update-entity db table (entity-id-from-unique db table unique-id) values)
(msg "updated " unique-id)
(entity-reset!))
(else
(msg "no values or no id to update as entity:" unique-id "values:" values)))))
(define (entity-reset!)
(set-current! 'entity-values '()))
......@@ -1270,16 +1285,14 @@
(spacer 10)
(text-view (make-id "new-pack-name-text") "Pack name" 20 fillwrap)
(edit-text (make-id "new-pack-name") "" 30 "text" fillwrap
(lambda (v) (set-current! 'pack-name v) '()))
(lambda (v) (entity-add-value! "name" "varchar" v) '()))
(spacer 10)
(horiz
(button (make-id "new-pack-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "new-pack-cancel") "Cancel" 20 fillwrap
(lambda () (entity-reset!) (list (finish-activity 2))))
(button (make-id "new-pack-done") "Done" 20 fillwrap
(lambda ()
(insert-entity
db "sync" "pack" (get-current 'user-id "no id")
(list
(ktv "name" "varchar" (get-current 'pack-name "no name"))))
(entity-record-values db "sync" "pack")
(list (finish-activity 2)))))
)
(lambda (activity arg)
......@@ -1307,7 +1320,8 @@
"manage-individuals-list" "button"
(db-all-where db "sync" "mongoose" (list "pack-id" (ktv-get (get-current 'pack '()) "unique_id")))
(lambda (individual)
(list (start-activity "manage-individual" 2 ""))))
(set-current! 'individual individual)
(list (start-activity "update-individual" 2 ""))))
(update-widget 'text-view (get-id "manage-individual-pack-name") 'text
(string-append "Pack: " (ktv-get (get-current 'pack '()) "name")))
))
......@@ -1324,33 +1338,27 @@
(text-view (make-id "new-individual-pack-name") "Pack:" 20 fillwrap)
(text-view (make-id "new-individual-name-text") "Name" 20 fillwrap)
(edit-text (make-id "new-individual-name") "" 30 "text" fillwrap
(lambda (v) (set-current! 'individual-name v) '()))
(lambda (v) (entity-add-value! "name" "varchar" v) '()))
(text-view (make-id "new-individual-name-text") "Gender" 20 fillwrap)
(spinner (make-id "new-individual-gender") (list "Female" "Male") fillwrap
(lambda (v) (set-current! 'individual-gender v) '()))
(lambda (v) (entity-add-value! "gender" "varchar" v) '()))
(text-view (make-id "new-individual-dob-text") "Date of Birth" 20 fillwrap)
(horiz
(text-view (make-id "new-individual-dob") "00/00/00" 25 fillwrap)
(button (make-id "date") "Set date" 20 fillwrap (lambda () '())))
(text-view (make-id "new-individual-litter-text") "Litter code" 20 fillwrap)
(edit-text (make-id "new-individual-litter-code") "" 30 "text" fillwrap
(lambda (v) (set-current! 'individual-litter-code v) '()))
(lambda (v) (entity-add-value! "litter-code" "varchar" v) '()))
(text-view (make-id "new-individual-chip-text") "Chip code" 20 fillwrap)
(edit-text (make-id "new-individual-chip-code") "" 30 "text" fillwrap
(lambda (v) (set-current! 'individual-chip-code v) '()))
(lambda (v) (entity-add-value! "chip-code" "varchar" v) '()))
(horiz
(button (make-id "new-individual-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "new-individual-cancel") "Cancel" 20 fillwrap
(lambda () (entity-reset!) (list (finish-activity 2))))
(button (make-id "new-individual-done") "Done" 20 fillwrap
(lambda ()
(insert-entity
db "sync" "mongoose" (get-current 'user-id "no id")
(list
(ktv "name" "varchar" (get-current 'individual-name "no name"))
(ktv "gender" "varchar" (get-current 'individual-gender "Female"))
(ktv "litter-code" "varchar" (get-current 'individual-litter-code ""))
(ktv "chip-code" "varchar" (get-current 'individual-chip-code ""))
(ktv "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
))
(entity-add-value! "pack-id" "varchar" (ktv-get (get-current 'pack '()) "unique_id"))
(entity-record-values db "sync" "mongoose")
(list (finish-activity 2)))))
)
(lambda (activity arg)
......@@ -1371,28 +1379,49 @@
(text-view (make-id "title") "Update Mongoose" 40 fillwrap)
(spacer 10)
(text-view (make-id "update-individual-name-text") "Name" 20 fillwrap)
(edit-text (make-id "update-individual-name") "" 30 "text" fillwrap (lambda (v) '()))
(edit-text (make-id "update-individual-name") "" 30 "text" fillwrap
(lambda (v) (entity-add-value! "name" "varchar" v) '()))
(text-view (make-id "update-individual-name-text") "Gender" 20 fillwrap)
(spinner (make-id "update-individual-gender") (list "Female" "Male") fillwrap (lambda (v) '()))
(spinner (make-id "update-individual-gender") (list "Female" "Male") fillwrap
(lambda (v) (entity-add-value! "gender" "varchar" v) '()))
(text-view (make-id "update-individual-dob-text") "Date of Birth" 20 fillwrap)
(horiz
(text-view (make-id "update-individual-dob") "00/00/00" 25 fillwrap)
(button (make-id "date") "Set date" 20 fillwrap (lambda () '())))
(text-view (make-id "update-individual-litter-text") "Litter code" 20 fillwrap)
(edit-text (make-id "update-individual-litter-code") "" 30 "text" fillwrap (lambda (v) '()))
(edit-text (make-id "update-individual-litter-code") "" 30 "text" fillwrap
(lambda (v) (entity-add-value! "litter-code" "varchar" v) '()))
(text-view (make-id "update-individual-chip-text") "Chip code" 20 fillwrap)
(edit-text (make-id "update-individual-chip-code") "" 30 "text" fillwrap (lambda (v) '()))
(edit-text (make-id "update-individual-chip-code") "" 30 "text" fillwrap
(lambda (v) (entity-add-value! "chip-code" "varchar" v) '()))
(spacer 10)
(horiz
(button (make-id "update-individual-delete") "Delete" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-died") "Died" 20 fillwrap (lambda () (list (finish-activity 2)))))
(horiz
(button (make-id "update-individual-cancel") "Cancel" 20 fillwrap (lambda () (list (finish-activity 2))))
(button (make-id "update-individual-done") "Done" 20 fillwrap (lambda () (list (finish-activity 2)))))
(button (make-id "update-individual-cancel") "Cancel" 20 fillwrap
(lambda () (entity-reset!) (list (finish-activity 2))))
(button (make-id "update-individual-done") "Done" 20 fillwrap
(lambda ()
(entity-update-values db "sync")
(list (finish-activity 2)))))
)
(lambda (activity arg)
(activity-layout activity))
(lambda (activity arg) (list))
(lambda (activity arg)
(entity-set! (get-current 'individual '()))
(let ((individual (get-current 'individual '())))
(list
(update-widget 'edit-text (get-id "update-individual-name") 'text
(ktv-get individual "name"))
(update-widget 'spinner (get-id "update-individual-gender") 'selection
(if (equal? (ktv-get individual "gender") "Female") 0 1))
(update-widget 'edit-text (get-id "update-individual-litter-code") 'text
(ktv-get individual "litter-code"))
(update-widget 'edit-text (get-id "update-individual-chip-code") 'text
(ktv-get individual "chip-code")))
))
(lambda (activity) '())
(lambda (activity) '())
(lambda (activity) '())
......@@ -1440,7 +1469,7 @@
(text-view (make-id "sync-title") "Sync database" 40 fillwrap)
(mtext "sync-dirty" "...")
(horiz
(mbutton "sync-connect" "Connect"
(mbutton2 "sync-connect" "Connect"
(lambda ()
(list
(network-connect
......@@ -1449,7 +1478,7 @@
(lambda (state)
(list
(update-widget 'text-view (get-id "sync-connect") 'text state)))))))
(mbutton "sync-sync" "Push"
(mbutton2 "sync-sync" "Push"
(lambda ()
(let ((r (append
(spit-dirty db "sync")
......@@ -1457,7 +1486,7 @@
(cons (if (> (length r) 0)
(toast "Uploading data...")
(toast "No data changed to upload")) r))))
(mbutton "sync-pull" "Pull"
(mbutton2 "sync-pull" "Pull"
(lambda ()
(cons (toast "Downloading data...") (suck-new db "sync")))))
(text-view (make-id "sync-console") "..." 15 (layout 300 'wrap-content 1 'left 0))
......@@ -1471,7 +1500,10 @@
(msg (csv db "stream" e)))
entity-types)
'()))
(mbutton2 "sync-send" "Done" (lambda () (list (finish-activity 2))))))
(mbutton2 "sync-send" "Done" (lambda () (list (finish-activity 2)))))
)
(lambda (activity arg)
(activity-layout activity))
......
android/src/foam/mongoose/StarwispBuilder.java
View file @ e63ac83a
......@@ -344,6 +344,34 @@ public class StarwispBuilder
parent.addView(v);
}
if (type.equals("debug-text-view")) {
TextView v = new TextView(ctx);
// v.setBackgroundResource(R.color.black);
v.setId(arr.getInt(1));
v.setText(Html.fromHtml(arr.getString(2)));
// v.setTextColor(R.color.white);
v.setTextSize(arr.getInt(3));
v.setMovementMethod(LinkMovementMethod.getInstance());
v.setLayoutParams(BuildLayoutParams(arr.getJSONArray(4)));
if (arr.length()>5) {
if (arr.getString(5).equals("left")) {
v.setGravity(Gravity.LEFT);
} else {
if (arr.getString(5).equals("fill")) {
v.setGravity(Gravity.FILL);
} else {
v.setGravity(Gravity.CENTER);
}
}
} else {
v.setGravity(Gravity.LEFT);
}
v.setTypeface(((StarwispActivity)ctx).m_Typeface);
parent.addView(v);
}
if (type.equals("web-view")) {
WebView v = new WebView(ctx);
v.setId(arr.getInt(1));
......@@ -1021,7 +1049,7 @@ public class StarwispBuilder
return;
}
if (type.equals("text-view")) {
if (type.equals("text-view") || type.equals("debug-text-view")) {
Log.i("starwisp","text-view...");
TextView v = (TextView)vv;
if (token.equals("text")) {
......
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