;; Scenario : we are developing a rendering package that uses a package for drawing ;; and manipulating shapes. The rendering package contains an interface subsystem ;; and a controller subsystem. ;; THE ORIGINAL SUBSYSTEMS (not unitized, but would be in full implementation) ;; Shapes subsystem (define Shape (interface () draw)) (define Rectangle (class* object% (Shape) (width height) (public (get-width width) (get-height height) (draw (lambda (window x y) (printf "draw rect with width ~a and height ~a at (~a, ~a) ~n" width height x y)))) (sequence (super-init)))) (define Circle (class* object% (Shape) (radius) (public (get-radius radius) (draw (lambda (window x y) (printf "draw circ with radius ~a at (~a, ~a) ~n" radius x y)))) (sequence (super-init)))) (define Union (class* object% (Shape) (shape1 shape2) (public (get-shape1 shape1) (get-shape2 shape2) (draw (lambda (window x y) (send shape1 draw window x y) (send shape2 draw window x y)))) (sequence (super-init)))) ;; Rendering Interface (define display-shape (lambda (shape) (send shape draw #f 0 0))) ;; Rendering Controller (define render-blob (lambda (size) (display-shape (make-object Union (make-object Circle size) (make-object Rectangle (* size 4) (* size 2)))))) ;; EXTENDING THE SHAPES SUBSYSTEM WITH BOUNDING BOXES (define BBShape (interface (Shape) boundingbox)) (define BBRectExt (class* Rectangle (BBShape) (width height) (public (boundingbox (lambda () (make-bounding-box 0 0 width height)))) (sequence (super-init width height)))) (define BBCircExt (class* Circle (BBShape) (radius) (public (boundingbox (lambda () (make-bounding-box (- radius) (- radius) radius radius)))) (sequence (super-init radius)))) (define BBUnionExt (class* Union (BBShape) (shape1 shape2) (public (boundingbox (lambda () ...))) (sequence (super-init shape1 shape2)))) ;; Rendering package can't make use of bounding boxes without modification. ;; - must modify interface to use bounding boxes in display ;; - must modify controller to create rendered shapes with bounding boxes ;; Why should the controller need to know anything about bounding boxes ;; though? It doesn't care about the actual shape classes, yet we have ;; to modify it to reflect the new class names. We shouldn't have to ;; modify any code that doesn't use the new features. ;; Ideally, we should parameterize the rendering controller over the classes ;; to create. The rendering controller would be a component. ;; How to parameterize components? Think about how we parameterize other constructs: ;; - parameterize functions with arguments ;; - parameterize classes with initialization variables ;; - parameterize packages with ??? Imports! (define-signature shapes^ (Shape Rectangle Circle Union)) ;; Rendering Interface (define-signature renderUI^ (display-shape)) (define RenderInterfaceUnit (unit/sig renderUI^ (import) (define display-shape (lambda (shape) (send shape draw #f 0 0))) )) ;; Rendering Controller (define-signature rendercontrol^ (render-blob)) (define RenderControlUnit (unit/sig rendercontrol^ (import renderUI^ shapes^) (define render-blob (lambda (size) (display-shape (make-object Union (make-object Circle size) (make-object Rectangle (* size 4) (* size 2)))))) )) ;; Notice that controller will create shapes from whatever classes it imports. ;; The controller is no longer refering to specific shapes! So giving the controller ;; the bounding box shapes changes what shapes get created without our having ;; to modify the source code. We still need to create a new interface unit that ;; supports bounding boxes though. (define RenderInterfaceBBUnit (unit/sig renderUI^ (import) (define display-shape (lambda (shape) (printf "Computing bounding box~n") (let ([bb (send shape boundingbox)] [compute-x (lambda (bb) 0)] [compute-y (lambda (bb) 0)]) (send shape draw #f (compute-x bb) (compute-y bb))))) )) ;; We can now build Rendering Systems with and without bounding boxes, using the ;; same controller, by creating two different shapes units (one supporting bounding ;; boxes and one not). How do we create both shapes units without duplicating the ;; original shapes code though? We build the BB shapes unit from the original unit. (define BasicShapesUnit (unit/sig shapes^ (import) (define Shape (interface () draw)) (define Rectangle (class* object% (Shape) (width height) (public (get-width width) (get-height height) (draw (lambda (window x y) (printf "draw rect with width ~a and height ~a at (~a, ~a) ~n" width height x y)))) (sequence (super-init)))) (define Circle (class* object% (Shape) (radius) (public (get-radius radius) (draw (lambda (window x y) (printf "draw circ with radius ~a at (~a, ~a) ~n" radius x y)))) (sequence (super-init)))) (define Union (class* object% (Shape) (shape1 shape2) (public (get-shape1 shape1) (get-shape2 shape2) (draw (lambda (window x y) (send shape1 draw window x y) (send shape2 draw window x y)))) (sequence (super-init)))) )) (define BBShapesExtensionUnit (unit/sig shapes^ (import (basic : shapes^)) (define Shape (interface (basic:Shape) boundingbox)) (define make-bounding-box (lambda (bl br tl tr) #f)) ;; dummy defn (define Rectangle (class* basic:Rectangle (Shape) (width height) (public (boundingbox (lambda () (make-bounding-box 0 0 width height)))) (sequence (super-init width height)))) (define Circle (class* basic:Circle (Shape) (radius) (public (boundingbox (lambda () (make-bounding-box (- radius) (- radius) radius radius)))) (sequence (super-init radius)))) (define Union (class* basic:Union (Shape) (shape1 shape2) (public (boundingbox (lambda () '...))) ;; dummy definition (sequence (super-init shape1 shape2)))) )) (define BBShapesUnit (compound-unit/sig (import) (link (Basic : shapes^ (BasicShapesUnit)) (BBExt : shapes^ (BBShapesExtensionUnit Basic))) (export (open BBExt)))) ;; Notes: ;; - the BBShapesUnit glues the Basic and BBExtension units together into a new unit ;; - the BBShapesExtensionUnit is parameterized over the parent classes. This means ;; that the class definitions in this unit are parameterized over their parent ;; classes. We can extend ANY Rect/Circ/Union classes with bounding boxes this way. ;; In the original (non-unitized) code, we specifically extended the basic classes. ;; Here are our two rendering packages (define RenderBasic (compound-unit/sig (import) (link (Shapes : shapes^ (BasicShapesUnit)) (UI : renderUI^ (RenderInterfaceUnit)) (Control : rendercontrol^ (RenderControlUnit UI Shapes))) (export (open Control)))) (define RenderWithBB (compound-unit/sig (import) (link (Shapes : shapes^ (BBShapesUnit)) (UI : renderUI^ (RenderInterfaceBBUnit)) (Control : rendercontrol^ (RenderControlUnit UI Shapes))) (export (open Control)))) (require-library "invoke.ss") (define-values/invoke-unit/sig rendercontrol^ RenderBasic #f) (render-blob 10) (define-values/invoke-unit/sig rendercontrol^ RenderWithBB #f) (render-blob 10) ;; Fun aside : notice the similar definitions of RenderBasic and RenderWithBB? ;; This calls for a helper function ... (define make-RenderUnit (lambda (shapes-unit interface-unit) (compound-unit/sig (import) (link (Shapes : shapes^ (shapes-unit)) (UI : renderUI^ (interface-unit)) (Control : rendercontrol^ (RenderControlUnit UI Shapes))) (export (open Control))))) (define RenderBasic (make-RenderUnit BasicShapesUnit RenderInterfaceUnit)) (define RenderWithBB (make-RenderUnit BBShapesUnit RenderInterfaceBBUnit)) ;; all of this has shown how to add operations (boundingbox). We still need ;; to show to add variants ;; ADDING TRANSLATED SHAPES ;; We want to add a new type of shape, a translated shape, to our shapes class. ;; Our shape class is now inside a unit. So we really want to create a new ;; shapes unit that adds a translated shape class to the basic shapes. ;; when we define this unit, we find that we need to import the shape interface, ;; but not the other shape classes. Here, we redefine the shapes^ signature to ;; allow the interface to be imported independently ;; In this example, I'm defining trans with bounding boxes immediately, rather than ;; defining it as two class extensions (one with just draw and one with bounding box). ;; Defining it as two classes provides more flexibility, but I did it this way here ;; to make the example code shorter (and hopefully easier to follow): (define-signature trans^ (Trans)) (define-signature shapeI^ (Shape)) (define-signature shapes^ ((open shapeI^) Rectangle Circle Union)) (define-signature shapes+trans^ ((open shapes^) (open trans^))) (define BBTransShapeUnit (unit/sig trans^ (import shapeI^) (define Trans (class* object% (Shape) (a-shape change-x change-y) (public (draw (lambda (window x y) (send a-shape draw window (+ x change-x) (+ y change-y)))) (boundingbox (lambda () '...))) (sequence (super-init)))))) (define BBShapes+TransUnit (compound-unit/sig (import) (link (Basic : shapes^ (BBShapesUnit)) (Trans : trans^ (BBTransShapeUnit (Basic : shapeI^)))) (export (open Basic) (open Trans)))) ;; notice how we can restrict the signature of Basic when linking it to Trans ;; If we are adding translated shapes, we may want a new render control that uses ;; these shapes. Note that we can link the translated shapes unit with the original ;; render control though -- the control just won't use the translated shapes. (define RenderControlWithTransUnit (unit/sig rendercontrol^ (import renderUI^ shapes+trans^) (define render-blob (lambda (size) (display-shape (make-object Trans (make-object Union (make-object Circle size) (make-object Rectangle (* size 4) (* size 2))) 25 40)))))) ;; at last, we create a new renderer that can use both extensions: bounding boxes ;; and translated shapes. Note that adding translated shapes doesn't require a ;; new interface, but does require a new control that can create translated ;; shapes. (define RenderWithBBAndTrans (compound-unit/sig (import) (link (Shapes : shapes+trans^ (BBShapes+TransUnit)) (UI : renderUI^ (RenderInterfaceBBUnit)) (Control : rendercontrol^ (RenderControlWithTransUnit UI Shapes))) (export (open Control)))) ;; Summary : what have we learned from all of this? ;; The good news : extending both variants and operations is possible, but it requires ;; a special combination of components and classes. For this to work ;; - subclasses must be parameterizable over their parent classes ;; - components must separate their definitions from their links to other components ;; Moral : separating defintions from connections between programming constructs ;; provides a lot of flexibility in writing reusable code ;; The bad news : most languages (including C++ and Java) don't yet ;; support these features. You have to use and modify variables to ;; store the current versions of classes (the Factory pattern) to ;; support this kind of blackbox extensions.