;; virtual-pet.ss -- a toy program for responsible children

;; John David Stone
;; Department of Mathematics and Computer Science
;; Grinnell College
;; stone@math.grin.edu

;; created December 9, 1997
;; last revised December 9, 1997

;; This program consists of procedure definitions that allow the user to
;; create her own virtual pet, play with it, and take care of its various
;; physical and emotional needs.  The program is written in an
;; object-oriented style; the virtual pet and the other entities that it
;; interacts with (apart from the user of the program) are all implemented
;; as objects.

;; Time in the virtual pet's world is not defined directly in terms of
;; real-world time, but is instead measured by the ticking of a virtual
;; clock.  This clock is implemented as a counter object, initialized to
;; zero when it is created and incremented every time it receives the
;; message TICK!.  The current age of the universe (that is, the number of
;; TICK! messages that the clock has received) can be recovered by sending
;; the message TELL-TIME to the clock.

;; The clock also maintains a list of all the objects in the virtual pet's
;; world and sends a GROW-OLDER! message to each one of them every time it
;; ticks.  The constructor for an object must send a REGISTER!  message to
;; the clock so that the object it constructs can be put on this list.
;; In this initial implementation, the virtual pet itself is the only
;; such object.

;; At every 128th tick, a cuckoo emerges from the clock to report
;; the current age of the universe (by printing it to standard output).

(define clock
  (let ((age-of-universe 0)
        (transient-objects '()))
    (lambda (message . arguments)
      (cond

       ((eq? message 'tick!)
        (let ((ticks (if (null? arguments) 1 (car arguments))))
          (if (not (and (integer? ticks)
                        (positive? ticks)))
              (error 'clock
                     (string-append "TICK! method: "
                                    "The argument must be a positive "
                                    "integer")))
          (do ((remaining ticks (- remaining 1)))
              ((zero? remaining))
            (set! age-of-universe (+ age-of-universe 1))
            (if (zero? (modulo age-of-universe 128))
                (write-line "Cuck-oo!  The time is exactly "
                            age-of-universe))
            (for-each (lambda (transient-object)
                        (transient-object 'grow-older!))
                      transient-objects))))
       
       ((eq? message 'tell-time) age-of-universe)
       
       ((eq? message 'register!)
        (if (null? arguments)
            (error 'clock
                   (string-append "REGISTER! method: "
                                  "An argument is required"))
            (set! transient-objects
                  (cons (car arguments) transient-objects))))
       
       (else (error 'clock "unrecognized message"))))))

;; The WRITE-LINE procedure writes each of its arguments to standard output
;; and terminates the line with a newline character.

(define write-line
  (lambda arguments
    (for-each display arguments)
    (newline)))

;; To obtain a virtual pet, the user should invoke the following procedure
;; (and bind the result to an identifier).

(define create-registered-virtual-pet
  (lambda ()
    (let ((pet (make-virtual-pet)))
      (clock 'register! pet)
      pet)))

;; Here is the definition of the actual constructor for a virtual pet.

(define make-virtual-pet

  ;; We begin by defining some constants that are the same for every
  ;; virtual pet, all measured in clock ticks.

  (let ((duration-of-illnesses 1024)
          ;; When the virtual pet gets sick, the illness lasts for a
          ;; this many clock ticks.
        (effective-period-of-medication 4096)
          ;; It can, however, be treated with medication, which is
          ;; effective for this many clock ticks.
        (maximum-time-without-meal 384)
        (maximum-time-without-drink 384)
        (maximum-time-without-rest 256))
          ;; The virtual pet needs to be fed, watered, and allowed to sleep
          ;; frequently.  If the specified number of clock ticks elapse
          ;; without the proper kind of treatment, the virtual pet dies.

    (lambda ()

      ;; Here are the fields of the virtual pet object.

      (let ((birth-time (clock 'tell-time)))
        (let ((life-expectancy 1048576)
              (alive #t)
                ;; The ``normal life expectancy'' of the virtual pet is
                ;; the specified number of ticks.  (This life expectancy
                ;; can be reduced by disease and is, in any case, not
                ;; guaranteed if the virtual pet is mistreated.

              (hunger 0.5)
              (time-of-last-meal birth-time)
              
              (thirst 0.5)
              (time-of-last-drink birth-time)
              
              (fatigue 0.8)
              (time-of-last-exercise birth-time)
              
              (sleepiness 0.2)
              (time-of-last-rest birth-time)
              (awake #t)
              
              (happiness 0.5)
              
              (health (+ 0.5 (random 0.5)))
              (time-of-last-illness birth-time)
              (time-of-last-medication birth-time)
              (vaccinated #f))
                 ;; The health of the virtual pet is quite variable.  The
                 ;; probability of disease can be greatly reduced by
                 ;; vaccinating the pet.
          
          (lambda (message . arguments)

            ;; A virtual pet responds to messages only if it is still alive.

            (if alive
                (let ((current-time (clock 'tell-time)))

                  (cond

                   ;; Here are the messages to which the virtual pet
                   ;; responds.

                   ;; The STATUS message causes a summary of the virtual
                   ;; pet's more visible traits to be exhibited.

                   ((eq? message 'status)
                    (write-line "         Hunger: " hunger)
                    (write-line "         Thirst: " thirst)
                    (write-line "        Fatigue: " fatigue)
                    (write-line "     Sleepiness: " sleepiness)
                    (write-line "      Happiness: " happiness)
                    (write-line "         Health: " health)
                    (clock 'tick! 1))

                   ;; The FEED message usually causes the virtual pet
                   ;; to eat a meal.

                   ((eq? message 'feed)

                    ;; The virtual pet wakes up to be fed if it is hungry
                    ;; enough.

                    (if (and (not awake)
                             (< 0.7 hunger))
                        (begin
                          (set! time-of-last-rest current-time)
                          (set! awake #t)))

                    ;; The virtual pet now eats if it is awake, at least a
                    ;; little hungry, not too tired, and not too sleepy.

                    (cond ((not awake)
                           (write-line "Z-z-z-z-z!"))
                          ((< hunger 0.3)
                           (write-line "I'm not hungry yet."))
                          ((and (< 0.8 fatigue)
                                (< hunger 0.5))
                           (write-line "I'm too tired to eat."))
                          ((and (< 0.8 sleepiness)
                                (< hunger 0.5))
                           (write-line "I'm too sleepy to eat."))
                          (else
                           (if (< 0.6 hunger)
                               (write-line "Yum!"))
                           (set! happiness
                                 (min 1.0 (+ happiness
                                             (/ hunger 2))))
                           (set! hunger (max 0.0 (- hunger 0.8)))
                           (set! time-of-last-meal current-time)))
                    (clock 'tick! 16))
                   
                   ;; The WATER message usually causes the virtual pet to
                   ;; take a drink.

                   ((eq? message 'water)
                    
                    ;; Write a plausible method describing the
                    ;; effects of watering the pet.
                    
                    )

                   ;; The PLAY message usually causes the virtual pet to
                   ;; run around happily and to bond with the user.

                   ((eq? message 'play)

                    ;; The virtual pet will not play if it is asleep, too
                    ;; hungry, too thirsty, too tired, too sleepy, or too
                    ;; sick.

                    (cond ((not awake)
                           (write-line "Z-z-z-z-z!"))
                          ((< 0.8 hunger)
                           (write-line "I'm too hungry to play."))
                          ((< 0.8 thirst)
                           (write-line "I'm to thirsty to play."))
                          ((< 0.8 fatigue)
                           (write-line "I'm too tired to play."))
                          ((< 0.8 sleepiness)
                           (write-line "I'm too sleepy to play."))
                          ((< health 0.2)
                           (write-line "Grrr!  Go away!"))
                          ((< health 0.4)
                           (write-line
                            "I don't feel well enough to play."))
                          (else

                           ;; Playing makes the virtual pet hungrier,
                           ;; thirstier, tireder, happier, and (if it is
                           ;; not too tired) healthier.

                           (set! hunger (min 1.0 (+ hunger 0.1)))
                           
                           ;; Uncomment the following line when the WATER
                           ;; method has been written.
                           ;; (set! thirst (min 1.0 (+ thirst 0.2)))
                           
                           (set! fatigue (min 1.0 (+ fatigue 0.1)))
                           (set! happiness
                                 (min 1.0 (+ happiness
                                             (/ (- current-time
                                                   time-of-last-exercise)
                                                128))))
                           (if (< fatigue 0.5)
                               (set! health (+ 0.1
                                               (* 0.9 health))))
                           (set! time-of-last-exercise current-time)))
                    (clock 'tick! 16))

                   ;; The LET-SLEEP message usually causes the virtual
                   ;; pet to fall asleep, if it is tired or sleepy enough,
                   ;; or to continue to sleep.

                   ((eq? message 'let-sleep)
                    (if awake
                        (if (and (< fatigue 0.5)
                                 (< sleepiness 0.4))
                            (write-line "I'm not sleepy!")
                            (set! awake #f)))
                    (clock 'tick! 32))

                   ;; The VACCINATE message causes the virtual pet to be
                   ;; protected against most diseases.

                   ((eq? message 'vaccinate)

                    ;; Wake the virtual pet up, if it isn't awake already.

                    (if (not awake)
                        (begin
                          (set! time-of-last-rest current-time)
                          (set! awake #t)))

                    ;; The virtual pet complains about being vaccinated
                    ;; more than once.

                    (if vaccinated
                        (write-line "I've already had that shot!")
                        (set! vaccinated #t))

                    (write-line "Ouch!")

                    ;; The virtual pet is unhappy after being vaccinated,
                    ;; and it also adversely affects its health in the
                    ;; short run.

                    (set! happiness (* happiness 0.4))
                    (set! health (* health 0.9))
                    (clock 'tick! 16))


                   ;; The MEDICATE message causes the virtual pet to take
                   ;; its medicine.

                   ((eq? message 'medicate)

                    ;; It must be awake in order to take the medicine.

                    (if (not awake)
                        (begin
                          (set! time-of-last-rest current-time)
                          (set! awake #t)))

                    (cond ((or (< 0.7 health)
                               (< duration-of-illnesses
                                  (- current-time
                                     time-of-last-illness)))

                           ;; It complains about unnecessary medication,
                           ;; which does not improve its health.

                           (write-line "Pfui!  I'm not sick!")
                           (set! health (* health 0.95)))

                          ((< effective-period-of-medication
                              (- current-time time-of-last-medication))
                           (set! health (* health 0.98)))

                          (else
                           (set! health (min 1.0 (* health 2)))))

                    (write-line "Yuck!")
                    (set! time-of-last-medication current-time)
                    (clock 'tick! 16))

                   ;; Only the clock should send the GROW-OLDER! message to
                   ;; the virtual pet.

                   ((eq? message 'grow-older!)
                    (if (or (< maximum-time-without-meal
                               (- current-time time-of-last-meal))
                            (< maximum-time-without-drink
                               (- current-time time-of-last-drink))
                            (< maximum-time-without-rest
                               (- current-time time-of-last-rest))
                            (zero? health)
                            (= life-expectancy 
                               (- current-time birth-time)))
                        (begin
                          (write-line "Farewell!")
                          (write-line "*   *   *   *   *   *   *")
                          (set! alive #f))
                        (begin
                          ;; Update all the attributes to reflect the
                          ;; passage of time.

                          ;; Hunger:

                          (set! hunger (min 1.0 (+ hunger 0.005)))
                          (if (and awake (< 0.8 hunger))
                              (write-line "I'm hungry!"))


                          ;; Thirst: 
                          ;; Uncomment the following line when the WATER
                          ;; method has been written.
                          ;; (set! thirst (min 1.0 (+ thirst 0.005)))

                          (if (and awake (< 0.8 thirst))
                              (write-line "I'm thirsty!"))

                          ;; Fatigue:

                          (set! fatigue
                                (if awake
                                    (min 1.0 (+ fatigue 0.005))
                                    (max 0.0 (- fatigue 0.01))))
                          (if (and awake (< 0.8 fatigue))
                              (write-line "I'm tired!"))

                          ;; Sleepiness:

                          (set! sleepiness
                                (if awake
                                    (min 1.0 (+ sleepiness 0.008))
                                    (max 0.0 (- sleepiness 0.012))))
                          (if (and awake (< 0.8 sleepiness))
                              (write-line "I'm sleepy!"))

                          ;; Health:

                          (let ((gets-sick (if vaccinated
                                               (zero? (random 16384))
                                               (zero? (random 1024)))))
                            (if gets-sick
                                (begin
                                  (if awake
                                      (write-line "I don't feel well."))
                                  (set! life-expectancy
                                        (- life-expectancy 128))
                                  (set! health (/ health 2))
                                  (set! fatigue
                                        (min 1.0 (+ fatigue 0.4)))
                                  (set! sleepiness
                                        (min 1.0 (+ sleepiness 0.5))))))
                          (set! health
                                (max 0.0
                                     (- health (* hunger 0.0002)
                                        (* thirst 0.0002)
                                        (* fatigue 0.0001)
                                        (* sleepiness 0.0001)
                                        (* happiness -0.0004))))

                          ;; Awake:

                          (if awake
                              (if (or (< 0.9 fatigue)
                                      (< 0.9 sleepiness))
                                  (set! awake #f))
                              (if (and (< fatigue 0.1)
                                       (< sleepiness 0.1))
                                  (begin
                                    (set! time-of-last-rest
                                          current-time)
                                    (set! awake #t)))))))
                   
                   (else (error 'virtual-pet
                                "unrecognized message")))))))))))