--			Drawable shapes
-- An example of an abstract data type in Haskell. This example
-- does not use classes, modules or existential type extensions.
-- This code is designed for easy comparison with Shapes-no-oop.cc
-- Note how similar it turned out.

-- An existential type: it's defined solely by its behavior
data Shape = Shape { 
		draws:: IO (),
		offset_by:: (Float,Float) -> Shape,
		set_dim::   (Float,Float) -> Shape }

-- A collection of polymorphic values.
-- This should generally be [Shapes].
-- But we define it as a tuple of three shapes to match the definition
-- and the sample code of Shapes in Shapes-no-oop.cc
data Shapes = Shapes (Shape, Shape, Shape)

draw:: Shapes -> IO ()
draw (Shapes (s1,s2,s3)) = draws s1 >> draws s2 >> draws s3

pack:: Shapes -> Shapes
pack (Shapes (s1,s2,s3)) = 
	Shapes ( offset_by s1 (0,1),
		 offset_by s2 (2,3),
		 offset_by s3 (4,5) )

resize:: Shapes -> Shapes
resize (Shapes (s1,s2,s3)) =
	Shapes ( set_dim s1 (10,10),
		 set_dim s2 (10,11),
		 set_dim s3 (11,12) )


-- Two concrete instances of the existential Shape value

rectangle:: (Float,Float,Float,Float) -> Shape
rectangle (x,y,width,height) = if width == height
  then
    square(x,y,width)
  else Shape {
	draws = mapM_ putStr 
		  [ "Drawing a rectangle [", show x, ", ", show y,
		    "] - [", show (x+width),
		    ", ", show (y+height), "]\n" ],
	offset_by = \ (new_x,new_y) ->
		rectangle (x+new_x,y+new_y,width,height),
	set_dim = \ (new_width,new_height) ->
		rectangle (x,y,new_width,new_height) }

square:: (Float,Float,Float) -> Shape
square (x,y,size) = Shape {
	draws = mapM_ putStr 
		  [ "Drawing a square [", show x, ", ", show y,
		    "]  of size ", show size, "\n" ],
	offset_by = \ (new_x,new_y) ->
		square (x+new_x,y+new_y,size),
	set_dim = \ (new_width,new_height) ->
		rectangle (x,y,new_width,new_height) }
	

-- A sample test
main = do {
	putStrLn "Instantiating shapes...";
	let shapes = Shapes (rectangle (0,0,1,2),
			     rectangle (0,0,5,5),
			     rectangle (0,0,7,7))
	    shapes_packed = pack shapes
	    shapes_resized = resize shapes_packed
	in
	  do { putStrLn "Drawing ... some rectangles are actually squares";
	       draw shapes;
	       putStrLn "Packing ...";
	       draw shapes_packed;
	       putStrLn "Resizing ... rectangles turn squares and vice versa";
	       draw shapes_resized };
	putStrLn "\nAll done"
	}