picture language exercises

picture-language.hs

module Chap2.PictureLanguage where

-- data Painter

-- 2.2.4 Example: A Picture Language
beside :: a -> a -> a
beside a b = undefined

below :: a -> a -> a
below bottom top = undefined


flipVert :: a -> a
flipVert painter = undefined

flipHoriz :: a -> a
flipHoriz painter = undefined


---------------------------------------
-----  Ex. 2.44 -----
upSplit painter n =
    if n == 0 then painter
    else
        let smaller = upSplit painter (n - 1)
        in below painter (beside smaller smaller)
---------------------------------------


flippedPairs painter =
    let painter2 = beside painter (flipVert painter)
    in  below painter2 painter2


rightSplit painter n =
    if n == 0 then painter
    else
        let smaller = rightSplit painter (n - 1)
        in beside painter (below smaller smaller)


cornerSplit painter n =
    if n == 0 then painter
    else
        let
            up          = upSplit painter (n - 1)
            right       = rightSplit painter (n - 1)
            topLeft     = beside up up
            corner      = cornerSplit painter (n - 1)
            bottomRight = below right right
        in
            beside (below painter topLeft) (below bottomRight corner)


squareLimit painter n =
    let
        quarter = cornerSplit painter n
        half = beside (flipHoriz quarter) quarter
    in
        below (flipVert half) half


squareOfFour tl tr bl br painter =
    let
        top    = beside (tl painter) (tr painter)
        bottom = beside (bl painter) (br painter)
    in
        below bottom top

-- Ex 2.45
split :: (Num n, Eq n) => (a -> a -> a) -> (a -> a -> a) -> a -> n -> a
split f g painter n =
    if n == 0 then painter
    else
        let smaller = split f g painter (n - 1)
        in f painter (g smaller smaller)




----

originFrame (MakeFrame a b c) = a
edge1Frame (MakeFrame a b c)  = b
edge2Frame (MakeFrame a b c)  = c

frameCoordMap :: Frame -> Vec2 -> Vec2
frameCoordMap frame v =
    addVec
        (originFrame frame)
        (addVec
            (scaleVec (xcor v) (edge1Frame frame))
            (scaleVec (ycor v) (edge2Frame frame))
        )


-- Ex. 2.46
data Vec2 = Vec2 { xcor :: Int, ycor :: Int } deriving (Show, Eq)

addVec (Vec2 x1 y1) (Vec2 x2 y2) = Vec2 (x1 + x2) (y1 + y2)
subVec (Vec2 x1 y1) (Vec2 x2 y2) = Vec2 (x1 - x2) (y1 - y2)
scaleVec s (Vec2 x1 y1) = Vec2 (s*x1) (s*y1)

(|+|) :: Vec2 -> Vec2 -> Vec2
v1 |+| v2 = addVec v1 v2


-- Ex. 2.47
--  make-frame
data Frame = MakeFrame Vec2 Vec2 Vec2 deriving (Show, Eq)


---- Ex 2.48 -----------
type Segment = (Vec2, Vec2)
startSegment (v1, v2) = v1
endSegment (v1, v2) = v2
--------------

drawLine :: Vec2 -> Vec2 -> IO ()
drawLine v1 v2 = print $ vec2string v1 ++ " --> " ++ vec2string v2

vec2string (Vec2 a b) = "(" ++ show a ++ "," ++ show b ++ ")"

segments2painter :: [Segment] -> Frame -> IO ()
segments2painter segmentsList frame =
    mapM_ draw segmentsList
    where
        toFrame = frameCoordMap frame
        draw :: Segment -> IO ()
        draw segment =
            drawLine
                (toFrame (startSegment segment))
                (toFrame (endSegment segment))


f = MakeFrame (Vec2 0 0) (Vec2 2 0) (Vec2 0 1)
ss =  [(Vec2 0 0, Vec2 1 0), (Vec2 1 0, Vec2 1 1)]

-- segments2painter ss f