{-# LANGUAGE BangPatterns #-}
module CodeWorld.DrawState where
import CodeWorld.Color
data DrawState
=
DrawState
!AffineTransformation
!(Maybe Color)
data AffineTransformation
= AffineTransformation !Double !Double !Double !Double !Double !Double
initialAffineTransformation :: AffineTransformation
initialAffineTransformation = AffineTransformation 1 0 0 1 0 0
mapDSAT :: (AffineTransformation -> AffineTransformation) -> DrawState -> DrawState
mapDSAT f (DrawState at mc) = DrawState (f at) mc
mapDSColor :: (Maybe Color -> Maybe Color) -> DrawState -> DrawState
mapDSColor f (DrawState at mc) = DrawState at (f mc)
initialDS :: DrawState
initialDS = DrawState initialAffineTransformation Nothing
translateDS :: Double -> Double -> DrawState -> DrawState
translateDS x y = mapDSAT $ \(AffineTransformation a b c d e f) ->
AffineTransformation
a
b
c
d
(a * x + c * y + e)
(b * x + d * y + f)
scaleDS :: Double -> Double -> DrawState -> DrawState
scaleDS x y = mapDSAT $ \(AffineTransformation a b c d e f) ->
AffineTransformation (x * a) (x * b) (y * c) (y * d) e f
rotateDS :: Double -> DrawState -> DrawState
rotateDS r = mapDSAT $ \(AffineTransformation a b c d e f) ->
AffineTransformation
(a * cos r + c * sin r)
(b * cos r + d * sin r)
(c * cos r - a * sin r)
(d * cos r - b * sin r)
e
f
reflectDS :: Double -> DrawState -> DrawState
reflectDS th = mapDSAT $ \(AffineTransformation a b c d e f) ->
AffineTransformation
(a * cos r + c * sin r)
(b * cos r + d * sin r)
(a * sin r - c * cos r)
(b * sin r - d * cos r)
e
f
where r = 2 * th
setColorDS :: Color -> DrawState -> DrawState
setColorDS col = mapDSColor $ \mcol ->
case (col, mcol) of
(_, Nothing) -> Just col
(RGBA _ _ _ 0, Just _) -> Just col
(RGBA _ _ _ a1, Just (RGBA r0 g0 b0 a0)) -> Just (RGBA r0 g0 b0 (a0 * a1))
opaqueDS :: DrawState -> DrawState
opaqueDS = mapDSColor $ fmap $ \(RGBA r g b _) -> RGBA r g b 1
getColorDS :: DrawState -> Maybe Color
getColorDS (DrawState _ col) = col