module Wumpus.Drawing.Shapes.InvTriangle
(
InvTriangle
, DInvTriangle
, invtriangle
) where
import Wumpus.Drawing.Shapes.Base
import Wumpus.Drawing.Shapes.Triangle
import Wumpus.Basic.Geometry.Base
import Wumpus.Basic.Kernel
import Wumpus.Core
newtype InvTriangle u = InvTriangle { getInvTriangle :: Triangle u }
type instance DUnit (InvTriangle u) = u
type DInvTriangle = InvTriangle Double
instance Functor InvTriangle where
fmap f = InvTriangle . fmap f . getInvTriangle
mapInner :: (Triangle u -> Triangle u) -> InvTriangle u -> InvTriangle u
mapInner f = InvTriangle . f . getInvTriangle
instance (Real u, Floating u) => Rotate (InvTriangle u) where
rotate ang = mapInner (rotate ang)
instance (Real u, Floating u) => RotateAbout (InvTriangle u) where
rotateAbout ang pt = mapInner (rotateAbout ang pt)
instance Fractional u => Scale (InvTriangle u) where
scale sx sy = mapInner (scale sx sy)
instance InterpretUnit u => Translate (InvTriangle u) where
translate dx dy = mapInner (translate dx dy)
runRotateAnchor :: (Real u, Floating u)
=> (Triangle u -> Anchor u) -> InvTriangle u -> Anchor u
runRotateAnchor f (InvTriangle a) =
let ctr = center a in rotateAbout pi ctr (f a)
instance (Real u, Floating u) =>
CenterAnchor (InvTriangle u) where
center = center . getInvTriangle
instance (Real u, Floating u) =>
ApexAnchor (InvTriangle u) where
apex = runRotateAnchor apex
instance (Real u, Floating u) =>
TopCornerAnchor (InvTriangle u) where
topLeftCorner = runRotateAnchor bottomRightCorner
topRightCorner = runRotateAnchor bottomLeftCorner
instance (Real u, Floating u) =>
SideMidpointAnchor (InvTriangle u) where
sideMidpoint n a = step (n `mod` 3)
where
step 1 = midpoint (topRightCorner a) (topLeftCorner a)
step 2 = midpoint (topLeftCorner a) (apex a)
step _ = midpoint (apex a) (topRightCorner a)
instance (Real u, Floating u) =>
CardinalAnchor (InvTriangle u) where
north = runRotateAnchor south
south = runRotateAnchor north
east = runRotateAnchor west
west = runRotateAnchor east
instance (Real u, Floating u) =>
CardinalAnchor2 (InvTriangle u) where
northeast = runRotateAnchor southwest
southeast = runRotateAnchor northwest
southwest = runRotateAnchor northeast
northwest = runRotateAnchor southeast
instance (Real u, Floating u) =>
RadialAnchor (InvTriangle u) where
radialAnchor theta = runRotateAnchor (radialAnchor $ circularModulo $ pi+theta)
invtriangle :: (Real u, Floating u, InterpretUnit u, Tolerance u)
=> u -> u -> Shape InvTriangle u
invtriangle bw h =
shapeMap InvTriangle $ updatePathAngle (+ pi) $ triangle bw h