Contributed by Chris Rathman
Note: I could not figure out how to call one method from another method within the class. As a result, the accessors are not used by the methods within the class definitions.
module Shape where -- declare method interfaces for the shape superclass struct Shape = getX :: Cmd Int getY :: Cmd Int setX :: Int -> Cmd () setY :: Int -> Cmd () moveTo :: Int -> Int -> Cmd () rMoveTo :: Int -> Int -> Cmd () draw :: Cmd () |
module Rectangle where -- declare method interfaces for rectangle subclass struct Rectangle < Shape = getWidth :: Cmd Int getHeight :: Cmd Int setWidth :: Int -> Cmd () setHeight :: Int -> Cmd () -- declare the constructor for the rectangle class rectangle (env, initx, inity, initwidth, initheight) = -- slots for the object state variables template x := initx y := inity width := initwidth height := initheight -- define the methods for the rectangle class in struct -- accessors for x & y coordinates getX = request return x getY = request return y setX newx = action x := newx setY newy = action y := newy -- move the x & y coordinates moveTo newx newy = action x := newx y := newy rMoveTo deltax deltay = action x := x + deltax y := y + deltay -- accessors for width & height getWidth = request return width getHeight = request return height setWidth newwidth = action width := newwidth setHeight newheight = action height := newheight -- draw the rectangle draw = request env.putStr("Drawing a Rectangle at:(" ++ (show x) ++ "," ++ (show y) ++ "), width " ++ (show width) ++ ", height " ++ (show height) ++ "\n") |
module Circle where -- declare method interfaces for circle subclass struct Circle < Shape = getRadius :: Cmd Int setRadius :: Int -> Cmd () -- declare the constructor for the circle class circle (env, initx, inity, initradius) = -- slots for the object state variables template x := initx y := inity radius := initradius -- define the methods for the circle class in struct -- accessors for x & y coordinates getX = request return x getY = request return y setX newx = action x := newx setY newy = action y := newy -- move the x & y coordinates moveTo newx newy = action x := newx y := newy rMoveTo deltax deltay = action x := x + deltax y := y + deltay -- accessors for the radius getRadius = request return radius setRadius newradius = action radius := newradius -- draw the circle draw = request env.putStr("Drawing a Circle at:(" ++ (show x) ++ "," ++ (show y) ++ "), radius " ++ (show radius) ++ "\n") |
module Polymorph(main) where import Shape import Circle import Rectangle main env = do -- create some shape instances s1 <- (rectangle (env, 10, 20, 5, 6)) s2 <- (circle (env, 15, 25, 8)) let scribble = s1:s2:[] -- iterate through the list and handle shapes polymorphically drawloop scribble -- call a rectangle specific function r <- (rectangle (env, 0, 0, 15, 15)) r.setWidth 30 r.draw drawloop [] = return () drawloop (x:xs) = do x.draw x.rMoveTo 100 100 x.draw drawloop xs |
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 |