#lang scheme/gui

;; CLASS
;; observable%
;; SUPERCLASS
;; object%
;; PURPOSE
;; All of our models should be observable. This means 
;; that we don't want to write the code that manages
;; adding and updating observers ourselves to every class.
;; So, by writing this base class, all model%s can inherit
;; the functionality instead of re-implementing it.
(define observable%
  (class object% 
    ;; Initially, no one is observed.
    (define observers (list))
    
    ;; How others add themselves to the observer.
    (define/public (add-observer o)
      (set! observers (cons o observers)))
    
    ;; When this method is invoked, everyone who is
    ;; observing us is told.
    (define/public (notify-observers)
      (for-each 
       (lambda (o) (send o update)) ;; <- this is why every view
       observers))                  ;;     must have an 'update'
    ;;     method.
    (super-new)))


;; CLASS
;; model%
;; SUPERCLASS
;; observable%
;; PURPOSE
;; The model is just the data. It does not contain any
;; representation of the data (a GUI, printing, etc.), but
;; instead contains:
;;  - fields to store information
;;  - methods to modify that information
;;  - methods to get the information
;; That's it.
;;
;; Note, though, that whenever we modify the data in the model,
;; we need to notify all of the objects observing us of the change.
;; So, after any change to a field in the model, you should probably
;; update all the listeners.
(define model%
  (class observable%
    
    (inherit notify-observers add-observer)
    
    ;; ... I need a way to store the color
    (define red-value 0)
    ;; EXTEND
    ;; This is a good place to add new fields.
    
    ;; ... I need a way to change the color
    (define/public (set-red-value! some-value)
      (set! red-value some-value)
      ;; tell the view to update
      (notify-observers)
      )
    
    ;; EXTEND
    ;; This is a good place to add new setters
    
    ;; ... I need a way to get the color
    (define/public (get-red-value) red-value)
    
    ;; EXTEND
    ;; This is a good place to add new getters.
    
    (super-new)))

;; CLASS
;; view%
;; SUPERCLASS
;; object%
;; PURPOSE
;; This is a GUI view of the color model. It will handle
;; everything about presentation: creating a frame, creating
;; a canvas (to draw things on), and perhaps most importantly,
;; it MUST have an 'update' method. Why? Because when our model
;; decides to nofity all of the views that are observing it,
;; it is going to try and invoke the 'update' method.
;;
;; Note that we need to have a reference to the model 
;; so that we can ask it what values its fields have.
;; We get an update 'signal' from the model, and then 
;; it is up to the view to ask the model for particular
;; information that it might use for drawing/presenting itself.
(define view%
  (class object%
    
    (init-field (the-model 'none-yet))
    
    ;; I need to define/draw the GUI here.
    ;; EXTEND
    ;; You might need to change the frame width.
    (define view-frame (new frame%  
                            (label "The View")
                            (width 200) 
                            (height 230)
                            ))
    (define view-canvas
      (new canvas% (parent view-frame)))
    
    (define dc (send view-canvas get-dc))
    
    ;; I need an update method that will change
    ;; the view when the model tells me to.    
    ;;
    ;; As mentioned in class, this is mostly a lot of 
    ;; around-the-bend work just to change the background color
    ;; of the rectangle that we're drawing. We have to create
    ;; a brush of the right color, attach that brush to the DC,
    ;; and then when we draw the rectangle, it will be the correct
    ;; color.
    (define/public (update)
      (let* ([red-value (send the-model get-red-value)]
             ;; EXTEND
             ;; This is a good place for new let-bindings for
             ;; additional values that we retrieve from the model.
             [red-brush (make-object brush% 
                          (make-object color%
                            red-value 0 0)
                          'solid)]
             ;; EXTEND
             ;; This is a good place to bind some new brushes.

             )
        
        ;; Draw the red rectangle
        (send dc set-brush red-brush)
        (send dc draw-rounded-rectangle 10 10 180 180 8)
        
        ;; EXTEND
        ;; This is a good place to set the dc's brush to new
        ;; colors and draw other rectangles.
        
        ))
    
    ;; This happens once just to force a drawing of a rectangle.
    (update)
    ;; If we don't do this, we won't see the GUI.
    (send view-frame show #t)
    (super-new)))

;; CLASS
;; controller%
;; SUPERCLASS
;; object%
;; PURPOSE
;; The controller is ... well, can be anything.
;; In this case, it is a slider. When the slider's callback
;; function is called, it sends a message to the model to 
;; change the red value. The controller% does NOT update
;; the view! Instead, it just changes the model. It is up to the
;; model to then update its viewers, and it is up to the viewers
;; to ask the model for any values that may have changed.
;;
;; The whole reason that the controller% has a reference to
;; the model% is because it needs to be able to CHANGE the model.
;; Other than that, the controller has no idea what, if any,
;; views might be watching the model.
(define controller%
  (class object%
    ;; When we create a controller object, we will
    ;; need to give it a model to interact with.
    (init-field (the-model 'none-yet))
    
    ;; I need a callback that will tell the model
    ;;   to update based on how people wiggle the GUI bits.
    (define (red-callback slider-widget an-event)
      (let ([slider-value (send slider-widget get-value)])
        (send the-model set-red-value! slider-value)
        ))
    
    ;; EXTEND
    ;; This is a good place to write the other callbacks.
    
    ;; I need to draw the GUI
    (define frame (new frame% (label "Red Slider")))
    (define sliderR (new slider% 
                        (label "Red")
                        (parent frame)
                        (min-value 0)
                        (max-value 255)
                        (callback red-callback)
                        ))
    
    ;; EXTEND
    ;; This is a good place to put the other sliders.
    
    (send frame show #t)
    (super-new)))


;; CONTRACT
;; main : _ -> _
(define (main)
  (let* ([a-model (new model%)]
         [gui-view (new view% (the-model a-model))]
         [a-controller (new controller% (the-model a-model))])
    
    (send a-model add-observer gui-view)))

;; Run the code
(main)