zhaw-fup/Exercises/exercise-6/Shapes.hs

module Shape where

import Data.List
import Matrix (Matrix (Matrix), Vector, Point, invert, apply)

{- Definition of 'Shape'
    Shapes are things that discriminate between outside and inside
-}
newtype Shape = Shape { inside :: Point -> Bool }

{- Basic Shapes
    These are the basic shapes used to construct more complicated shapes
-}

{-
    A simple empty shape
-}
empty :: Shape
empty = Shape $ const False

{-
    A disc with radius 1 located at (0,0)
-}
unitDisc :: Shape
unitDisc = Shape $ \(x, y) ->
    x^2 + y^2 <= 1

{-
    A square with length/width 1 located at (0,0)
-}
unitSq :: Shape
unitSq = Shape $ \(x, y) ->
    abs x <= 1 && abs y <= 1

{- Manipulations
   Functions to change and combine existing shapes into new shapes
-}

{- Translation
    Moving a shape along a vector
-}
translate :: Vector -> Shape -> Shape
translate (dx, dy) s = Shape $ \(x, y) ->
    inside s (x + dx, y + dy)

{- Inverting
    Inverting a shape i.e. switching outside vs inside
-}
negate :: Shape -> Shape
negate s = Shape $ \ (x, y) -> not (inside s (x, y))

{- General combinator
    Combining two shapes with a parametric boolean function
-}
combineBool
    :: (Bool -> Bool -> Bool)
    -> Shape
    -> Shape
    -> Shape
combineBool f s1 s2 = Shape $ \p -> f (f1 p) (f2 p)
    where
        f1 = inside s1
        f2 = inside s2

{-
    All points that are in both shapes
-}
intersect :: Shape -> Shape -> Shape
intersect s1 s2 = Shape $ \ (x, y) -> all (\ s -> inside s (x, y)) [s1, s2]

{-
    All points that in at least one of the shapes
-}
merge :: Shape -> Shape -> Shape
merge s1 s2 = Shape $ \ (x, y) -> any (\ s -> inside s (x, y)) [s1, s2]

{-
    All points in the first shape that are not in the second shape
-}
minus :: Shape -> Shape -> Shape
minus s1 s2 = Shape $ \ (x, y) -> inside s1 (x, y) && not (inside s1 (x, y))


{- Matrix transformations
    Applying a matrix/linear transformation to a shape
-}
transformM :: Matrix -> Shape -> Shape
transformM m s = Shape $ \p ->
    inside s $ apply m' p
    where
        m' = invert m

{-
    Stretch a shape along the X axis
-}
stretchX :: Float -> Shape -> Shape
stretchX r = transformM $ Matrix (r, 0) (0, 1)

{-
    Stretch a shape along the Y axis
-}
stretchY :: Float -> Shape -> Shape
stretchY r = transformM $ Matrix (1, 0) (0, r)

{-
    Stretch a shape
-}
stretch :: Float -> Shape -> Shape
stretch r = transformM $ Matrix (r, 0) (0, r)

{-
    Mirror a shape at the X-axis
-}
flipX :: Shape -> Shape
flipX = transformM (Matrix (1, 0) (0, -1))

{-
    Mirror a shape at the Y-axis
-}
flipY :: Shape -> Shape
flipY = transformM (Matrix (-1, 0) (0, 1))


flip45 :: Shape -> Shape
flip45 = transformM (Matrix (0, 1) (1, 0))

{-
    Mirror a shape at the origin
-}
flip0 :: Shape -> Shape
flip0 = transformM (Matrix (-1, 0) (0, -1))


{-
    Rotate a shape around the origin
-}
rotate :: Float -> Shape -> Shape
rotate a = transformM $ Matrix
        (cos a, -(sin a))
        (sin a, cos a)

{- Semantics
    Here we render/interpret shapes in terms of "ASCII-Art" text files
-}

render :: Float -> Float -> Shape -> IO ()
render length height shape = writeFile "shape.txt" lines
    where
        draw p
            | inside shape p = ('#', p)
            | otherwise = (' ', p)

        breakLn (d, (x,y))
            | x == length = [d,'\n']
            | otherwise = [d]

        pixels = [draw (x,y) | y <- [(-height)..height],  x <- [(-length)..length]]

        lines = concatMap breakLn pixels

{- Examples
--}

shape1 = translate (100, 100) $ stretch 10 unitDisc
shape2 = rotate 1 unitSq

shape3 = translate (100, 100) $ merge shape1 shape2

iShape = flipX $ merge
    (stretchY 2 unitSq)
    (translate (0, 5) unitDisc)

disc50 = stretch 50 unitDisc