(use goo)
(use goo/runtime)
(use time/threads)
(use cols/pipe)
(use samurui/samurui)
(use samurui/graph)
(use nest/motes/motes)
(use nest/comm/motecomm)
(use samurui/gtkbinding)
(dv *gradient-fudge-factor* 1.0)
(dc <nest-demo-app> (<any>))
(iprop <nest-demo-app> motes <mote-ensemble> "Motes")
(iaction <nest-demo-app> app-base-grad app "Emit Base Grad"
(do (fun (id)
(def sm (new <server-message>))
(msg out "Asking mote %= to emit base-station gradient\n" id)
(set (target-mote-id sm) id)
(set (action-id sm) *server-message-emit-gradient*)
(set (param1 sm) 0) (add! *messages-to-send* (process-server-message sm))
)
*motes-directly-heard*)
)
(iaction <nest-demo-app> app-clear-grads app "Reset Grads"
(def sm (new <server-message>))
(set (target-mote-id sm) #xffff) (set (action-id sm) *server-message-reset-gradients*)
(set (param0 sm) 1)
(set (param1 sm) 1)
(set (param2 sm) 1)
(set (param3 sm) 1)
(write-message-to-default (process-server-message sm))
)
(dv *show-locs* #f)
(iaction <nest-demo-app> app-show-locs app "Show Locs"
(set *show-locs* (not *show-locs*))
(if *show-locs*
(graph-control-add-post-draw (ensemble-graph (motes app)) draw-line-to-thought)
(graph-control-remove-post-draw (ensemble-graph (motes app)) draw-line-to-thought))
)
(dm mote-dist (ma|<mote> mb|<mote> => <flo>)
(def dx (- (mote-actual-x mb) (mote-actual-x ma)))
(def dy (- (mote-actual-y mb) (mote-actual-y ma)))
(sqrt (+ (* dx dx) (* dy dy)))
)
(iaction <nest-demo-app> app-calc-locs app "Calc Locs"
(update-mote-positions (motes app))
(msg out "Updated mote positions...\n")
(def me (motes app))
(def source-a (find-mote-with-grad-val me 1))
(def source-b (find-mote-with-grad-val me 2))
(def source-c (find-mote-with-grad-val me 3))
(def scale-a (/ (+ (/ (mote-dist source-b source-a)
(elt (mote-grads source-b) 1))
(/ (mote-dist source-c source-a)
(elt (mote-grads source-c) 1)))
2))
(def scale-b (/ (+ (/ (mote-dist source-c source-b)
(elt (mote-grads source-c) 2))
(/ (mote-dist source-a source-b)
(elt (mote-grads source-a) 2)))
2))
(def scale-c (/ (+ (/ (mote-dist source-a source-c)
(elt (mote-grads source-a) 3))
(/ (mote-dist source-b source-c)
(elt (mote-grads source-b) 3)))
2))
(msg out "Scale factors calculated...\n")
(do (fun (mote)
(if (or (or (== mote source-a)
(== mote source-b))
(== mote source-c))
(seq
(set (mote-thought-x mote) (mote-actual-x mote))
(set (mote-thought-y mote) (mote-actual-y mote))
)
(seq
(def c1 (circle (mote-actual-x source-a)
(mote-actual-y source-a)
(* scale-a (elt (mote-grads mote) 1))))
(def c2 (circle (mote-actual-x source-b)
(mote-actual-y source-b)
(* scale-b (elt (mote-grads mote) 2))))
(def c3 (circle (mote-actual-x source-c)
(mote-actual-y source-c)
(* scale-c (elt (mote-grads mote) 3))))
(def l1 (intersect c1 c2))
(def intersection-points (intersect c3 l1))
(if (empty? intersection-points)
(msg out "No intersection points on mote id: %=\n" (mote-id mote))
(seq
(def p-closest (elt intersection-points 0))
(when (> (len intersection-points) 1)
(if (< (+ (+ (sqdist (elt intersection-points 1)
(circle-p c1))
(sqdist (elt intersection-points 1)
(circle-p c2)))
(sqdist (elt intersection-points 1)
(circle-p c3)))
(+ (+ (sqdist p-closest
(circle-p c1))
(sqdist p-closest
(circle-p c2)))
(sqdist p-closest
(circle-p c3))))
(set p-closest (elt intersection-points 1)))
)
(set (mote-thought-x mote) (point-x p-closest))
(set (mote-thought-y mote) (point-y p-closest))
)
)
)
)
)
(motes (motes app))
)
(msg out "Locations estimated.\n")
)
(iaction <nest-demo-app> app-reset-info app "Reset Info"
(do (fun (x)
(add! *motes-to-call* x)
)
*motes-heard-from*)
(set *motes-heard-from* (fab <tab> 0))
)
(iaction <nest-demo-app> app-reset-neighbors app "Reset Neighbors"
(set *motes-directly-heard* (fab <tab> 0))
)
(iaction <nest-demo-app> app-reset-graph app "!!Reset Graph!!"
(set *motes-heard-from* (fab <tab> 0))
(set *motes-to-call* (vec))
(graph-control-clear-graph (ensemble-graph (motes app)))
(set (motes (motes app)) (fab <tab> 0))
)
(iaction <nest-demo-app> app-reset-edges app "!!Reset Edges!!"
(app-reset-info app)
(graph-control-clear-edges (ensemble-graph (motes app)))
(do (fun (mote)
(set (can-hear mote) (vec))
(set (heard-by mote) (vec))
)
(motes (motes app))
)
)
(iaction <nest-demo-app> app-boost-unique app "Boost Unique"
(set *server-unique-id* (+ *server-unique-id* 1000))
)
(iaction <nest-demo-app> app-all-leds-on app "All LEDs On"
(def sm (new <server-message>))
(msg out "Sending LEDs ON to ALL\n")
(set (target-mote-id sm) #xffff)
(set (action-id sm) *server-message-control-leds*)
(set (param1 sm) 1)
(set (param2 sm) 1)
(set (param3 sm) 1)
(write-message-to-default (process-server-message sm))
)
(dv *anim-enabled* #t)
(iaction <nest-demo-app> app-toggle-anim app "Toggle Anim"
(set *anim-enabled* (not *anim-enabled*))
(graph-control-enable-anim (ensemble-graph (motes app)) *anim-enabled*)
)
(imodel <nest-demo-app>
(attr motes fill)
(columns
app-boost-unique
app-clear-grads
app-calc-locs
app-show-locs
app-reset-info
app-reset-edges
app-reset-graph
app-all-leds-on
app-toggle-anim
)
)
(dv *nest-demo-app* (new <nest-demo-app>))
(set (motes *nest-demo-app*) (new <mote-ensemble>))
(dv *motes-directly-heard* (fab <tab> 0))
(dv *motes-heard-from* (fab <tab> 0))
(dv *motes-to-call* (vec))
(dv *messages-to-send* (vec))
(dm possibly-inquire-about (id|<int>)
(unless (elt-or *motes-heard-from* id #f)
(add! *motes-to-call* id)
)
)
(dm possibly-inquire-about (ids|<col>)
(do possibly-inquire-about ids)
)
(dm gimme-mote-to-call ()
(if (empty? *motes-to-call*)
#f
(seq
(def mote-to-call (1st *motes-to-call*))
(set *motes-to-call* (del-vals *motes-to-call* mote-to-call))
(add! *motes-to-call* mote-to-call)
mote-to-call
)
)
)
(dm heard-from-mote (id|<int>)
(set (elt *motes-heard-from* id) id)
(set *motes-to-call* (del-vals *motes-to-call* id))
)
(dv *probe-every* 8)
(dv probe-tick 0)
(df tick-poll-pipe (da-pipe)
(while (> (len da-pipe) 0)
(def da-msg (dequeue! da-pipe))
(case (handler-id da-msg)
((*climb-message-id*)
(def cm (process-climb-message da-msg))
(def m (get-mote-by-id (motes *nest-demo-app*) (source cm)))
(msg out "Got climb-message from mote %d\n" (mote-id m))
(msg out " He can hear: %= and has radio power: %=\n" (msg-can-hear cm) (radio-power cm))
(mote-can-hear-ids (motes *nest-demo-app*) m (msg-can-hear cm))
(heard-from-mote (source cm))
(possibly-inquire-about (msg-can-hear cm))
(set (mote-radio-power m) (radio-power cm))
(set (mote-light-status m) (light-status cm))
(set (mote-grads m) (grad-dists cm))
)
((*hear-report-message-id*)
(def hm (process-hear-report-message da-msg))
(mote-id-can-hear-ids (motes *nest-demo-app*) (source hm) (heard hm))
(set (elt *motes-directly-heard* (source hm)) (source hm))
(possibly-inquire-about (source hm))
(possibly-inquire-about (heard hm))
)
)
)
(incf probe-tick)
(when (== probe-tick *probe-every*)
(set probe-tick 0)
(if (empty? *messages-to-send*)
(seq
(def mote-to-call (gimme-mote-to-call))
(when mote-to-call
(def sm (new <server-message>))
(msg out "Asking mote %= for A/S/L\n" mote-to-call)
(set (target-mote-id sm) mote-to-call)
(set (action-id sm) *server-message-status*)
(write-message-to-default (process-server-message sm))
)
)
(seq
(def message-to-send (1st *messages-to-send*))
(set *messages-to-send* (del! *messages-to-send* 0))
(write-message-to-default message-to-send)
)
)
)
)
(dv *incoming-event-pipe* (fab <pipe> 0))
(gtk_timeout_add 200
(gtk_getGtkFunctionCallback)
(goo_createCallback tick-poll-pipe *incoming-event-pipe*))
(spawn
(def my-mcc (init-mote-comm))
(read-message-loop my-mcc (fun (da-msg)
(enqueue! *incoming-event-pipe* da-msg)
)
)
)
(gtk_init_easy)
(present *nest-demo-app*)
(gtk_main)