Goo

(use goo)

;; define the shape class
(dc <shape> (<any>))
   ;; define the shape class properties
   (dp x (<shape> => <int>) 0)
   (dp y (<shape> => <int>) 0)

   ;; accessors for x & y
   (dm get-x (self|<shape>) (x self))
   (dm get-y (self|<shape>) (y self))
   (dm set-x (self|<shape> new-x|<int>) (set (x self) new-x))
   (dm set-y (self|<shape> new-y|<int>) (set (y self) new-y))

   ;; move the x & y coordinates
   (dm move-to (self|<shape> new-x|<int> new-y|<int>)
      (set-x self new-x)
      (set-y self new-y))
   (dm r-move-to (self|<shape> delta-x|<int> delta-y|<int>)
      (move-to self (+ (get-x self) delta-x) (+ (get-y self) delta-y)))

   ;; draw the shape - abstract
   (dg draw (self|<shape>))

;; export the class and methods
(export <shape> x y get-x get-y set-x set-y move-to r-move-to draw)

(use goo)
(use shape)

;; define the rectangle class
(dc <rectangle> (<shape>))
   ;; define the rectangle class properties
   (dp width (<rectangle> => <int>) 0)
   (dp height (<rectangle> => <int>) 0)

   ;; accessors for width & height
   (dm get-width (self|<rectangle>) (width self))
   (dm get-height (self|<rectangle>) (height self))
   (dm set-width (self|<rectangle> new-width|<int>) (set (width self) new-width))
   (dm set-height (self|<rectangle> new-height|<int>) (set (height self) new-height))

   ;; draw the rectangle
   (dm draw (self|<rectangle>)
      (msg out "Drawing a Rectangle at:(%=,%=) width %=, height %=\n"
         (get-x self) (get-y self) (get-width self) (get-height self)))

;; export the class and methods
(export <rectangle> width height get-width get-height set-width set-height draw)

(use goo)
(use shape)

;; define the circle class
(dc <circle> (<shape>))
   ;; define the circle class properties
   (dp radius (<circle> => <int>) 0)

   ;; accessors for radius
   (dm get-radius (self|<circle>) (radius self))
   (dm set-radius (self|<circle> new-radius|<int>) (set (radius self) new-radius))

   ;; draw the circle
   (dm draw (self|<circle>)
      (msg out "Drawing a Circle at:(%=,%=) radius %=\n"
         (get-x self) (get-y self) (get-radius self)))

;; export the class and methods
(export <circle> radius get-radius set-radius draw)

(use goo)
(use shape)
(use circle)
(use rectangle)

;; function to test the polymorphism
(df polymorph ()
   ;; create a collection containing various shape instances
   (dv scribble (fab <vec> 1))
   (set (elt scribble 0) (new <rectangle> x 10 y 20 width 5 height 6))
   (set (elt scribble 1) (new <circle> x 15 y 25 radius 8))

   ;; iterate through the list of shapes and handle polymorphically
   (do
      (fun (each)
         (draw each)
         (r-move-to each 100 100)
         (draw each))
      scribble)

   ;; create a rectangle instance
   (def arect (new <rectangle> x 0 y 0 width 15 height 15))

   ;; call a rectangle specific function
   (set-width arect 30)
   (draw arect))

;; export the function for further use
(export polymorph)

(use polymorph)
(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