{ |one, step, back| }

The Shape Example in Smalltalk

Contributed by Chris Rathman

Code for Smalltalk

Workspace: Try Shape

     | scribble aRectangle | 
      
     "toss the different shapes into a collection"  
     scribble := Bag new.  
     scribble add: (CMRRectangle x:10 y:20 width:5 height:6).  
     scribble add: (CMRCircle x:15 y:25 radius:8).  
       
     "use the shapes polymorphically"  
     scribble do: [:each |  
        each draw.  
        each rMoveToX: 100 rMoveToY: 100.  
        each draw].  
       
     "call a rectangle specific function"  
     aRectangle := CMRRectangle x:0 y:0 width:15 height:15.  
     aRectangle width: 30.  
     aRectangle draw.

Class: Shape

     Object subclass: #CMRShape  
        instanceVariableNames: 'x y '  
        classVariableNames: ''  
        poolDictionaries: ''  
        category: 'Chris-Objects'

Instance methods - accessing

     x
        "get the origin x value"  
        ^x.  
       
     y 
        "get the origin y value"  
        ^y.  
       
     x: aNumber 
        "set the origin x value"  
        ^x := aNumber.  
       
     y: aNumber
        "set the origin y value"  
        ^y := aNumber.

Instance methods - transforming

     "transforming"  
     moveToX: newX moveToY: newY  
        "shift the origen based on the (x,y) point"  
        self x: newX.  
        self y: newY.  
        ^(self x) @ (self y).  
       
     rMoveToX: deltaX rMoveToY: deltaY  
        "shift the origen based on the delta (x,y) point"  
        self x: (self x + deltaX).  
        self y: (self y + deltaY).  
        ^(self x) @ (self y).

Class: Rectangle

     CMRShape subclass: #CMRRectangle  
        instanceVariableNames: 'width height '  
        classVariableNames: ''  
        poolDictionaries: ''  
        category: 'Chris-Objects'

Class methods - instance creation

     x: xValue y: yValue width: aWidth height: aHeight  
        "construct a rectangle"  
        | rectangle |  
        rectangle := super new.  
        rectangle x: xValue.  
        rectangle y: yValue.  
        rectangle width: aWidth.  
        rectangle height: aHeight.  
        ^rectangle.

Instance methods - accessing

     height  
        "get the height of the rectangle"  
        ^height.  
       
     width  
        "get the width of the rectangle"  
        ^width.  
       
     height: aNumber  
        "set the height of the rectangle"  
        ^height := aNumber.  
       
     width: aNumber  
        "set the width of the rectangle"  
        ^width := aNumber.

Instance methods - displaying

     draw  
        "draw the rectangle"  
        Transcript show:  
           'Drawing a rectangle at:(' ,  
           self x printString , ',' ,  
           self y printString ,  
           '), width ' ,  
           self width printString ,  
           ', height ' ,  
           self height printString;  
           cr.

Class: Circle

     CMRShape subclass: #CMRCircle  
        instanceVariableNames: 'radius '  
        classVariableNames: ''  
        poolDictionaries: ''  
        category: 'Chris-Objects'!

Class methods - instance creation

     x: xValue y: yValue radius: aRadius  
        "construct a circle"  
        | circle |  
        circle := super new.  
        circle x: xValue.  
        circle y: yValue.  
        circle radius: aRadius.  
        ^circle.

Instance methods - accessing

     radius  
        "get the radius value"  
        ^radius.  
       
     radius: aNumber  
        "set the radius of the circle"  
        ^radius := aNumber.

Instance methods - displaying

     draw  
        "draw the circle"  
        Transcript show:  
           'Drawing a circle at:(' ,  
           self x printString , ',' ,  
           self y printString ,  
           '), radius ' ,  
           self radius printString;  
           cr.

Output

Drawing a circle at:(15,25), radius 8
Drawing a circle at:(115,125), radius 8
Drawing a rectangle at:(10,20), width 5, height 6
Drawing a rectangle at:(110,120), width 5, height 6
Drawing a rectangle at:(0,0), width 30, height 15