Contributed by Chris Rathman (based on help from Andreas Rossberg)
See also: Alice ML - Using Functors
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(); |
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 |