REBOL

REBOL [
   Title: "Shape Polymorphism"
   Date:   6-Jun-2000
   Author: "Chris Rathman"
   Version: 1.0.0
]

make-shape: func [
   newx [number!]
   newy [number!]
][
   return make object! [
      x: newx
      y: newy

      ; accessors for x & y
      getX: func [] [return x]
      getY: func [] [return y]
      setX: func [newx [number!]] [x: newx]
      setY: func [newy [number!]] [y: newy]

      ; move the x & y position of the object
      moveTo: func [newx [number!] newy [number!]] [
         setX newx
         setY newy
      ]
      rMoveTo: func [deltax [number!] deltay [number!]] [
         moveTo (deltaX + getX) (deltaY + getY)
      ]
   ]
]

make-rectangle: func [
   newx [number!]
   newy [number!]
   newwidth [number!]
   newheight [number!]
][
   return make (make-shape newx newy) [
      width: newwidth
      height: newheight

      ; accessors for width & height
      getWidth: func [] [return width]
      getHeight: func [] [return height]
      setWidth: func [newwidth [number!]] [width: newwidth]
      setHeight: func [newheight [number!]] [height: newheight]

      ; draw the rectangle
      draw: func [] [
         prin "Drawing a Rectangle at:("
         prin getX
         prin ","
         prin getY
         prin "), width "
         prin getWidth
         prin ", height "
         print getHeight
      ]
   ]
]

make-circle: func [
   newx [number!]
   newy [number!]
   newradius [number!]
][
   return make (make-shape newx newy) [
      radius: newradius

      ; accessors for the radius
      getRadius: func [] [return radius]
      setRadius: func [newradius [number!]] [radius: newradius]

      ; draw the circle
      draw: func [] [
         prin "Drawing a Circle at:("
         prin getX
         prin ","
         prin getY
         prin "), radius "
         print getRadius
      ]
   ]
]

; set up some shape instances
scribble: array [2]
scribble/1: make-rectangle 10 20 5 6
scribble/2: make-circle 15 25 8

; iterate through the array and handle shapes polymorphically
foreach item scribble [
   item/draw
   item/rMoveTo 100 100
   item/draw
]

; access a rectangle specific function
a-rectangle: make-rectangle 0 0 15 15
a-rectangle/setWidth 30
a-rectangle/draw

>> do %shape.r
Script: "Shape Polymorphism" (6-Jun-2000)
Drawing a Rectangle at:(10,20), width 5, height 6
Drawing a Rectangle at:(110,120), width 5, height 6
Drawing a Circle at:(15,25), radius 8
Drawing a Circle at:(115,125), radius 8
Drawing a Rectangle at:(0,0), width 30, height 15