;; -*- gauche -*-
(use srfi-1)

;; approach using Gauche's class system

;; base class
(define-class <base> () ())

(define-method initialize ((self <base>) initargs)
  (next-method)                         ; muoy importante...
  (print "initialize " self " with " initargs))


;; subject
(define-class <subject> (<base>)
  ((observers :init-value '())
   (counter :init-value 0 :accessor counter-of)))

(define-method do-something ((self <subject>))
  (print "do-something")
  ;(slot-set! self 'data (+ 1 (slot-ref self 'data)))
  ;(slot-set! self 'data (+ 1 (data self)))
  ;(set! (counter-of self) (+ 1 (counter-of self)))
  (inc! (counter-of self))
  (notify self))

(define-method attach ((self <subject>) (obs <base>))
  (slot-set! self 'observers
             (cons obs (slot-ref self 'observers))))

;; todo detach

(define-method notify ((self <subject>))
  (print "subject " self " will notify with " (counter-of self))
  (dolist (obs (slot-ref self 'observers))
    (update obs (counter-of self))))


;; observer
(define-class <observer> (<base>)
  ((name :init-keyword :name)))

(define-method update ((self <observer>) data)
  (format #t "observer ~s: new data ~s\n" (slot-ref self 'name) data))

(let ((subject (make <subject>))
      (observer-a (make <observer> :name 'aap))
      (observer-b (make <observer> :name 'noot)))
  (attach subject observer-a)
  (do-something subject)
  (attach subject observer-b)
  (do-something subject))

;; -----------------------------------------------------------------
;; classic closure approach
(define (make-subject)
  (let ((observers '())
        (data 0))
    (define (do-something)
      (inc! data)
      (notify))
    
    (define (attach subject)
      (push! observers subject))

    (define (detach subject)
      (delete! subject observers))

    (define (notify)
      (dolist (o observers)
        (o 'update data)))

    (lambda args
      (apply
       (case (car args)
         ((do-something) do-something)
         ((attach) attach)
         ((detach) detach)
         ((notify) notify)
         (else (print "subject: unknown method " (car args))))
       (cdr args)))))

(define (make-observer name)
  (let ((id name))
    (define (update data)
      (format #t "~s: update ~s\n" id data))

    (lambda args
      (apply
       (case (car args)
         ((update) update)
         (else (print "observer: unknown method " (car args))))
       (cdr args)))))

;; (let ((subject (make-subject))
;;       (observer-a (make-observer 'aap))
;;       (observer-b (make-observer 'noot)))
;;   (subject 'attach observer-a)
;;   (dotimes (i 2) (subject 'do-something))
;;   (subject 'attach observer-b)
;;   (dotimes (i 2) (subject 'do-something))
;;   (subject 'detach observer-a)
;;   (dotimes (i 2) (subject 'do-something)))