;;; File:
;;;   student-object.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Summary:
;;;   Whee!  Let's represent students as objects.
;;; Note:
;;;   Everything else is forthcoming.

; +-------------------------------------------------------------------
; | Design Decisions |
; +------------------+

; Each attribute of the student gets a different vector, with
; a name that is preceded by "student".  For example, the student's
; last name is stored in the vector student-last-name.


; +------+------------------------------------------------------------
; | HOPs |
; +------+

(define left-section
  (lambda (proc left)
    (lambda (right)
      (proc left right))))
(define l-s left-section)

(define right-section
  (lambda (proc right)
    (lambda (left)
      (proc left right))))
(define r-s right-section)


; +-------------------------------------------------------------------
; | Constructors |
; +--------------+

;;; Procedure:
;;;   make-student
;;; Parameters:
;;;   last-name, a string
;;;   first-name, a string
;;;   id, a string
;;;   major, a string
;;;   class, an integer
;;; Purpose:
;;;   Create a new student object.
;;; Produces:
;;;   student, a student object.
;;; Preconditions:
;;;   (None)
;;; Postconditions:
;;;   student is a valid student.
;;;   student responds to the following messages:
(define make-student
  (lambda (last-name first-name id major class)
    (cond
      ((not (string? last-name))
       (error "make-student: parameter 0 (last-name) must be a string"))
      ((not (string? first-name))
       (error "make-student: parameter 1 (first-name) must be a string"))
      ((not (string? id))
       (error "make-student: parameter 3 (id) must be a string"))
      ((not (string? major))
       (error "make-student: parameter 4 (major) must be a string"))
      ((not (integer? class))
       (error "make-student: parameter 5 (class) must be an integer"))
      ((not (valid-class? class))
       (error "make-student: parameter 6 (class) is invalid"))
      (else
       (let ((student-last-name (vector last-name))
             (student-first-name (vector first-name))
             (student-id (vector id))
             (student-major (vector major))
             (student-class (vector class))
             (student-homework (vector null))
             (student-exams (vector null))
             (student-projects (vector null))
             (student-participation (vector 90))
             (student-ec (vector null)))
         (lambda (message . params)
           (cond
             ((eq? message ':type)
              'student)
             ((eq? message ':->string)
              (string-append
               "#<student>("
               (vector-ref student-last-name 0)
               ", "
               (vector-ref student-first-name 0)
               " ["
               (vector-ref student-id 0)
               "])"))
             ((eq? message ':get-last-name)
              (vector-ref student-last-name 0))
             ((eq? message ':get-first-name)
              (vector-ref student-first-name 0))
             ((eq? message ':get-id)
              (vector-ref student-id 0))
             ((eq? message ':get-major)
              (vector-ref student-major 0))
             ((eq? message ':get-class)
              (vector-ref student-class 0))
             ((eq? message ':get-homework)
              (vector-ref student-homework 0))
             ((eq? message ':get-exams)
              (vector-ref student-exams 0))
             ((eq? message ':get-projects)
              (vector-ref student-projects 0))
             ((eq? message ':get-participation)
              (vector-ref student-participation 0))
             ((eq? message ':get-ec)
              (vector-ref student-ec 0))
             ((eq? message ':count-student-ec)
              (length (vector-ref student-ec 0)))
             ((eq? message ':set-name!)
              (check-params "#<student>:set-name!"
                            params
                            (list (cons "a string" string?)
                                  (cons "a string" string?)))
              (vector-set! student-last-name 0 (car params))
              (vector-set! student-first-name 0 (cadr params)))
             ((eq? message ':set-major!)
              (check-params "#<student>:set-major!"
                            params
                            (list (cons "a string" string?)))
              (vector-set! student-major 0 (car params)))
             ((eq? message ':set-class!)
              (check-params "#<student>:set-class!"
                            params
                            (list (cons "an integer" integer?)))
              (if (not (valid-class? (car params)))
                  (error "#<student>:set-class!: Invalid class.")
                  (vector-set! student-class 0 (car params))))
             ((eq? message ':set-participation!)
              (check-params "#<student>:set-participation!"
                            params
                            (list (cons "an integer" integer?)))
              (vector-set! student-participation 0 (car params)))
             ((eq? message ':add-homework!)
              (check-params "#<student>:add-homework!"
                            params
                            (list (cons "a valid symbolic grade"
                                        symbolic-grade?)))
              (vector-set! student-homework 0
                           (append (vector-ref student-homework 0)
                                   params)))
             ((eq? message ':add-exam!)
              (check-params "#<student>:add-exam!"
                            params
                            (list (cons "a real" real?)))
              (vector-set! student-exams 0
                           (append (vector-ref student-exams 0)
                                   params)))
             ((eq? message ':add-project!)
              (check-params "#<student>:add-project!"
                            params
                            (list (cons "a valid letter grade"
                                        string-grade?)))
              (vector-set! student-projects 0
                           (append (vector-ref student-projects 0)
                                   params)))
             ((eq? message ':add-ec!)
              (check-params "#<student>:add-ec!"
                            params
                            (list (cons "a string" string?)))
              (vector-set! student-ec 0
                           (append (vector-ref student-ec 0)
                                   params)))
             (else
              (error "#<student>: invalid message")))))))))


; +-------------------+-----------------------------------------------
; | General Utilities |
; +-------------------+

(define random-element
  (lambda (lst)
    (list-ref lst (random (length lst)))))

;;; Procedure:
;;;   check-params
;;; Parameters:
;;;   procedure, a string
;;;   params, a list of parameters
;;;   specs, a list of string/predicates pairs.
;;; Purpose:
;;;   Checks to see that the parameters meet their specifications.
;;; Produces:
;;;   (nothing)
;;; Preconditions:
;;;   All the elements of specs are pairs.
;;;   The cdrs of all the elements of specs are unary predicates.
;;;   The cars of all the elements of specs are strings.
;;; Postconditions:
;;;   If the parameters fail to match the specifications (wrong
;;;     number or any predicate fails), reports an error.
(define check-params
  (lambda (procedure params specs)
    (if (not (= (length params) (length specs)))
        (error
         (string-append
          procedure ": "
          "expects " (number->string (length specs))
          "parameters, received " (number->string (length params))
          "."))
        (let kernel ((params params)
                     (specs specs)
                     (pos 0))
          (cond
            ((null? params)) ; Done!
            (((cdar specs) (car params))
             (kernel (cdr params) (cdr specs) (+ pos 1)))
            (else
             (error
              (string-append
               procedure ": "
               "parameter " (string->number pos)
               " is not " (caar specs)))))))))

;;; Procedure:
;;;   display-line
;;; Parameters:
;;;   val0, val2, ... valn: 0 or more values.
;;; Purpose:
;;;   Displays all of the values, followed by a carriage return.
(define display-line
  (letrec ((kernel
            (lambda (remaining)
              (if (null? remaining)
                  (newline)
                  (begin
                    (display (car remaining))
                    (kernel (cdr remaining)))))))
    (lambda vals
      (kernel vals))))

;;; Procedure:
;;;   display-category
;;; Parameters:
;;;   category, a string
;;;   lst, a list
;;; Purpose:
;;;   Display all the values for a particular category.
(define display-category
  (lambda (cat lst)
    (letrec ((kernel
              (lambda (lst)
                (if (null? (cdr lst))
                    (begin
                      (display (car lst))
                      (newline))
                    (begin
                      (display (car lst))
                      (display ", ")
                      (kernel (cdr lst)))))))
      (if (null? lst)
          (display-line "No " cat ".")
          (begin
            (display cat)
            (display ": ")
            (kernel lst))))))


; +-------------------+-----------------------------------------------
; | Student Utilities |
; +-------------------+

;;; Procedure:
;;;   display-student
;;; Parameters:
;;;   student, a student
;;; Purpose:
;;;   Print out information on the student.
;;; Produces:
;;;   Nothing; called for the side effect.
(define display-student
  (lambda (student)
    (display-line "Record for " (student ':get-last-name)
                  ", " (student ':get-first-name)
                  " [ID: " (student ':get-id) "]")
    (display-line "Major: " (student ':get-major)
                  "; Class: " (student ':get-class))
    (display-category "Homework" (student ':get-homework))
    (display-category "Exams" (student ':get-exams))
    (display-category "Projects" (student ':get-projects))
    (display-line "Participation: " (student ':get-participation))
    (display-category "Extra Credit" (student ':get-ec))))

;;; Procedure:
;;;   valid-class?
;;; Parameters:
;;;   class, an integer [unverified]
;;; Purpose:
;;;   Determines whether class is valid.
;;; Produces:
;;;   is-valid?, a boolean
(define valid-class?
  (lambda (class)
    (<= 2000 class 2010)))

;;; Procedure:
;;;   symbolic-grade?
;;; Parameters:
;;;   grade, a symbol
;;; Purpose:
;;;   Determines whether grade is one of the valid symbolic grades.
;;; Produces:
;;;   valid?, a boolean.
(define symbolic-grade?
  (r-s member (list 'plus 'check-plus 'check 'check-minus 'minus 'zero)))

;;; Procedure:
;;;   string-grade?
;;; Parameters:
;;;   grade, a symbol
;;; Purpose:
;;;   Determines whether grade is one of the valid string grades.
;;; Produces:
;;;   valid?, a boolean.
(define string-grade?
  (r-s member
       (list "A+" "A" "A-" "B+" "B" "B-" "C+" "C"  "D" "F" "0")))

;;; Procedure:
;;;   random-student
;;; Parameters:
;;;   (none)
;;; Purpose:
;;;   Generate a sample student, primarily to test all of the
;;;   procedures.
;;; Produces:
;;;   student, a student
(define random-student
  (lambda ()
    (let ((student (make-student "Last" "First"
                                 (number->string (random 1000))
                                 "Undeclared"
                                 (+ 2000 (random 8)))))
      (student ':set-name!
               (random-element (list "Smith" "Doe" "Jones"))
               (random-element (list "Sam" "Terry" "Kim")))
      (student ':set-major!
               (random-element (list "Computer Science" "Math")))
      (student ':set-class!
               (+ 1 (student ':get-class)))
      (student ':set-participation!
               (+ 60 (random 41)))
      (student ':add-homework!
               (random-element (list 'plus 'check 'minus)))
            (student ':add-homework!
                     (random-element (list 'plus 'check 'minus)))
            (student ':add-homework!
                     (random-element (list 'plus 'check 'minus)))
            (student ':add-exam!
                     (+ 75 (random 26)))
            (student ':add-exam!
                     (+ 75 (random 26)))
            (student ':add-exam!
                     (+ 75 (random 26)))
            (student ':add-project!
                     (random-element (list "A" "B+" "B-" "F")))
            (student ':add-project!
                     (random-element (list "A" "B+" "B-" "F")))
            (student ':add-ec! "something")
            (student ':add-ec! "something else")
      student)))


; +-------------------------------------------------------------------
; | History |
; +---------+

; Monday, 20 November 2006 [Samuel A. Rebelsky]
; * Created as empty file.

; Tuesday, 21 November 2006 [Samuel A. Rebelsky]
; * Added code.