module Wumpus.Drawing.Extras.Axes
(
orthontAxes
, horizontalLabels
, verticalLabels
) where
import Wumpus.Drawing.Connectors
import qualified Wumpus.Drawing.Connectors.ConnectorPaths as C
import Wumpus.Basic.Kernel
import Wumpus.Core
import Data.Monoid
orthontAxes :: (Real u, Floating u, InterpretUnit u)
=> (Int,Int) -> (Int,Int) -> LocGraphic u
orthontAxes (xl,xr) (yl,yr) = promoteLoc $ \(P2 x y) ->
snapmove (1,1) >>= \(V2 uw uh) ->
let conn1 = rightArrow barb45 connline
xPtl = P2 (x (uw * fromIntegral xl)) y
xPtr = P2 (x + (uw * fromIntegral xr)) y
yPtl = P2 x (y (uh * fromIntegral yl))
yPtr = P2 x (y + (uh * fromIntegral yr))
in localize cap_square $ ignoreAns (connect conn1 xPtl xPtr)
`mappend` ignoreAns (connect conn1 yPtl yPtr)
horizontalLabels :: (Num a, Fractional u, InterpretUnit u)
=> RectAddress -> [a] -> LocGraphic u
horizontalLabels addr ns =
snapmove (1,1) >>= \(V2 uw _) -> ignoreAns (runChainH uw $ mapM mf ns)
where
mf n = chain1 $ runPosObject addr $ posTextUpright $ show n
verticalLabels :: (Num a, Fractional u, InterpretUnit u)
=> RectAddress -> [a] -> LocGraphic u
verticalLabels addr ns =
snapmove (1,1) >>= \(V2 _ uh) -> ignoreAns (runChainV uh $ mapM mf ns)
where
mf n = chain1 $ runPosObject addr $ posTextUpright $ show n
connline :: (Real u, Floating u, InterpretUnit u) => ConnectorPathQuery u
connline = C.connline default_connector_props