Correctly (?) prune field-tables
This commit is contained in:
parent
3bc95aeaeb
commit
1e1fef6a6e
|
@ -97,8 +97,11 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Parameters. Many of these are *updated* during facet execution!
|
||||
|
||||
(define (empty-field-table)
|
||||
(hash))
|
||||
|
||||
;; Parameterof FieldTable
|
||||
(define current-field-table (make-parameter (hash)))
|
||||
(define current-field-table (make-parameter (empty-field-table)))
|
||||
|
||||
;; Parameterof ActorState
|
||||
(define current-actor-state (make-parameter #f))
|
||||
|
@ -547,12 +550,16 @@
|
|||
'()
|
||||
(seteqv)
|
||||
parent-fid)))
|
||||
(when parent-fid
|
||||
(update-facet! parent-fid (lambda (f)
|
||||
(and f
|
||||
(struct-copy facet f
|
||||
[children (set-add (facet-children f) fid)])))))
|
||||
(with-current-facet fid (current-field-table) #f
|
||||
(define starting-field-table
|
||||
(if parent-fid
|
||||
(match (lookup-facet parent-fid)
|
||||
[#f (current-field-table)] ;; TODO: Is this correct???
|
||||
[f
|
||||
(store-facet! parent-fid (struct-copy facet f
|
||||
[children (set-add (facet-children f) fid)]))
|
||||
(facet-field-table f)])
|
||||
(empty-field-table)))
|
||||
(with-current-facet fid starting-field-table #f
|
||||
(setup-proc)
|
||||
(update-facet! fid (lambda (f) (and f
|
||||
(struct-copy facet f
|
||||
|
|
|
@ -23,11 +23,6 @@
|
|||
(define (draggable-shape name orig-x orig-y image)
|
||||
(define (window-at x y) (window name x y 10 (seal image)))
|
||||
(define (mouse-left-event-type? t) (member t '("leave" "button-up")))
|
||||
;;
|
||||
;; N.B. Currently (9 July 2016), fields are not properly
|
||||
;; garbage-collected on tail-calls between states, as you pick up
|
||||
;; and put down shapes, you'll see their field-tables grow.
|
||||
;;
|
||||
(define (idle ticks0 x0 y0)
|
||||
(react (field [ticks ticks0] [x x0] [y y0])
|
||||
(assert (window-at (x) (y)) #:meta-level 1)
|
||||
|
|
Loading…
Reference in New Issue