-------------------------------------------------------------------------
-- 
--  Haskell: The Craft of Functional Programming, 3e
--  Simon Thompson
--  (c) Addison-Wesley, 1996-2011.
-- 
--  Chapter 1
-- 
--  The Pictures example code is given in the file Pitures.hs.
--  This file can be used by importing it; more details are given in
--  Chapter 2.
-- 
-------------------------------------------------------------------------

module Chapter1 where
import Pictures hiding (rotate)

-- A first definition, of the integer value, size.

size :: Integer
size :: Integer
size = Integer
12Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
13

-- Some definitions using Pictures.

-- Inverting the colour of the horse picture, ...

blackHorse :: Picture
blackHorse :: Picture
blackHorse = Picture -> Picture
invertColour Picture
horse

-- ... rotating the horse picture, ...

rotateHorse :: Picture
rotateHorse :: Picture
rotateHorse = Picture -> Picture
flipH (Picture -> Picture
flipV Picture
horse)

-- Some function definitions.

-- To square an integer, ...

square :: Integer -> Integer
square :: Integer -> Integer
square Integer
n = Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n

-- ... to double an integer, and ...

double :: Integer -> Integer
double :: Integer -> Integer
double Integer
n = Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n

-- ... to rotate a picture we can perform the two reflections,
-- and so we define

rotate :: Picture -> Picture
rotate :: Picture -> Picture
rotate Picture
pic = Picture -> Picture
flipH (Picture -> Picture
flipV Picture
pic)

-- A different definition of rotateHorse can use rotate

rotateHorse1 :: Picture
rotateHorse1 :: Picture
rotateHorse1 = Picture -> Picture
rotate Picture
horse

-- where the new definition is of a different name: you can't change a definition
-- in a script.

-- Defining rotate a different way, as a composition of functions; see the
-- diagram in the book for a picture of what's going on.

rotate1 :: Picture -> Picture
rotate1 :: Picture -> Picture
rotate1 = Picture -> Picture
flipH (Picture -> Picture) -> (Picture -> Picture) -> Picture -> Picture
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Picture -> Picture
flipV

-- Pictures 

-- The definitions of the functions modelling pictures are in the file
-- Pictures.hs.

-- Tests and properties

-- The functions test_rotate, prop_rotate etc are in the Pictures.hs module