Scheme

; define the shape class
(define (make-shape newx newy)
  (let (
        (x newx)
        (y newy))

    (lambda (method parms)
      (cond
        ; accessors for x & y
        ((eq? method 'getx) x)
        ((eq? method 'gety) y)
        ((eq? method 'setx) (set! x parms))
        ((eq? method 'sety) (set! y parms))

        ; move the x & y coordinates
        ((eq? method 'moveto)
         (set! x (car parms))
         (set! y (car (cdr parms))))

        ((eq? method 'rmoveto)
         (set! x (+ x (car parms)))
         (set! y (+ y (car (cdr parms))))))
      )
    )
  )


; define the circle class
(define (make-circle newx newy newradius)
  (let (
        (super (make-shape newx newy))
        (radius newradius))

    (lambda (method parms)
      (cond
        ; accessors for radius
        ((eq? method 'getradius) radius)
        ((eq? method 'setradius) (set! radius parms))

        ; draw the circle
        ((eq? method 'draw)
         (display "Drawing a Circle at:(")
         (display (super 'getx ()))
         (display ",")
         (display (super 'gety ()))
         (display "), radius ")
         (display radius)
         (newline)
         )

        (else (super method parms)))
      )
    )
  )


; define the rectangle class
(define (make-rectangle newx newy newwidth newheight)
  (let (
        (super (make-shape newx newy))
        (width newwidth)
        (height newheight))

    (lambda (method parms)
      (cond
        ; accessors for width & height
        ((eq? method 'getwidth) width)
        ((eq? method 'getheight) height)
        ((eq? method 'setwidth) (set! width parms))
        ((eq? method 'setheight) (set! height parms))

        ; draw the rectangle
        ((eq? method 'draw)
         (display "Drawing a Rectangle at:(")
         (display (super 'getx ()))
         (display ",")
         (display (super 'gety ()))
         (display "), width ")
         (display width)
         (display ", height ")
         (display height)
         (newline)
         )

        (else (super method parms)))
      )
    )
  )


; iterate through the list of shapes
(define drawloop
  (lambda (shape)
    ((car shape) 'draw ())
    ((car shape) 'rmoveto '(100 100))
    ((car shape) 'draw ())
    (if (null? (cdr shape))
        ()
        (drawloop (cdr shape)))
    )
  )


; test polymorphism in Scheme
(define (polymorph)
  (let (
        ; create a list containing various shape instances
        (scribble (list (make-rectangle 10 20 5 6) (make-circle 15 25 8)))

        ; create a rectangle instance
        (arect (make-rectangle 0 0 15 15)))

    ; iterate through the list of shapes and handle polymorphically
    (drawloop scribble)

    ; call a rectangle specific function
    (arect 'setwidth 30)
    (arect 'draw ()))
  )

(polymorph)

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