;;; vivek-text.ss
;;;   Textual UI for Vivek's "Love Your Body" Dating Service
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   1.1 of October 2000
;;; Contents:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Library files

;;; This library contains our database of prospective clients.  
;;; It defines the variable "datees".
(load "datees.ss")

;;; This library contains utility procedures that are helpful
;;; for getting input
(load "input.ss")

;;; All the cool utilities for Vivek.
(load "vivek.ss")

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

;;; Display information about a person.  Useful for the interactive
;;; version of the dating game.  Also used for testing.
;;; Parameters:
;;;   A person (a datee) in the standard format.  See datees.ss
;;;   for more information.
;;; Preconditions:
;;;   The person is in the appropriate format.
;;; Postconditions:
;;;   Displays the person in a helpful way.
;;; Returns:
;;;   The same person.
;;; Note:
;;;   Still needs some work.  Does not display desires.
(define display-person
  (lambda (person)
    (let ((fullname (get-datee-full-name person))
          (gender (get-datee-gender person))
          (dates (get-datee-prefers person))
          (age (get-datee-age person))
          (characteristics (get-datee-characteristics person))
          (likes (get-datee-likes person))
          (desires (get-datee-desires person)))
      ; Display the basic information.
      (display (string-append fullname
                              " [" (number->string age) " year old "
                              (symbol->string gender) "]"))
      (newline)
      ; What gender(s) does she date?
      (display "  ")
      (cond
        ((equal? dates 'male) (display "Prefers to date men"))
        ((equal? dates 'female) (display "Prefers to date women"))
        ((equal? dates 'both) (display "Dates both men and women"))
        (else (display "Seems to prefer to date self")))
      (newline)
      ; Display the characteristics
      (display-characteristics characteristics)
      ; Display the likes
      (display-likes likes)
      ; That's it, return the person.
      person)))

;;; Display information about a list of people with the people numbered.
;;; for clarity.
;;; Parameters:
;;;   A list of people (potentially empty)
;;; Preconditions:
;;;   Each entry in the list is an appropriately-formatted person.
;;; Postconditions:
;;;   Displays lots of text about the people.
;;; Return value:
;;;   None.
(define display-people
  (lambda (people)
    (display-people-helper people 1)))

(define display-people-helper
  (lambda (people num)
    (if (not (null? people))
        (begin
          (display num)
          (display ". ")
          (display-person (car people))
          (display-people-helper (cdr people) (+ 1 num))))))

;;; Display information on a person's characteristics
;;; Parameters:
;;;   A list of characteristics, potentially empty.
;;; Pre:
;;;   Each characteristic has the appropriate form
;;; Post:
;;;   Displays stuff.
;;; Return value:
;;;   None
(define display-characteristics
  (lambda (stuff)
    (if (not (null? stuff))
        (let ((feature (car stuff))
              (more-stuff (cdr stuff)))
          (display "  ")
          (if (pair? feature)
              (display-standard-feature feature)
              (display feature))
          (newline)))))

;;; Helper function.  Displays one characteristic.
;;; Parameters:
;;;   A pair giving one feature (e.g., height, weight, ...)
;;; Pre:
;;;   The parameter is a pair, preferably with one of the standard features.
;;; Post:
;;;   Display stuff.
;;; Return value:
;;;   None
(define display-standard-feature
  (lambda (feature)
    (let ((name (car feature))
          (value (cadr feature)))
      (cond
        ((equal? name 'height) 
         (display "Height: ")
         (display value)
         (display " inches"))
        ((equal? name 'weight)
         (display "Weight: ")
         (display value)
         (display " pounds"))
        (else 
         (begin
           (display (car feature))
           (display ": ")
           (display (cadr feature))))))))

(define display-likes
  (lambda (likes)
    (display "  Likes: ")
    (cond
      ((null? likes) (display "ABSOLUTELY NOTHING"))
      ((= (length likes) 1) (display (car likes)))
      ((= (length likes) 2) (display (string-append (car likes)
                                                    " and "
                                                    (cadr likes))))     
      (else (display-likes-helper likes)))
    (newline)))

(define display-likes-helper
  (lambda (likes)
    (if (= (length likes) 1)
        (display (string-append "and " (car likes)))
        (begin
          (display (car likes))
          (display ", ")
          (display-likes-helper (cdr likes))))))

(define skipme null)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Utilities to read information on a person

;;; Read someone's first name
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns: 
';;   A first name.

(define read-first-name
  (lambda ()
    (capfirst (read-string "What is your first name? "))))

;;; Read someone's last name
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns: 
;;;   A last name.
(define read-last-name
  (lambda ()
    (capfirst (read-string "What is your last name? "))))

;;; Read someone's gender
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A symbol (male or female).
(define read-gender
  (lambda ()
    (read-symbol "What is your gender? " '(male female))))

;;; Read someone's preferred dating gender
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A symbol (male, female, or both).
(define read-dates
  (lambda ()
    (read-symbol "What gender do you prefer to date? " '(male female both))))

;;; Read someone's age.
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A number.
(define read-age
  (lambda ()
    (display "What is your age? ")
    (let ((age (read)))
      (cond ((not (number? age)) (begin (display "You must enter a number.")
                                        (newline)
                                        (read-age)))
            ((< age 18) (begin (display "Sorry, you must be 18 to use this service.")
                               (newline)
                               (read-age)))
            ((> age 90) (begin (display "Sorry, I'm ageist and you're too old to use this service.")
                               (newline)
                               (read-age)))
            (else age)))))

;;; Read someone's height (in inches)
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A number.
(define read-height
  (lambda ()
    (read-positive-number "Please enter your height in inches: ")))

;;; Read someone's weight (in pounds)
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A number.
(define read-weight
  (lambda ()
    (read-positive-number "Please enter your weight in pounds: ")))

;;; Read someone's characteristics.
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A list of characteristics, as given in the person specs.
(define read-characteristics
  (lambda ()
    (append 
     (list
       (list 'height 
             (read-positive-number "Please enter your height (in inches): "))
       (list 'weight 
             (read-positive-number "Please enter your weight (in pounds): "))
       (list 'eyecolor 
             (read-string "Please enter your eye color: "))
       (list 'haircolor 
             (read-string "Please enter your hair color: "))
       (list 'shoesize 
             (read-positive-number "Please enter your shoesize: ")))
     (read-string-list "How else would you describe yourself (X to stop)? " "x"))))

;;; Read a list of likes
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A list of strings.
(define read-likes
  (lambda ()
    (read-string-list "What is something you like? (X to stop)? " "x")))

;;; Read a list of preferences.
;;; Precondition:
;;;   The standard input port is available for reading.
;;; Postconditions: 
;;;   May have printed something.
;;;   Probably read some input.
;;; Returns:
;;;   A list of preferences in the appropriate format.
;;; Note:
;;;   Currently implemented in a simple form.
(define read-preferences
  (lambda ()
    null))

;;; Read a whole person.
;;; Pre: None
;;; Post: Probably displays lots of output.
;;;       Probably reads lots of input.
;;; Returns: The record for a person
(define read-person
  (lambda ()
    (list (capfirst (read-string "What is your first name? "))
          (read-last-name)
          (read-gender)
          (read-dates)
          (read-age)
          (read-characteristics)
          (read-likes)
          (read-preferences)
          )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tests

;;; A test of output.  Displays information about one datee.
(define test-output
    (lambda ()
      (display "Testing ...")
      (newline)
      (display "*** Here's the first person")
      (newline)
      (display-person (car datees))
      (display "*** Here's the second person")
      (newline)
      (display-person (cadr datees))
      (display "Done testing")
      (newline)))

; (test-output)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; The interface

(define run-vivek
  (lambda ()
    (display "Welcome to Vivek's \"Love Your Body\" Dating Service")
    (newline)
    (display "I'll ask you some questions about yourself and then ")
    (display "suggest some dates.")
    (newline)
    (newline)
    (let* ((client (read-person))
           (dates (suggest-dates client datees)))
      (newline)
      (display "Here's what I know about you: ")
      (newline)
      (display-person client)
      (newline)
      (if (null? dates)
          (begin
            (display "Sorry, I can't find anyone compatible.")
            (newline))
          (begin
            (display "I found ")
            (display (length dates))
            (display " potential dates.")
            (newline)
            (display-people dates))))))
            
(run-vivek)

; (read-person)