Add files for Exercise 6

This commit is contained in:
Manuel Thalmann 2024-06-16 22:32:20 +02:00
parent 326ab69152
commit 31032ddf60
3 changed files with 199 additions and 0 deletions

View file

@ -0,0 +1,23 @@
module Matrix (Matrix (..), Point, Vector, scale, invert, apply) where
type Point = (Float, Float)
type Vector = Point
data Matrix = Matrix (Float, Float) (Float, Float)
deriving (Show)
scale :: Float -> Matrix -> Matrix
scale r (Matrix (a, b) (c, d)) = Matrix (r * a, r * b) (r * c, r * d)
invert :: Matrix -> Matrix
invert (Matrix (a, b) (c, d)) =
scale
(1 / (a * d - b * c))
(Matrix (d, -b) (-c, a))
apply :: Matrix -> Vector -> Vector
apply (Matrix (a, b) (c, d)) (x, y) =
( a * x + b * y,
c * x + d * y
)

View file

@ -0,0 +1,173 @@
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) ->
error "Fixme"
{- Inverting
Inverting a shape i.e. switching outside vs inside
-}
negate :: Shape -> Shape
negate s = error "Fixme"
{- 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 = error "Fixme"
{-
All points that in at least one of the shapes
-}
merge :: Shape -> Shape -> Shape
merge = error "Fixme"
{-
All points in the first shape that are not in the secnond shape
-}
minus :: Shape -> Shape -> Shape
minus = error "Fixme"
{- 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

BIN
Exercises/exercise-6/exercise-6.pdf (Stored with Git LFS) Normal file

Binary file not shown.