#lang racket/gui
;;; Racket Simulation Collection
;;; variable.rkt
;;; Copyright (c) 2008 M. Douglas Williams
;;;
;;; This file is part of the Racket Simulation Collection.
;;;
;;; The Racket Simulation Collection is free software: you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation, either version 3 of the License,
;;; or (at your option) any later version.
;;;
;;; The Racket Simulation Collection is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public License
;;; along with the Racket Simulation Collection.  If not, see
;;; <http://www.gnu.org/licenses/>.
;;;
;;; -----------------------------------------------------------------------------
;;;
;;; Version  Date      Description
;;; 1.0.0    11/28/08  Initial release.  (MDW)
;;; 4.0.0    08/18/10  Converted to Racket. (MDW)

(require "environment.rkt"
         "history-graphics.rkt")

(require (planet williams/science/math))

;;; (print-variable v (title #f)) -> void?
;;;   v : (or/c variable? false/c)
;;;   title : (or/c string? false/c) = #f
(define (print-variable v (title #f))
  (when (and (variable? v)
             (variable-statistics v)
             (> (variable-n v) 0))
    (when title
      (printf "~a~n" title))
    (when (variable-statistics v)
      (printf "n                  = ~a~n" (variable-n v))
      (printf "minimum            = ~a~n" (variable-minimum v))
      (printf "maximum            = ~a~n" (variable-maximum v))
      (printf "mean               = ~a~n" (variable-mean v))
      (printf "standard deviation = ~a~n" (variable-standard-deviation v))
      (when (and (variable-history v)
                 (finite? (variable-mean v))
                 (not (= (variable-minimum v) (variable-maximum v))))
        (printf "~a~n" (history-plot (variable-history v)))))
    (printf "~n")))

;;;
(define (print-variable-vector vec (title-vector #f))
  (for ((i (in-range (vector-length vec))))
    (let ((var (vector-ref vec i))
          (title (if title-vector
                     (vector-ref title-vector i)
                     #f)))
      (print-variable var title))))


;;; -----------------------------------------------------------------------------
;;;                               Variable Slider
;;; -----------------------------------------------------------------------------
;;; A variable slider is a slider that can automatically send its value to a
;;; simulation collection variable.  The class variable-slider% is a subclass of
;;; the MrEd slider% class and only works with integers in the range of -10000 to
;;; 10000.  The min and max values are set when the slider is created.

;;; variable-slider%
(define variable-slider%
  (class slider%
    ;; --------------------------------------------------------------------------
    ;;                            Initializations
    ;; --------------------------------------------------------------------------
    (init label)
    (init min-value)
    (init max-value)
    (init parent)
    (init ((variable-init variable) #f))
    (unless (or (variable? variable-init)
                (not variable-init))
      (error
       "initialization of variable-slider%: expected either a (simulation collection) variable or #f, given ~a"
       variable-init))
    ;; --------------------------------------------------------------------------
    ;;                          Inherited Methods
    ;; --------------------------------------------------------------------------
    (inherit get-value)
    ;; --------------------------------------------------------------------------
    ;;                          Private Variables
    ;; --------------------------------------------------------------------------
    (define variable #f)
    ;; --------------------------------------------------------------------------
    ;;                             Set Variable
    ;; --------------------------------------------------------------------------
    (define/public (set-variable v)
      (unless (or (not v)
                  (variable? v))
        (error 'set-variable
               "expect argument of either #f or type variable?, given ~a"
               v))
      (set! variable v)
      (when variable
        (set-variable-value! variable (get-value))))
    ;; --------------------------------------------------------------------------
    ;;                            Initialize Object
    ;; --------------------------------------------------------------------------
    (super-instantiate
        (label min-value max-value parent)
      ;; Callback will set the variable value
      (callback
       (lambda (slider event)
         (when variable
           (set-variable-value! variable (get-value))))))
    (set-variable variable-init)))

;;; -----------------------------------------------------------------------------
;;;                               Variable Gauge
;;; -----------------------------------------------------------------------------
;;; A variable gauge is a gauge that is automatically updated when the its assoc-
;;; iated variable, if any, is updated.
(define variable-gauge%
  (class gauge%
    ;; --------------------------------------------------------------------------
    ;;                            Initializations
    ;; --------------------------------------------------------------------------
    (init label)
    (init((range-init range)))
    (unless (or (and (integer? range-init)
                     (<= 1 range-init 10000))
                (and (variable? range-init)
                     (<= 1 (variable-value range-init) 10000)))
      (error
       "initialization of variable-gauge%: expected one of integer in the range 1 to 10000 or  a (simulation collection) variable whose value is an integer in the range 1 to 10000, given ~a"
       range-init))
    (init parent)
    (init ((variable-init variable) #f))
    (unless (or (variable? variable-init)
                (not variable-init))
      (error
       "initialization of variable-gauge%: expected either a (simulation collection) variable or #f, given ~a"
       variable-init))
    ;; --------------------------------------------------------------------------
    ;;                          Inherited Methods
    ;; --------------------------------------------------------------------------
    (inherit set-value)
    ;; --------------------------------------------------------------------------
    ;;                          Private Variables
    ;; --------------------------------------------------------------------------
    (define range
      (cond ((integer? range-init)
             range-init)
            ((variable? range-init)
             (variable-value range-init))))
    (define variable #f)
    (define range-monitor #f)
    (define value-monitor #f)
    ;; --------------------------------------------------------------------------
    ;;                              Set Range
    ;; --------------------------------------------------------------------------
    (define/override (set-range r)
      (unless (or (and (integer? r)
                       (<= 1 r 10000))
                  (and (variable? r)
                       (<= 1 (variable-value r) 10000)))
        (error 'set-variable
               "expected argument of one an integer in range 1 to 10000 or a (simulation collection) variable whose value is an integer in range 1 to 10000, given ~a"
               r))
      ;; Remove any existing range monitor
      (when range-monitor
        (variable-remove-set-monitor! range range-monitor)
        (set! range-monitor #f))
      ;; Set the local range variable
      (set! range r)
      ;; Set the parent range and set up the range variable monitor
      (cond ((integer? range)
             (super set-range range))
            ((variable? range)
             (super set-range (variable-value range))
             (set! range-monitor
                   (variable-add-set-monitor!
                    range 'after
                    (lambda (variable value)
                      (super set-range value)))))))
    ;; --------------------------------------------------------------------------
    ;;                             Set Variable
    ;; --------------------------------------------------------------------------
    (define/public (set-variable v)
      (unless (or (not v)
                  (variable? v))
        (error 'set-variable
               "expect argument of either #f or type variable?, given ~a"
               v))
      ;; Remove any existing value monitor
      (when value-monitor
        (variable-remove-set-monitor! variable value-monitor)
        (set! value-monitor #f))
      ;; Set the local variable variable
      (set! variable v)
      ;; Set the parent value and set up the value variable monitor
      (if variable
          (begin
            (if (variable-initialized? variable)
                (set-value (variable-value variable))
                (set-value 0))
            (set! value-monitor
                  (variable-add-set-monitor!
                   variable 'after
                   (lambda (variable value)
                     (if (variable-initialized? variable)
                         (set-value value)
                         (set-value 0))))))
          (set-value 0)))
    ;; --------------------------------------------------------------------------
    ;;                            Initialize Object
    ;; --------------------------------------------------------------------------
    (super-instantiate
        (label range parent))
    (set-range range-init)
    (set-variable variable-init)))

;;; -----------------------------------------------------------------------------
;;;                              Variable Message
;;; -----------------------------------------------------------------------------
(define variable-message%
  (class message%
    ;; --------------------------------------------------------------------------
    ;;                            Initializations
    ;; --------------------------------------------------------------------------
    (init label)
    (init parent)
    (init ((variable-init variable) #f))
    ;; --------------------------------------------------------------------------
    ;;                          Inherited Methods
    ;; --------------------------------------------------------------------------
    (inherit set-label)
    ;; --------------------------------------------------------------------------
    ;;                          Private Variables
    ;; --------------------------------------------------------------------------
    (define variable #f)
    (define value-monitor #f)
    ;; --------------------------------------------------------------------------
    ;;                             Set Variable
    ;; --------------------------------------------------------------------------
    (define/public (set-variable v)
      (when value-monitor
        (variable-remove-set-monitor! variable value-monitor)
        (set! value-monitor #f))
      (set! variable v)
      (when variable
        (set! value-monitor
              (variable-add-set-monitor!
               variable 'after
               (lambda (variable value)
                 (set-label (number->string value)))))))
    ;; --------------------------------------------------------------------------
    ;;                            Initialize Object
    ;; --------------------------------------------------------------------------
    (super-instantiate
        ((if (and (variable? variable-init)
                  (variable-initialized? variable-init))
             (number->string (variable-value variable-init))
             "")
         parent))
    (set-variable variable-init)))

(define variable-text-field%
  (class text-field%
    (init label)
    (init parent)
    (init ((variable-init variable) #f))
    (inherit set-value)
    (define variable #f)
    (define value-monitor #f)
    (define/public (set-variable v)
      (when value-monitor
        (variable-remove-set-monitor! variable value-monitor)
        (set! value-monitor #f))
      (set! variable v)
      (when variable
        (set! value-monitor
              (variable-add-set-monitor!
               variable 'after
               (lambda (variable value)
                 (set-value (number->string value)))))))
    (super-instantiate
        (label parent))
    (set-variable variable-init)))

(define variable-monitor%
  (class horizontal-panel%
    (init label)
    (init parent)
    (init ((variable-init variable) #f))
    (super-instantiate
     (parent))
    (define label-message
      (instantiate message%
        (label this)))
    (define value-message
      (instantiate message%
        ((if (and (variable? variable-init)
                  (variable-initialized? variable-init))
             (number->string (variable-value variable-init))
             "")
         this)
        (stretchable-width #t)))
    (define variable #f)
    (define value-monitor #f)
    (define/public (set-variable v)
      (when value-monitor
        (variable-remove-set-monitor! variable value-monitor)
        (set! value-monitor #f))
      (set! variable v)
      (when variable
        (set! value-monitor
              (variable-add-set-monitor!
               variable 'after
               (lambda (variable value)
                 (send value-message
                       set-label (number->string value)))))))
    (set-variable variable-init)))

;;; Module Contracts

(provide (all-defined-out))