Or Your Money Back

;;; Class: 511-01 (Organization of Programming Languages)
;;; Instructor:   Dr. J Franco
;;; Project:   Final Exam - Part II
;;; Date:   3/14/99
;;; Name:   Mihajlo A. Jovanovic
;;;
  (define employee-maker
    (lambda (name ssn)
      (lambda msg
        (let ((get-name (lambda () name))
              (get-ssn  (lambda () ssn))
              (show (lambda () (display ""))))
          (case (car msg)
            ('get-name (get-name))
            ('get-ssn (get-ssn))
            ('show (show))
            ('wage-emp
              (let ((wgs (cadr msg))(hrs '0))
                (lambda msg
                  (let ((get-wages (lambda () wgs))
                        (get-hours (lambda () hrs))
                        (compute-pay (lambda () (* wgs hrs)))
                        (set-wages (lambda (w) (set! wgs w)))
                        (set-hours (lambda (h) (set! hrs h))) 
                        (show (lambda ()
                                (display name)
                                (display " ")
                                (display ssn)
                                (newline))))
                    (case (car msg)
                      ('get-name (get-name))
                      ('get-ssn (get-ssn))
                      ('show (show))
                      ('get-wages (get-wages))
                      ('get-hours (get-hours))
                      ('compute-pay (compute-pay))
                      ('set-wages (set-wages (cadr msg)))
                      ('set-hours (set-hours (cadr msg)))
                      ('programmer
                        (lambda msg
                          (let ((show (lambda ()
                                        (display "Programmer name: ")
                                        (display name)
                                        (newline)
                                        (display "ID: ")
                                        (display ssn)
                                        (newline)
                                        (display "Wages: ")
                                        (display wgs)
                                        (newline)
                                        (display "Hrs: ")
                                        (display hrs)
                                        (newline))))
                            (case (car msg)
                              ('get-name (get-name))
                              ('get-ssn (get-ssn))
                              ('show (show))
                              ('get-wages (get-wages))
                              ('get-hours (get-hours))
                              ('compute-pay (compute-pay))
                              ('set-wages (set-wages (cadr msg)))
                              ('set-hours (set-hours (cadr msg)))))))))))))))))

(define find-by-name
  (lambda (e)
    (e 'get-name)))

(define find-by-ssn
  (lambda (e)
    (e 'get-ssn)))
               
(define queue
  (lambda (f)         ;;; find function
    (let ((l '()))    ;;; list of employee objects
      (lambda msg
        (let ((enqueue (lambda (e) (set! l (cons e l))))
              (dequeue (lambda () (let ((e (car l))) (set! l (cdr l)) e)))
              (set-locator (lambda (func) (set! f func)))
              (show (lambda () 
                (letrec ((a (lambda (loe)
                              (if (null? loe)
                                  (newline)
                                  (begin
                                    ((car loe) 'show)
                                    (a (cdr loe)))))))
                  (a l))))
              (find (lambda (s)
                      (letrec ((a (lambda (s f l)
                                    (if (null? l)
                                        'ERROR-NOT-FOUND
                                        (if (eq? s (f (car l)))
                                            (car l)
                                            (a s f (cdr l)))))))
                        (a s f l)))))
          (case (car msg)
            ('enqueue (enqueue (cadr msg)))
            ('dequeue (dequeue))
            ('set-locator (set-locator (cadr msg)))
            ('show (show))
            ('find (find (cadr msg)))))))))

(define Prog13
  (lambda (q)        ;;; queue of employee objects
    (lambda msg
      (let ((add-to-db (lambda (e) (q 'enqueue e)))
            (worker-info (lambda (s) ((q 'find s) 'show)))
            (display-db (lambda () (q 'show)))
            (set-hours (lambda (s h) ((q 'find s) 'set-hours h))))
            (case (car msg)
            ('add-to-db (add-to-db (cadr msg)))
            ('worker-info (begin
                            (if (eq? (cadr msg) 'name)
                                (q 'set-locator find-by-name)
                                (q 'set-locator find-by-ssn))
                            (worker-info (caddr msg))))
            ('display-db (display-db))
            ('set-hours (begin
                          (if (eq? (cadr msg) 'name)
                              (q 'set-locator find-by-name)
                              (q 'set-locator find-by-ssn))
                              (set-hours (caddr msg) (cadddr msg))))))))) 

;;;
;;; Examples
;;

(define my-queue (queue find-by-name))

(define prog1 (((employee-maker 'Mihajlo '281-96-3311) 'wage-emp 15) 'programmer))

(define prog2 (((employee-maker 'Ankur '987-65-4321) 'wage-emp 25) 'programmer))

(define prog3 (((employee-maker 'Harry '123-45-6789) 'wage-emp 20) 'programmer))

(define program (Prog13 my-queue))

;(program 'add-to-db prog1)
;(program 'add-to-db prog2)
;(program 'add-to-db prog3)

;(program 'worker-info 'name 'mihajlo)  

;(program 'set-hours 'ssn '281-96-3311 5)

;(program 'display-db)