module Asteroids.Geometry( Figure(..), -- data Figure = Rect Dimension Dimension -- | Triangle Dimension Angle Dimension -- | Polygon [Point] -- | Circle Dimension -- | Translate Point Figure -- | Scale Double Figure -- | Rotate Angle Figure -- deriving (Eq, Ord, Show) draw, -- :: Figure-> Graphic Shape, -- abstract shape, -- :: Figure -> Shape drawShape, -- :: Figure-> Graphic contains, -- :: Shape-> Point-> Bool intersect, -- :: Shape-> Shape-> Bool polar, -- :: Double-> Angle-> Point smult, -- :: Double-> Point-> Point add, -- :: Point-> Point-> Point len, -- :: Point-> Double rot -- :: Angle-> Point-> Point ) where import Graphics.HGL.Units (Angle(), Point()) import Graphics.HGL.Draw.Picture (ellipse, polygon) import Graphics.HGL.Draw.Monad (Graphic()) import Data.List (nub) -- to make ghc happy -- delete for hugs fromInt :: Num a=> Int-> a fromInt n = fromInteger \$ toInteger n -- unchanged bits from previous version type Dimension = Int data Figure = Rect Dimension Dimension | Triangle Dimension Angle Dimension | Polygon [Point] | Circle Dimension | Translate Point Figure | Scale Double Figure | Rotate Angle Figure deriving (Eq, Ord, Show) smult :: Double-> Point-> Point smult f (x, y) | f == 1 = (x, y) | otherwise = (round (f* fromInt x), round (f* fromInt y)) add :: Point-> Point-> Point add (x1, y1) (x2, y2) = (x1+ x2, y1+ y2) rot :: Angle-> Point-> Point rot w (x, y) | w == 0 = (x, y) | otherwise = (round (x'* cos w+ y'* sin w), round (-x' * sin w + y'* cos w)) where x' = fromInt x; y'= fromInt y data Shape = Poly [Point] | Circ Point Double deriving (Eq, Show) shape :: Figure-> Shape shape = fig' ((0, 0), 1, 0) where fig' :: (Point, Double, Angle)-> Figure-> Shape fig' (m, r, phi) (Translate t f) = fig' (add m (smult r (rot phi t)), r, phi) f fig' (m, r, phi) (Scale s f) = fig' (m, r* s, phi) f fig' (m, r, phi) (Rotate w f) = fig' (m, r, phi+ w) f fig' c (Rect a b) = poly c [(x2, y2), (-x2, y2), (-x2, -y2), (x2, -y2)] where x2= a `div` 2; y2= b `div` 2 fig' c (Triangle l1 a l2) = poly c [(0, 0), (0, l1), rot a (0, l2)] fig' c (Polygon pts) = poly c pts fig' (m, r, _) (Circle d) = Circ m (r*fromInt d) poly :: (Point, Double, Angle)-> [Point]-> Shape poly (m, p, w) = Poly. chckcls. map (add m. smult p. rot w) where chckcls [] = [] chckcls x = if (head x) == (last x) then x else x++ [head x] drawShape :: Shape-> Graphic drawShape (Poly pts) = polygon pts drawShape (Circ (mx, my) r) = ellipse (mx-r', my- r') (mx+ r', my+ r') where r'= round r draw :: Figure-> Graphic draw = drawShape . shape contains :: Shape-> Point-> Bool contains (Poly pts)= inP pts contains (Circ c r)= inC c r inC :: Point-> Double-> Point-> Bool inC (mx, my) r (px, py) = len (px- mx, py- my) <= r len :: Point-> Double len (x, y)= sqrt (fromInt (x^(2::Int)+ y^(2::Int))) det :: Point-> (Point, Point)-> Int det (cx,cy) ((ax,ay), (bx,by)) = signum ((by-ay)*(cx-bx)-(cy-by)*(bx-ax)) sides :: [Point]-> [(Point, Point)] sides ps | length ps < 2 = [] | otherwise = (head ps, head (tail ps)): sides (tail ps) inP :: [Point]-> Point-> Bool inP ps c = (length. nub. map (det c). sides) ps == 1 intersect :: Shape-> Shape-> Bool intersect (Poly p) (Circ c r)= inP p c || any (inC c r) p intersect (Circ c r) (Poly p)= inP p c || any (inC c r) p intersect (Poly p1) (Poly p2)= any (inP p1) p2 || any (inP p2) p1 intersect (Circ (mx1, my1) r1) (Circ (mx2, my2) r2)= len (mx2- mx1, my2- my1) <= r1+ r2 polar :: Double-> Angle-> Point polar r phi = rot phi (round r, 0)