module Wumpus.Drawing.Shapes.Rectangle
(
Rectangle
, DRectangle
, rectangle
) where
import Wumpus.Drawing.Geometry.Intersection
import Wumpus.Drawing.Geometry.Paths
import Wumpus.Drawing.Paths
import Wumpus.Drawing.Shapes.Base
import Wumpus.Basic.Kernel
import Wumpus.Core
import Control.Applicative
data Rectangle u = Rectangle
{ rect_ctm :: ShapeCTM u
, rect_hw :: !u
, rect_hh :: !u
}
deriving (Eq,Ord,Show)
type DRectangle = Rectangle Double
type instance DUnit (Rectangle u) = u
mapRectangleCTM :: (ShapeCTM u -> ShapeCTM u) -> Rectangle u -> Rectangle u
mapRectangleCTM f = (\s i -> s { rect_ctm = f i }) <*> rect_ctm
instance Num u => Scale (Rectangle u) where
scale sx sy = mapRectangleCTM (scale sx sy)
instance Rotate (Rectangle u) where
rotate ang = mapRectangleCTM (rotate ang)
instance (Real u, Floating u) => RotateAbout (Rectangle u) where
rotateAbout ang pt = mapRectangleCTM (rotateAbout ang pt)
instance Num u => Translate (Rectangle u) where
translate dx dy = mapRectangleCTM (translate dx dy)
runRectangle :: (u -> u -> ShapeCTM u -> a) -> Rectangle u -> a
runRectangle fn (Rectangle { rect_ctm = ctm, rect_hw = hw, rect_hh = hh }) =
fn hw hh ctm
instance (Real u, Floating u) => CenterAnchor (Rectangle u) where
center = runRectangle (\ _ _ -> ctmCenter)
instance (Real u, Floating u) => CardinalAnchor (Rectangle u) where
north = runRectangle $ \_ hh -> projectPoint $ P2 0 hh
south = runRectangle $ \_ hh -> projectPoint $ P2 0 (hh)
east = runRectangle $ \hw _ -> projectPoint $ P2 hw 0
west = runRectangle $ \hw _ -> projectPoint $ P2 (hw) 0
instance (Real u, Floating u) => CardinalAnchor2 (Rectangle u) where
northeast = runRectangle $ \hw hh -> projectPoint $ P2 hw hh
southeast = runRectangle $ \hw hh -> projectPoint $ P2 hw (hh)
southwest = runRectangle $ \hw hh -> projectPoint $ P2 (hw) (hh)
northwest = runRectangle $ \hw hh -> projectPoint $ P2 (hw) hh
instance (Real u, Floating u) => RadialAnchor (Rectangle u) where
radialAnchor theta = runRectangle $ \hw hh ->
projectPoint $ rectangleIntersect hw hh theta
rectangleIntersect :: (Real u, Floating u)
=> u -> u -> Radian -> Point2 u
rectangleIntersect hw hh theta =
maybe zeroPt id $ findIntersect zeroPt theta $ rectangleLines zeroPt hw hh
rectangle :: (Real u, Floating u, FromPtSize u)
=> u -> u -> LocShape u (Rectangle u)
rectangle w h =
intoLocShape (mkRectangle (0.5*w) (0.5*h))
(mkRectPath (0.5*w) (0.5*h))
mkRectangle :: Num u => u -> u -> LocCF u (Rectangle u)
mkRectangle hw hh = promoteR1 $ \ctr ->
pure $ Rectangle { rect_ctm = makeShapeCTM ctr
, rect_hw = hw
, rect_hh = hh
}
mkRectPath :: (Real u, Floating u, FromPtSize u)
=> u -> u -> LocCF u (Path u)
mkRectPath hw hh = promoteR1 $ \ctr ->
let btm_left = displace (hw) (hh) ctr
in roundCornerShapePath $ rectangleCoordPath (2*hw) (2*hh) btm_left