Alice ML - Using Functors

exception Abstract

signature SHAPE =
   sig
      val getX      : unit -> int
      val getY      : unit -> int
      val setX      : int -> unit
      val setY      : int -> unit
      val moveTo    : int * int -> unit
      val rMoveTo   : int * int -> unit
      val draw      : unit -> unit
   end

functor Shape (val x:int val y:int) :> SHAPE =
   struct
      val x = ref x
      val y = ref y
      fun getX () = !x
      fun getY () = !y
      fun setX x' = x := x'
      fun setY y' = y := y'
      fun moveTo (x', y') = ( setX x'; setY y' )
      fun rMoveTo (dx, dy) = moveTo(!x + dx, !y + dy)
      fun draw () = raise Abstract
   end

signature RECTANGLE =
   sig
      include SHAPE
      val getWidth  : unit -> int
      val getHeight : unit -> int
      val setWidth  : int -> unit
      val setHeight : int -> unit
   end

functor Rectangle (val x:int val y:int val width:int val height:int) :> RECTANGLE =
   struct
      structure Shape = Shape (val x=x val y=y)
      open Shape
      val width = ref width
      val height = ref height
      fun getWidth () = !width
      fun getHeight () = !height
      fun setWidth width' = width := width'
      fun setHeight height' = height := height'
      fun draw () = print(
         "Drawing a Rectangle at:(" ^ Int.toString(getX()) ^ "," ^ Int.toString(getY()) ^
            "), Width " ^ Int.toString(getWidth()) ^ ", Height " ^ Int.toString(getHeight()) ^ "\n")
   end

signature CIRCLE =
   sig
      include SHAPE
      val getRadius : unit -> int
      val setRadius : int -> unit
   end

functor Circle (val x:int val y:int val radius:int) :> CIRCLE =
   struct
      structure Shape = Shape (val x=x val y=y)
      open Shape
      val radius = ref radius
      fun getRadius () = !radius
      fun setRadius radius' = radius := radius'
      fun draw () = print(
         "Drawing a Circle at:(" ^ Int.toString(getX()) ^ "," ^ Int.toString(getY()) ^
            "), Radius " ^ Int.toString(getRadius()) ^ "\n")
   end

fun drawLoop pShape =
   let
      structure S = unpack pShape : SHAPE
   in
      S.draw();
      S.rMoveTo(100, 100);
      S.draw()
   end

fun polymorph () =
   let
      (* create some shape instances *)
      val scribble = [pack (Rectangle(val x=10 val y=20 val width=5 val height=6)) : RECTANGLE,
                      pack (Circle(val x=15 val y=25 val radius=8)) : CIRCLE]
      structure Rect = Rectangle(val x=0 val y=0 val width=15 val height=15)

      (* example downcast *)
      structure R = unpack (hd scribble) : RECTANGLE
      structure C = unpack (hd (tl scribble)) : CIRCLE
   in
      (* iterate through the list and handle shapes polymorphically *)
      List.map drawLoop scribble;

      (* call a rectangle specific function *)
      Rect.setWidth(30);
      Rect.draw()
   end;

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