#lang scheme/gui

(require (planet williams/simulation/simulation-with-graphics))
(require (planet williams/science/random-distributions))
(require mrlib/bitmap-label)

;;; Simulation parameters
(define mode 'open-loop)
(define n-attendants 2)
(define customer-interarrival-time 4.0)
(define attendant-minimum-service-time 2.0)
(define attendant-maximum-service-time 10.0)

;;; Simulation model
(define attendant #f)

(define (generator n)
  (do ((i 0 (+ i 1)))
      ((= i n) (void))
    (wait (random-exponential customer-interarrival-time))
    (schedule now (customer i))))

(define-process (customer i)
  (with-resource (attendant)
    (wait/work (random-flat attendant-minimum-service-time
                            attendant-maximum-service-time))))

(define (run-simulation n-runs n-customers-per-run)
  (parameterize
      ((current-output-port (open-output-text-editor text)))
;    (with-new-simulation-environment
     ;; Initialize graphics
     (begin-busy-cursor)
     (send run-button enable #f)
     (send gauge set-range n-runs)
     (send gauge set-value 0)
     (send text lock #f)
     ;; Execute simulation model
     (let ((k (make-variable 0)))         ; Used for progress gauge
       (monitor after (set-variable-value! k v)
                (send gauge set-value v))
       (case mode
         ((open-loop)
          ;; Open loop processing
          (let ((max-attendants (make-variable)))
            (tally (variable-statistics max-attendants))
            (tally (variable-history max-attendants))
            (do ((i 0 (+ i 1)))
                ((= i n-runs) (void))
              (with-new-simulation-environment
               (set! attendant (make-resource +inf.0))
               (schedule (at 0.0) (generator n-customers-per-run))
               (start-simulation)
               (set-variable-value!
                max-attendants
                (variable-maximum (resource-satisfied-variable-n attendant)))
               (send text erase)
               (printf "Open loop processing~n")
               (printf "Number of runs = ~a~n"
                       (variable-n max-attendants))
               (printf "Minimum maximum attendants = ~a~n"
                       (variable-minimum max-attendants))
               (printf "Maximum maximum attendants = ~a~n"
                       (variable-maximum max-attendants))
               (set-variable-value! k i)))
            (printf "Mean maximum attendants = ~a~n"
                    (variable-mean max-attendants))
            (printf "Variance maximum attendants = ~a~n"
                    (variable-variance max-attendants))
            (write-special
             (history-plot (variable-history max-attendants)
                           "Maximum Attendants"))
            (newline)))
         ((closed-loop)
          ;; Closed loop processing
          (let ((avg-queue-length (make-variable)))
            (tally (variable-statistics avg-queue-length))
            (tally (variable-history avg-queue-length))
            (do ((i 0 (+ i 1)))
                ((= i n-runs) (void))
              (with-new-simulation-environment
               (set! attendant (make-resource n-attendants))
               (schedule (at 0.0) (generator n-customers-per-run))
               (start-simulation)
               (set-variable-value!
                avg-queue-length
                (variable-mean (resource-queue-variable-n attendant)))
               (send text erase)
               (printf "Closed loop processing~n")
               (printf "Number of runs = ~a~n"
                       (variable-n avg-queue-length))
               (printf "Minimum average queue length = ~a~n"
                       (variable-minimum avg-queue-length))
               (printf "Maximum average queue length = ~a~n"
                       (variable-maximum avg-queue-length))
               (set-variable-value! k i)))
            (printf "Mean average queue length = ~a~n"
                    (variable-mean avg-queue-length))
            (printf "Variance average queue length = ~a~n"
                    (variable-variance avg-queue-length))
            (write-special
             (history-plot (variable-history avg-queue-length)
                           "Average Queue Length"))
            (newline))))
       (send text lock #t)
       (send run-button enable #t)
       (end-busy-cursor))))
;)

;; Simulation graphics
(define frame (instantiate frame% ("Open Loop/Closed Loop Analysis")))

(define menu-bar (instantiate menu-bar% (frame)))

(define file-menu (instantiate menu% ("&File" menu-bar)))

(define exit-menu-item (instantiate menu-item% ("E&xit" file-menu)
                         (callback (lambda (mi e)
                                     (exit)))))

(define edit-menu (instantiate menu% ("&Edit" menu-bar)))

(define options-menu-item
  (instantiate menu-item% ("Options..." edit-menu)
    (callback (lambda (mi e)
                (case mode
                  ((open-loop)
                   (send radio-box set-selection 0)
                   (send slider-3 enable #f))
                  ((closed-loop)
                   (send radio-box set-selection 1)
                   (send slider-3 enable #t)))
                (send slider-3 set-value n-attendants)
                (send text-field-1 set-value
                      (format "~a" customer-interarrival-time))
                (send text-field-2 set-value
                      (format "~a" attendant-minimum-service-time))
                (send text-field-3 set-value
                      (format "~a" attendant-maximum-service-time))
                (send dialog show #t)))))

(define panel-1 (instantiate horizontal-panel% (frame)
                  (alignment '(right center))))

(define run-button (instantiate button%
                     ((make-bitmap-label "Run" "run.png") panel-1)
                     (horiz-margin 4)
                     (callback (lambda (b e)
                                 (run-simulation (send slider-1 get-value)
                                                 (send slider-2 get-value))))))

(define stop-button (instantiate button%
                      ((make-bitmap-label "Stop" "break.png") panel-1)
                      (horiz-margin 4)
                      (callback (lambda (b e)
                                  (stop-simulation)))))

(define panel-2 (instantiate vertical-panel% (frame)
                  (style '(border))))

(define slider-1 (instantiate slider% ("Number of runs" 1 1000 panel-2)
                   (init-value 100)
                   (style '(horizontal vertical-label))))

(define slider-2 (instantiate slider% ("Number of customers per run" 1 1000 panel-2)
                   (init-value 500)
                   (style '(horizontal vertical-label))))

(define canvas (instantiate editor-canvas% (frame)
                 (min-width 500)
                 (min-height 450)
                 (style '(no-hscroll hide-vscroll))))

(define text (instantiate text% ()))

(send canvas set-editor text)
(send text lock #t)

(define gauge (instantiate gauge% ("Progress" 1 frame)))

(define dialog (instantiate dialog% ("Options" frame)))

(define group-box-panel-1 (instantiate group-box-panel% ("Mode" dialog)
                            (alignment '(left top))))

(define radio-box (instantiate radio-box%
                    (#f '("Open loop" "Closed loop") group-box-panel-1)
                    (style '(vertical vertical-label))
                    (callback (lambda (rb e)
                                (case (send rb get-selection)
                                  ((0)
                                   (send slider-3 enable #f))
                                  ((1)
                                   (send slider-3 enable #t)))))))

(define slider-3 (instantiate slider% ("Number of attendants" 1 100 dialog)
                   (init-value 2)
                   (style '(horizontal vertical-label))))

(define group-box-panel-2
  (instantiate group-box-panel% ("Customer" dialog)))

(define text-field-1
  (instantiate text-field% ("Interarrival time" group-box-panel-2)))

(define group-box-panel-3 (instantiate group-box-panel% ("Attendant" dialog)))

(define text-field-2
  (instantiate text-field% ("Minimum service time" group-box-panel-3)))

(define text-field-3
  (instantiate text-field% ("Maximum service time" group-box-panel-3)))

(define panel-3 (instantiate horizontal-panel% (dialog)
                (alignment '(center center))))

(define cancel-button (instantiate button% ("Cancel" panel-3)
                        (callback (lambda (b e)
                                    (send dialog show #f)))))

(define ok-button
  (instantiate button% ("Ok" panel-3)
    (callback (lambda (b e)
                (case (send radio-box get-selection)
                  ((0)
                   (set! mode 'open-loop))
                  ((1)
                   (set! mode 'closed-loop)
                   (set! n-attendants
                         (send slider-3 get-value))))
                (set! customer-interarrival-time
                      (string->number (send text-field-1 get-value)))
                (set! attendant-minimum-service-time
                      (string->number (send text-field-2 get-value)))
                (set! attendant-maximum-service-time
                      (string->number (send text-field-3 get-value)))
                (send dialog show #f)))))

(send frame show #t)