Alice ML - Using Records

Contributed by Chris Rathman (based on help from Andreas Rossberg)

See also: Alice ML - Using Functors

Alice ML Script

type shape = { getX    : unit -> int,
               getY    : unit -> int,
               setX    : int -> unit,
               setY    : int -> unit,
               moveTo  : int * int -> unit,
               rMoveTo : int * int -> unit,
               draw    : unit -> unit }

signature SHAPE =
   sig
      val new : int * int * (unit -> unit) -> shape
   end

structure Shape :> SHAPE =
   struct
      fun new (x, y, draw) =
         let
            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)
            val draw = draw
         in
            { getX, getY, setX, setY, moveTo, rMoveTo, draw }
         end
   end

type rectangle = { super     : shape,
                   getX      : unit -> int,
                   getY      : unit -> int,
                   setX      : int -> unit,
                   setY      : int -> unit,
                   moveTo    : int * int -> unit,
                   rMoveTo   : int * int -> unit,
                   draw      : unit -> unit,
                   getWidth  : unit -> int,
                   getHeight : unit -> int,
                   setWidth  : int -> unit,
                   setHeight : int -> unit }

signature RECTANGLE =
   sig
      val new : int * int * int * int -> rectangle
   end

structure Rectangle :> RECTANGLE =
   struct
      fun new (x, y, width, height) =
         let
            val draw = Promise.promise()
            val super = Shape.new(x, y, Promise.future draw)
            val getX = #getX super
            val getY = #getY super
            val setX = #setX super
            val setY = #setY super
            val moveTo = #moveTo super
            val rMoveTo = #rMoveTo super
            val width = ref width
            val height = ref height
            fun getWidth () = !width
            fun getHeight () = !height
            fun setWidth width' = width := width'
            fun setHeight height' = height := height'
            val _ = Promise.fulfill(draw,
               fn () => print("Drawing a Rectangle at:(" ^ Int.toString(getX()) ^ "," ^ Int.toString(getY()) ^
                  "), Width " ^ Int.toString(getWidth()) ^ ", Height " ^ Int.toString(getHeight()) ^ "\n"))
         in
            { super, getX, getY, setX, setY, moveTo, rMoveTo, draw=(Promise.future draw),
               getWidth, getHeight, setWidth, setHeight }
         end
   end

type circle = { super     : shape,
                getX      : unit -> int,
                getY      : unit -> int,
                setX      : int -> unit,
                setY      : int -> unit,
                moveTo    : int * int -> unit,
                rMoveTo   : int * int -> unit,
                draw      : unit -> unit,
                getRadius : unit -> int,
                setRadius : int -> unit }

signature CIRCLE =
   sig
      val new : int * int * int -> circle
   end

structure Circle :> CIRCLE =
   struct
      fun new (x, y, radius) =
         let
            val draw = Promise.promise()
            val super = Shape.new(x, y, Promise.future draw)
            val getX = #getX super
            val getY = #getY super
            val setX = #setX super
            val setY = #setY super
            val moveTo = #moveTo super
            val rMoveTo = #rMoveTo super
            val radius = ref radius
            fun getRadius () = !radius
            fun setRadius radius' = radius := radius'
            val _ = Promise.fulfill(draw,
               fn () => print("Drawing a Circle at:(" ^ Int.toString(getX()) ^ "," ^ Int.toString(getY()) ^
                  "), Radius " ^ Int.toString(getRadius()) ^ "\n"))
         in
            { super, getX, getY, setX, setY, moveTo, rMoveTo, draw=(Promise.future draw), getRadius, setRadius }
         end
   end

fun drawLoop (s : shape) =
   let in
      #draw s();
      #rMoveTo s(100, 100);
      #draw s()
   end

fun polymorph () =
   let
      (* create some packed shape instances *)
      val scribble = [#super (Rectangle.new(10, 20, 5, 6)),
                      #super (Circle.new(15, 25, 8))]
      val rect = Rectangle.new(0, 0, 15, 15)
   in
      (* iterate through the list and handle shapes polymorphically *)
      List.map drawLoop scribble;

      (* call a rectangle specific function *)
      #setWidth rect(30);
      #draw rect()
   end;

polymorph();

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:(15,25), Radius 8
Drawing a Circle at:(115,125), Radius 8
Drawing a Rectangle at:(0,0), Width 30, Height 15

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