(module cworld mzscheme
(require "structures.ss"
(lib "struct.ss")
(lib "plt-match.ss")
(lib "contract.ss"))
(define-struct cworld (world ops listeners))
(define (new-cworld an-initial-world)
(make-cworld an-initial-world '() '()))
(define (cworld-apply-op a-cworld an-op)
(let ([new-cworld (apply-primitive-op a-cworld an-op)])
(notify-all-listeners! new-cworld)
new-cworld))
(define (cworld-add-listener a-cworld a-listener)
(copy-struct cworld a-cworld
[cworld-listeners
(cons a-listener (cworld-listeners a-cworld))]))
(define (notify-all-listeners! a-cworld)
(for-each (lambda (a-listener)
(a-listener a-cworld))
(cworld-listeners a-cworld)))
(define-struct op ())
(define-struct (op:replace-world op) (world))
(define (apply-primitive-op a-cworld an-op)
(match an-op
[(struct op:replace-world (new-world))
(copy-struct cworld a-cworld
[cworld-world new-world]
[cworld-ops (cons an-op (cworld-ops a-cworld))])]))
(define listener/c (cworld? . -> . any))
(provide/contract
[struct cworld ([world World?]
[ops (listof op?)]
[listeners (listof listener/c)])]
[new-cworld (World? . -> . cworld?)]
[struct op ()]
[struct (op:replace-world op) ([world World?])]
[cworld-apply-op
(cworld? op? . -> . cworld?)]
[cworld-add-listener
(cworld? listener/c . -> . any)]))