| | 329 | ;;; publish - subscribe on rectangles |
|---|
| | 330 | (defstruct rect-publisher |
|---|
| | 331 | subscribers) |
|---|
| | 332 | |
|---|
| | 333 | (setf (documentation 'make-rect-publisher 'function) |
|---|
| | 334 | "MAKE-RECT-PUBLISHER creates a new publisher object.") |
|---|
| | 335 | |
|---|
| | 336 | (defstruct rect-subscriber |
|---|
| | 337 | object rectangle callback-fn) |
|---|
| | 338 | |
|---|
| | 339 | (defun register-rect-subscriber (publisher subscriber rectangle callback-fn) |
|---|
| | 340 | "Register SUBSCRIBER with associated RECTANGLE and CALLBACK-FN with |
|---|
| | 341 | PUBLISHER, so that on changes in RECTANGLE, CALLBACK-FN will be called |
|---|
| | 342 | with SUBSCRIBER as the only arg." |
|---|
| | 343 | (push (make-rect-subscriber :object subscriber :rectangle (copy-list rectangle) :callback-fn callback-fn) |
|---|
| | 344 | (rect-publisher-subscribers publisher))) |
|---|
| | 345 | |
|---|
| | 346 | (defun publish-rect-change (publisher rectangle) |
|---|
| | 347 | "Tells PUBLISHER about changes in RECTANGLE. All subscribers whose |
|---|
| | 348 | own rectangle intersects with RECTANGLE will be notified." |
|---|
| | 349 | (dolist (subscriber (rect-publisher-subscribers publisher)) |
|---|
| | 350 | (when (rectangle-intersects-p rectangle (rect-subscriber-rectangle subscriber)) |
|---|
| | 351 | (funcall (rect-subscriber-callback-fn subscriber) (rect-subscriber-object subscriber))))) |
|---|
| | 352 | |
|---|
