SNOBOL4

Contributed by Chris Rathman

Note: This one is on the ragged edge of demonstrating polymorphism. The technique used here does not provide for inheritance or method redefinition. The polymorphic dispatch is accomplished by doing an EVAL(string) type function within the virtual method. SNOBOL has some nice features with string handling and variable indirection, but the shape example really doesn't do much along these lines.

shape.sno

*  Shape related methods - shared by all shape classes
               DEFINE('getX(this)')
               DEFINE('getY(this)')
               DEFINE('setX(this,newx)')
               DEFINE('setY(this,newy)')
               DEFINE('moveTo(this,newx,newy)')
               DEFINE('rMoveTo(this,deltax,deltay)')
               DEFINE('draw(this)')                            :(SHAPE_END)
getX           getX = x(this['fields'])                        :(RETURN)
getY           getY = y(this['fields'])                        :(RETURN)
setX           x(this['fields']) = newx                        :(RETURN)
setY           y(this['fields']) = newy                        :(RETURN)
moveTo         setX(this, newx)
               setY(this, newy)                                :(RETURN)
rMoveTo        moveTo(this,
+                 getX(this) + deltax,
+                 getY(this) + deltay)                         :(RETURN)
draw           APPLY(this['draw'], this)                       :(RETURN)
SHAPE_END

*  Circle Class - (Note: the draw function is the only polymorphic function)
               DATA('Circle(x,y,radius)')
               DEFINE('makeCircle(x,y,radius)')
               DEFINE('getRadius(this)')
               DEFINE('setRadius(this,newradius)')
               DEFINE('drawCircle(this)')                      :(CIRCLE_END)
makeCircle     makeCircle = TABLE()
               makeCircle['fields'] = Circle(x, y, radius)
               makeCircle['draw'] = 'drawCircle'               :(RETURN)
getRadius      getRadius = radius(this['fields'])              :(RETURN)
setRadius      radius(this['fields']) = newradius              :(RETURN)
drawCircle     OUTPUT = "Drawing a Circle at:("
+                 getY(this) "," getY(this)
+                 "), radius " getRadius(this)                 :(RETURN)
CIRCLE_END

*  Rectangle Class - (Note: the draw function is the only polymorphic function)
               DATA('Rectangle(x,y,width,height)')
               DEFINE('makeRectangle(x,y,width,height)')
               DEFINE('getWidth(this)')
               DEFINE('getHeight(this)')
               DEFINE('setWidth(this,newwidth)')
               DEFINE('setHeight(this,newheight)')
               DEFINE('drawRectangle(this)')                   :(RECTANGLE_END)
makeRectangle  makeRectangle = TABLE()
               makeRectangle['fields'] = Rectangle(x, y, width, height)
               makeRectangle['draw'] = 'drawRectangle'         :(RETURN)
getWidth       getWidth = width(this['fields'])                :(RETURN)
getHeight      getHeight = height(this['fields'])              :(RETURN)
setWidth       width(this['fields']) = newwidth                :(RETURN)
setHeight      height(this['fields']) = newheight              :(RETURN)
drawRectangle  OUTPUT = "Drawing a Rectangle at:("
+                 getX(this) "," getY(this)
+                 "), width " getWidth(this)
+                 ", height " getHeight(this)                  :(RETURN)
RECTANGLE_END

*  try shapes procedure
START
*     create some shape instances
               scribble = ARRAY('2')
               scribble[1] = makeRectangle(10,20,5,6)
               scribble[2] = makeCircle(15,25,8)

*     iterate through the list and handle shapes polymorphically
               i = 1
LOOP           each = scribble[i]                              :F(LOOP_END)
               draw(each)
               rMoveTo(each, 100, 100)
               draw(each)
               i = i + 1                                       :(LOOP)
LOOP_END

*     call a rectangle specific function
               arect = makeRectangle(0,0,15,15)
               setWidth(arect, 30)
               draw(arect)
END

Output

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

Chris Rathman / Chris.Rathman@tx.rr.com