;;; File:
;;;   compound.ss
;;; Version:
;;;   1.1
;;; 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!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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).

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

;;; When we determine whether a real number actually represents a
;;; temperature in degrees Celsius, we'll need to compare it to the number
;;; that represents absolute zero on the Celsius scale.

(define absolute-zero -273.15)

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

;;; We'll use one particular list containing just the symbol 'COMPOUND as a
;;; difficult-to-forge mark of the compound type.  Why is this 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

;;; The constructor for a compound checks assembles a vector from the
;;; field values it is given, storing the type mark at the beginning.  It
;;; 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

;;; 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)))

;;; 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)
                 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))))