;;; File:
;;;   compound.ss
;;; Version:
;;;   1.1.1 of April 2001
;;; Purpose:
;;;   Define primitives for a record type that holds information
;;;   about the chemical and physical properties of inorganic compounds
;;;   (Sounds fascinating, doesn't it?)
;;; Authors:
;;;   John David Stone (original author)
;;;   Sam Rebelsky (updater)
;;; Contents:
;;;   Introductory Notes:
;;;   Constants:
;;;     absolute-zero: Lowest legal temperature
;;;   Utilities:
;;;     (produce-type-mark)
;;;       Create a hard-to-duplicate value to be used to mark
;;;       the type of the record.
;;;   Constructors:
;;;     (make-compound name formula molecular-weight 
;;;                    melting-point boiling-point color)
;;;       Make a new compound
;;;   Selectors:
;;;     (get-compound-name compound)
;;;     (get-compound-formula compound)
;;;     (get-compound-molecular-weight compound)
;;;     (get-compound-melting-point compound)
;;;     (get-compound-boiling-point compound)
;;;     (get-compound-color compound)
;;; History:
;;;   April 21, 2000 [JDS, v1.0]
;;;     Created
;;;   Monday, 27 November 2000 [SR, v1.1]
;;;     Updated some comments
;;;     Still have lots more to go!
;;;   Monday, 30 April 2001 [SR, v1.1.1]
;;;     Continued updating comments.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Notes

;;; An inorganic compound is usually identified either by its name (e.g.,
;;; ``gadolinium iodide'') or by its chemical formula (``GdI3'').  The
;;; properties that we'll keep track of are its molecular weight (in atomic
;;; units), its melting and boiling points (in degrees Celsius), and its
;;; color (represented by a Scheme symbol).

;;; Compounds are stored as vectors in which element 0 is a special
;;; value (the ``type mark'') which identifies the vector as something
;;; used to represent a compound.  The type mark is intentionally
;;; hard to reproduce.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Local Constants

;;; Name:
;;;   absolute-zero
;;; Type:
;;;   Real number
;;; Purpose:
;;;   To represent absolute zero in Celsius.  We can use this when
;;;   checking whether another number is a temperature.
(define absolute-zero -273.15)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Local Utilities

;;; Procedure:
;;;   produce-type-mark
;;; Parameters:
;;;   None
;;; Purpose:
;;;   To build a special identifier to mark this type.
;;; Produces:
;;;   type-mark, a type mark
;;; Preconditions:
;;;   None
;;; Postconditions:
;;;   type-mark will only be equivalent (eqv?) to itself.
;;; Note:
;;;   We'll use one particular list containing just the symbol 'compound 
;;;   as a difficult-to-forge mark of the compound type.  Why is this 
;;;   mark difficult to forge?  Because another (list 'compound) will 
;;;   use a different cons cell and therefore be different.
(define produce-type-mark
  (let ((type-mark (list 'compound)))
    (lambda () type-mark)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Constructors

;;; Procedure:
;;;   make-compound
;;; Parameters:
;;;   name, a string
;;;   formula, a string
;;;   molecular-weight, a positive real number
;;;   melting-point, a real number
;;;   boiling-point, a real number
;;;   color, a symbol
;;; Purpose:
;;;   Assembles a compound from the field values it is given.
;;; Produces:
;;;   compound, a compound
;;; Preconditions:
;;;   The type preconditions above must be met [Verified].
;;; Postconditions:
;;;   compound is a valid compound.
;;; Implementation Note:
;;;   Calls the mutator for each field so that an appropriate 
;;;   precondition test is performed on each of the given values. 
(define make-compound
  (lambda (name formula molecular-weight melting-point boiling-point color)
    (let ((result (make-vector 7)))
      (vector-set! result 0 (produce-type-mark))
      (set-compound-name! result name)
      (set-compound-formula! result formula)
      (set-compound-molecular-weight! result molecular-weight)
      (set-compound-melting-point! result melting-point)
      (set-compound-boiling-point! result boiling-point)
      (set-compound-color! result color)
      result)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Selectors


;;; Procedures:
;;;   get-compound-name
;;;   get-compound-formula
;;;   get-compound-molecular-weight
;;;   get-compound-melting-point
;;;   get-compound-boiling-point
;;;   get-compound-color
;;; Purpose:
;;;   Extract a field from a compound.
;;; Produces:
;;;   A name, formula, ..., or color.
;;;   Names and formulae are strings.
;;;   Molecular weights, melting points, and boiling points
;;;     are real numbers.
;;;   Colors are symbols.
;;; Preconditions:
;;;   Must be a valid compound created by make-compound. [Unverified]
;;; Postconditions:
;;;   Returns the specified field.
;;; Implementation note:
;;;   To select a field, call VECTOR-REF to pick it out of the 
;;;   correct position.

(define get-compound-name
  (lambda (c)
    (vector-ref c 1)))

(define get-compound-formula
  (lambda (c)
    (vector-ref c 2)))

(define get-compound-molecular-weight
  (lambda (c)
    (vector-ref c 3)))

(define get-compound-melting-point
  (lambda (c)
    (vector-ref c 4)))

(define get-compound-boiling-point
  (lambda (c)
    (vector-ref c 5)))

(define get-compound-color
  (lambda (c)
    (vector-ref c 6)))

;;; Procedures:
;;;   set-compound-name!
;;;   set-compound-formula!
;;;   set-compound-molecular-weight!
;;;   set-compound-melting-point!
;;;   set-compound-boiling-point!
;;;   set-compound-color!
;;; Parameters:
;;;   TO BE FINISHED!
;;; Implementation Note:
;;;   To modify a field, perform the appropriate precondition test 
;;;   on the field value and invoke VECTOR-SET! if it is met.

(define set-compound-name!
  (lambda (c name)
    (if (string? name)
        (vector-set! c 1 name)
        (error 'set-compound-name!
               "The name of a compound must be a string."))))

(define set-compound-formula!
  (lambda (c formula)
    (if (string? formula)
        (vector-set! c 2 formula)
        (error 'set-compound-formula!
               "The formula for a compound must be a string."))))

(define set-compound-molecular-weight!
  (lambda (c molecular-weight)
    (if (and (real? molecular-weight)
             (positive? molecular-weight))
        (vector-set! c 3 molecular-weight)
        (error 'set-compound-molecular-weight!
               "The molecular weight of a compound must be a positive real number."))))

(define set-compound-melting-point!
  (lambda (c melting-point)
    (if (and (real? melting-point)
             (< absolute-zero melting-point))
        (vector-set! c 4 melting-point)
        (error 'set-compound-melting-point!
               (string-append
                 "The melting point of a compound must be a real number greater than "
                 (number->string absolute-zero)
                 ".")))))

(define set-compound-boiling-point!
  (lambda (c boiling-point)
    (if (and (real? boiling-point)
             (< absolute-zero boiling-point))
        (vector-set! c 5 boiling-point)
        (error 'set-compound-boiling-point!
               (string-append
                 "The boiling point of a compound must be a real number greater than "
                 (number->string absolute-zero)
                 ".")))))

(define set-compound-color!
  (lambda (c color)
    (if (symbol? color)
        (vector-set! c 6 color)
        (error 'set-compound-color!
               "The color of a compound must be a Scheme symbol."))))

;;; The type predicate, COMPOUND?, checks to make sure that the given
;;; object is a vector of the appropriate length, with the type mark as its
;;; first element, containing values that meet the various preconditions.
(define compound?
  (lambda (something)
    (and (vector? something)
         (= (vector-length something) 7)
         (eq? (vector-ref something 0) (produce-type-mark))
         (string? (vector-ref something 1))
         (string? (vector-ref something 2))
         (real? (vector-ref something 3))
         (positive? (vector-ref something 3))
         (real? (vector-ref something 4))
         (<= absolute-zero (vector-ref something 4))
         (real? (vector-ref something 5))
         (<= absolute-zero (vector-ref something 5))
         (symbol? (vector-ref something 6)))))

;;; We determine whether two compounds are identical by making sure that
;;; corresponding fields are equal in the appropriate sense.

(define compound=?
  (lambda (left right)
    (and (string-ci=? (get-compound-name left) (get-compound-name right))
         (string=? (get-compound-formula left) (get-compound-formula right))
         (= (get-compound-molecular-weight left)
            (get-compound-molecular-weight right))
         (= (get-compound-melting-point left) 
            (get-compound-melting-point right))
         (= (get-compound-boiling-point left) 
            (get-compound-boiling-point right))
         (eq? (get-compound-color left) (get-compound-color right)))))

;;; The copier for compounds allocates a new vector and stores in it
;;; separately allocated copies of the string fields, transferring the
;;; values of the other fields without change.

(define compound-copy
  (lambda (original)
    (make-compound (string-copy (get-compound-name original))
                   (string-copy (get-compound-formula original))
                   (get-compound-molecular-weight original)
                   (get-compound-melting-point original)
                   (get-compound-boiling-point original)
                   (get-compound-color original))))

;;; The displayer for compounds displays the value of each field, prefixed
;;; with the name of the field, a colon and a space.  The fields are
;;; enclosed in parentheses, and a comma and a space separate adjacent
;;; fields.  The whole is prefixed with #compound to indicate the type.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Output

;;; The displayer expects a compound as its first argument and allows, but
;;; does not require, a second argument, which it expects to be an output
;;; port.  If the second argument is present, the compound is displayed
;;; through that port.  Otherwise, the current default output port is
;;; used.

(define compound-display
  (lambda (scribend . optional)
    (let ((out (if (null? optional) (current-output-port) (car optional))))
      (display "#compound(" out)
      (display "name" out)
      (display ": " out)
      (display (get-compound-name scribend) out)
      (newline out)
      (display "          " out)
      (display "formula" out)
      (display ": " out)
      (display (get-compound-formula scribend) out)
      (newline out)
      (display "          " out)
      (display "molecular-weight" out)
      (display ": " out)
      (display (get-compound-molecular-weight scribend) out)
      (newline out)
      (display "          " out)
      (display "melting-point" out)
      (display ": " out)
      (display (get-compound-melting-point scribend) out)
      (newline out)
      (display "          " out)
      (display "boiling-point" out)
      (display ": " out)
      (display (get-compound-boiling-point scribend) out)
      (newline out)
      (display "          " out)
      (display "color" out)
      (display ": " out)
      (display (get-compound-color scribend) out)
      (display ")" out)
      (newline out))))