{-# LANGUAGE TypeFamilies #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Wumpus.Basic.Shapes.Coordinate -- Copyright : (c) Stephen Tetley 2010 -- License : BSD3 -- -- Maintainer : Stephen Tetley -- Stability : highly unstable -- Portability : GHC -- -- Coordinate is a bit like a shape but does not generate a path -- and cannot be scaled or rotated (it can be translated). -- -- \*\* WARNING \*\* - the types of Shapes and Coordinate are not -- ideal and are pending revision. -- -------------------------------------------------------------------------------- module Wumpus.Basic.Shapes.Coordinate ( CoordinateAnchor , DCoordinateAnchor , Coordinate , DCoordinate , coordinate , coordinateMark ) where import Wumpus.Basic.Anchors import Wumpus.Basic.Graphic import Wumpus.Core -- package: wumpus-core -------------------------------------------------------------------------------- -- | Coordinate data CoordinateAnchor u = CoordinateAnchor { coord_x :: !u , coord_y :: !u } deriving (Eq,Ord,Show) type DCoordinateAnchor = CoordinateAnchor Double type instance DUnit (CoordinateAnchor u) = u newtype Coordinate u = Coordinate { getCoordinate :: CoordinateAnchor u } deriving (Eq,Ord,Show) type DCoordinate = Coordinate Double type instance DUnit (Coordinate u) = u instance (Real u, Floating u) => CenterAnchor (CoordinateAnchor u) where center (CoordinateAnchor x y) = P2 x y instance Num u => Translate (Coordinate u) where translate dx dy = Coordinate . fn . getCoordinate where fn (CoordinateAnchor x y) = CoordinateAnchor (x+dx) (y+dy) -- Need a differentiation at the type level between a coord -- that can be translated (moved) and a coord that anchors... coordinate :: Num u => Point2 u -> Coordinate u coordinate (P2 x y) = Coordinate $ CoordinateAnchor { coord_x = x, coord_y = y } -- Note - should @coordinate@ take a point, Shapes don\'t. coordinateMark :: (Real u, Floating u) => Coordinate u -> Image u (CoordinateAnchor u) coordinateMark x = intoImage (return $ getCoordinate x) (drawCoord x) drawCoord :: (Real u, Floating u) => Coordinate u -> Graphic u drawCoord coord = localize bothStrokeColour $ filledEllipse 2 2 (center $ getCoordinate coord)