Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (require cs111/define-struct)
- (require 2htdp/image)
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Structural Inheritance
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Here's the class hierarchy we'll be building:
- ;;
- ;; Shape
- ;; __|___
- ;; | |
- ;; Circle Rectangle
- ;; A Shape is an ABSTRACT base type.
- ;;
- ;; Properties:
- ;; - color, a valid Racket color string
- ;;
- ;; Methods:
- ;; - render : Shape -> Image, a function to draw the shape
- ;; - area : Shape -> Number, a function to compute the area of a shape
- ;;
- ;; Abstract just means it's a template for subtypes, but
- ;; we never call (make-shape ...) directly.
- (define-struct shape [color]
- #:methods
- ; render : Shape -> Image
- (define (render sh)
- ; Nothing to render right now because the shape has no size.
- empty-image)
- ; area : Shape -> Number
- (define (area sh)
- ; Nothing to compute right now because the shape has no size.
- ; We'll return -1 to simplify things.
- -1))
- ;; Now let's define some subtypes of Shape.
- ;; A Circ is a subtype of Shape.
- ;;
- ;; Properties:
- ;; - color, a valid Racket color string (inherited from Shape)
- ;; - radius, a positive real number
- ;;
- ;; Methods:
- ;; - render : Shape -> Image (inherited from Shape)
- ;; - area : Shape -> Number (inherited from Shape)
- ;;
- ;; Note that we're calling our type `circ` because `circle`
- ;; is already defined by the 2htdp/image library.
- (define-struct (circ shape)
- ;; (circ shape) tells Racket we're inheriting properties and
- ;; methods from the Shape type, so we don't need to list
- ;; those inherited properties explicitly.
- ;;
- ;; We just need to add the new, Circ-specific property.
- [radius]
- #:methods
- ;; render : Shape -> Image
- ;; Remeber that a Circ is a Shape (because of inheritance),
- ;; so we can call `render` on a Circ.
- (define (render c)
- ;; Draw a circle with the same old function we know and love
- (circle (circ-radius c)
- "solid"
- ;; Remember, `color` is an INHERITED property of the base
- ;; type Shape, so we need to use `shape-color` instead of
- ;; `circ-color` to get it
- (shape-color c)))
- ;; area : Shape -> Number
- (define (area c)
- (* pi
- (sqr (circ-radius c)))))
- ;; Let's make a Circ
- (define small-circ
- ;; Notice the order of the property values:
- (make-circ
- ;; (1) Inherited properties, in order
- "green"
- ;; (2) Subtype properties, in order
- 10))
- ;; Let's try the Circ's `render` function
- ;; Notice how with methods, we don't use the typical
- ;; <StructType>-<FieldName> notation.
- ;; i.e. instead of (circ-render ...) we just use (render ...)
- (render small-circ)
- ;; .
- (render (make-circ "blue" 100))
- ;; .
- ;; Area?
- (area small-circ)
- ;; #i314.1592653589793
- (area (make-circ "red" 75))
- ;; #i17671.458676442588
- ;; A Rect is a subtype of Shape.
- ;;
- ;; Properties:
- ;; - color, a valid Racket color string (inherited from Shape)
- ;; - width, a positive real number
- ;; - length, a positive real number
- ;;
- ;; Methods:
- ;; - render : Shape -> Image (inherited from Shape)
- ;; - area : Shape -> Number (inherited from Shape)
- ;;
- ;; Note that we're calling our type `rect` because `rectangle`
- ;; is already defined by the 2htdp/image library.
- (define-struct (rect shape)
- ;; Additional fields: width, length
- [width length]
- #:methods
- ;; render : Shape -> Image
- (define (render r)
- (rectangle (rect-width r)
- (rect-length r)
- "solid"
- ;; Remember, `color` is an inherited property of Shape
- ;; so we use `shape-color`, not `rect-color`
- (shape-color r)))
- ;; area : Shape -> Number
- (define (area r)
- (* (rect-width r)
- (rect-length r))))
- ;; Make some Rects
- (define big-rect
- (make-rect
- ;; (1) Inherited properties, in order
- "red"
- ;; (2) Subtype properties, in order
- 150 100))
- (define actually-square
- (make-rect "black" 50 50))
- ;; Notice that `render` intelligently does the right thing, depending
- ;; on whether we pass a Rect or a Circ
- (render big-rect)
- ;; .
- (render actually-square)
- ;; .
- ;; Same with `area`
- (area big-rect)
- ;; 15000
- (area actually-square)
- ;; 2500
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Remember, we're dealing with regular structs and functions, so
- ;; all the normal stuff applies.
- (require cs111/iterated)
- "Using iterated-above..."
- (iterated-above
- ;; render : Shape -> Image is still a normal image-making function
- (lambda (n) (render (make-rect "green" (* 20 n) (* 20 n))))
- 5)
- ;; .
- ;; We can do everything as usual with structs:
- (circ? big-rect) ; false
- (circ? small-circ) ; true
- (circ? (make-rect "blue" 10 20)) ; false
- (circ? "hello") ; false
- "Original big-rect"
- (render big-rect)
- ;; .
- ;; Set! struct properties as usual
- (set-rect-width! big-rect
- (* 2
- ;; Access properties as usual
- (rect-width big-rect)))
- "After doubling width:"
- (render big-rect)
- ;; .
- ;; Notice that we always treat inherited properties
- ;; as attached to their original types, not the
- ;; descendant types.
- (set-shape-color! ; Not `set-rect-color!`
- big-rect "yellow")
- "After changing color:"
- (render big-rect)
- ;; .
- ;; Lists of structs work as usual
- (define shapes
- (list
- (make-circ "firebrick" 30)
- (make-rect "yellow" 40 50)
- (make-circ "blue" 20)))
- (define rendered-shapes (map render shapes))
- "Images rendered from a list of shapes"
- rendered-shapes
- ;; . . .
- "Result of folding all images into one"
- (foldl overlay empty-image rendered-shapes)
- ;; .
- ;; Filter shapes by size
- (define large-shapes
- (filter
- ;; Shape -> Boolean
- (lambda (s) (>= (area s) 2000))
- shapes))
- "Shapes with areas greater than or equal to 2000 units"
- (map render large-shapes)
- ;; #<list: . .>
- ;; Imperative functions and stuff work too
- (for-each
- ;; Shape -> Void
- ;; Side effect: sets the color of the given Shape to green
- (lambda (s) (set-shape-color! s "green"))
- shapes)
- "Shapes after we made them green"
- (map render shapes)
- ;; #<list: . . .>
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement