(module picture-updater (lib "frtime.ss" "fta" "slideshow" "private" "frtime")
(require (as-is:unchecked mzscheme make-hash-table hash-table-get hash-table-put!))
(define master-table (make-hash-table))
(define (track-var! name val)
(hash-table-put! master-table name (new-cell val)))
(define (track-events! name)
(hash-table-put! master-table name (event-receiver)))
(define-syntax track-rel-var!
(syntax-rules ()
[(_ name (id ...) expr)
(begin
(hash-table-put! master-table name (new-cell
(let ([id (hash-table-get master-table 'id)] ...)
expr)))
(printf "~n~n relative var value: ~n~a~n~n" (let ([id (hash-table-get master-table 'id)] ...)
expr)))]))
(define (update-var! name val)
(set-cell! (hash-table-get master-table name) val))
(define (event-occur! name val)
(send-event (hash-table-get master-table name) val))
(define (call-when-change! name proc)
(proc (value-now (hash-table-get master-table name)))
(for-each-e! (changes (hash-table-get master-table name))
proc))
(define (call-on-event! name proc)
(for-each-e! (hash-table-get master-table name)
proc))
(define-syntax with-var
(syntax-rules ()
[(_ ([let-name var-name] ...) body0 body1 ...)
(let ([let-name (hash-table-get master-table var-name)] ...)
body0
body1 ...)]))
(define (get-value-now name)
(value-now/no-copy (hash-table-get master-table name)))
(define (get-behavior name)
(hash-table-get master-table name))
(define (get-events name)
(hash-table-get master-table name))
(provide track-var!
track-events!
update-var!
event-occur!
call-when-change!
call-on-event!
get-value-now
get-behavior
get-events
))