; More examples.

; Before defining everything we want to do with foods, we'll need to define
; some more basic verbs and nouns: pots, pans, burners, etc.  Let's assume
; this stuff is in another file someplace.  Note how we isolate this lower
; level of abstraction from the higher level we're interested in now.
(load "kitchen-primitives")

; First we'll define a bunch of kinds of food.
(define <food>
	(make-named-class 'food (list <object>) (list 'calories 'cost)))
	; That is, <food> is a class of objects, and every instance of
	; <food> has two data slots: calories and cost.

(define <cooked-food>
	(make-named-class 'cooked-food (list <food>) (list 'cooking-time)))
	; That is, <cooked-food> is a subclass of <food>.  Every instance of
	; <cooked-food> has three data slots: cooking-time, calories, and
	; cost; note that the last two are inherited from its superclass.

(define <hamburger>
	(make-named-class 'hamburger (list <cooked-food>) (list)))
	; <hamburger> is a subclass of <cooked-food> with no data slots except
	; the three it inherits from its superclass: cooking-time, calories,
	; and cost.

(define <ice-cream>
	(make-named-class 'ice-cream (list <food>) (list 'flavor)))
(define <rice>
	(make-named-class 'rice (list <cooked-food>) (list)))
(define <brown-rice>
	(make-named-class 'brown-rice (list <rice>) (list)))
(define <white-rice>
	(make-named-class 'white-rice (list <rice>) (list)))
(define <fruit>
	(make-named-class 'fruit (list <food>) (list)))
(define <fruit-with-peel>
	(make-named-class 'fruit-with-peel (list <fruit>) (list)))
(define <apple>
	(make-named-class 'apple (list <fruit>) (list)))
(define <banana>
	(make-named-class 'banana (list <fruit-with-peel>) (list)))
(define <water>
	(make-named-class 'water (list <food>) (list)))
	; not exactly, but we do ingest it.

(define <hamburger-bun>
	(make-named-class 'hamburger-bun (list <food> <container>) (list)))
	; Note that a <hamburger-bun> can be thought of BOTH as a <food>
	; (you can eat it), AND as a <container> (you can put something into
	; it).  This is a phenomenon called "multiple inheritance"; we'll
	; talk about it later in the semester.


; Now we define the "verbs" that we're likely to apply to these foods.
(define eat (make-generic))
	; Takes a <food> and returns nothing.
(define prepare (make-generic))
	; Takes a <food> and returns a <food> that is ready to eat.
(define toppings (make-generic))
	; Takes a <food> and returns a list of possible toppings.

; Now we define how those verbs are carried out on different kinds of foods.
(add-method prepare
	(make-method (list <food>)
		(lambda (compute-next-method food-item)
			food-item)))
	; By default, you don't do anything to prepare a food item;
	; you just return it.

(add-method prepare
	(make-method (list <cooked-food>)
		(lambda (compute-next-method food-item)
			(error "This is an abstract method."))))
	; For cooked foods, we know we need to cook the thing, but we don't
	; know how.  If anybody tries to prepare a cooked-food without saying
	; more specifically what kind of cooked-food it is, print an error
	; message.

(add-method prepare
	(make-method (list <hamburger>)
		(lambda (compute-next-method hamburger)
			(let ((pan (get-thing <frying-pan>))
				  (bun (get-thing <hamburger-bun>)))
	; In "kitchen-primitives" is a function "get-thing" which, when you
	; tell it what class of thing you need, finds one and returns it.
	; The "let" gives us local variables named "pan" and "bun",
	; initialized by getting a <frying-pan> and a <hamburger-bun>
	; respectively.
				(set-burner 'medium)
				(put-on-burner pan)
				(wait '(30 seconds))
				(put-in hamburger pan)
				(wait (slot-ref hamburger 'cooking-time))
				(turn-over hamburger)
				(wait (slot-ref hamburger 'cooking-time))
				(set-burner 'off)
				(take-out hamburger pan)
				(put-in hamburger bun)
				bun))))
	; when we're finished, we return the bun, which contains the hamburger,
	; so somebody can eat it.

(add-method prepare
	(make-method (list <rice>)
		(lambda (compute-next-method rice)
			(let    ( (pan (get-thing <saucepan>))
				  (water (get-thing <water>))
				  (bowl (get-thing <bowl>)))
				(set-burner 'high)
				(put-on-burner pan)
				(put-in water pan)
				(wait-until (lambda () (boiling? water)))
				(put-in rice pan)
				(set-burner 'low)
				(wait (slot-ref rice 'cooking-time))
				(set-burner 'off)
				(take-out rice pan)
				(put-in rice bowl)
				rice))))
(add-method prepare
	(make-method (list <brown-rice>)
		(lambda (compute-next-method rice)
			(wash rice)
			(compute-next-method))))
	; To prepare brown rice, use the usual method for preparing rice, but
	; wash the rice first.  (Note how this avoids duplicating code.)

(add-method prepare
	(make-method (list <fruit-with-peel>)
		(lambda (compute-next-method fruit)
			(take-off-peel fruit))))
(add-method toppings
	(make-method (list <hamburger>)
		(lambda (compute-next-method hamburger)
			(list 'ketchup 'mustard 'pickles 'onions))))
(add-method toppings
	(make-method (list <ice-cream>)
		(lambda (compute-next-method ice-cream)
			(list 'chocolate-sauce 'sprinkles 'peanuts))))
(add-method toppings
	(make-method (list <rice>)
		(lambda (compute-next-method rice)
			(list 'vegetables 'sauce))))

(add-method initialize
	(make-method (list <brown-rice>)
		(lambda (compute-next-method rice initargs)
			(slot-set! rice 'cooking-time '(35 minutes)))))
	; "initialize" is a predefined generic that takes two arguments: the
	; object to initialize and any initialization arguments provided with
	; it.  We shall ignore the initialization arguments and just set the
	; cooking time.

(add-method initialize
	(make-method (list <white-rice>)
		(lambda (compute-next-method rice initargs)
			(slot-set! rice 'cooking-time ('20 minutes)))))

(define wash
	(lambda (thing-to-wash)
		(let    ( (bowl (get-thing <bowl>))
			  (water (get-thing <water>)))
			(put-in thing-to-wash bowl)
			(put-in water bowl)
			(take-out water bowl)
			(take-out thing-to-wash bowl)
			thing-to-wash)))
	; Note that I've defined "wash" as an ordinary Scheme function,
	; rather than as a method for a generic.  If it turned out that I
	; needed to wash different things in different ways, I would
	; probably change my mind.  But any existing code that called
	; "wash" wouldn't need to be changed!

(define take-off-peel (make-generic))

(add-method take-off-peel
	(make-method (list <fruit>)
		(lambda (cnm fruit)
			(print "Peeling a " (class-name-of fruit) "."))))