module Wumpus.Basic.Kernel.Objects.Orientation
(
RectAddress(..)
, Orientation(..)
, orientationStart
, orientationBounds
, extendOrientation
, extendOLeft
, extendORight
, extendODown
, extendOUp
, padHEven
, padXMinor
, padXMajor
, padVEven
, padYMajor
, padYMinor
, spineRight
, spineBelow
, halignBottomO
, halignCenterO
, halignTopO
, valignLeftO
, valignCenterO
, valignRightO
, spinemoveH
, spinemoveV
, binmoveHBottom
, binmoveHCenter
, binmoveHTop
, binmoveVLeft
, binmoveVCenter
, binmoveVRight
) where
import Wumpus.Basic.Kernel.Base.BaseDefs
import Wumpus.Core
import Data.Monoid
data RectAddress = CENTER
| NN | SS | EE | WW | NE | NW | SE | SW
| BLL | BLC | BLR
deriving (Enum,Eq,Ord,Show)
data Orientation u = Orientation
{ or_x_minor :: !u
, or_x_major :: !u
, or_y_minor :: !u
, or_y_major :: !u
}
deriving (Eq,Ord,Show)
instance Functor Orientation where
fmap f (Orientation xmin xmaj ymin ymaj) =
Orientation (f xmin) (f xmaj) (f ymin) (f ymaj)
instance (Fractional u, Ord u) => OPlus (Orientation u) where
oplus = concatOrientation
instance (Fractional u, Ord u) => Monoid (Orientation u) where
mempty = Orientation 0 0 0 0
mappend = concatOrientation
concatOrientation :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
concatOrientation op0 op1 = Orientation hw hw hh hh
where
(hw0,hh0) = halfDists op0
(hw1,hh1) = halfDists op1
hw = max hw0 hw1
hh = max hh0 hh1
halfDists :: Fractional u => Orientation u -> (u,u)
halfDists (Orientation xmin xmaj ymin ymaj) =
(0.5 * (xmin+xmaj), 0.5 * (ymin+ymaj))
orientationStart :: Fractional u => RectAddress -> Orientation u -> Vec2 u
orientationStart rpos (Orientation xmin xmaj ymin ymaj) = go rpos
where
w = xmin + xmaj
h = ymin + ymaj
hw = 0.5 * w
hh = 0.5 * h
go CENTER = V2 ((hw) + xmin) ((hh) + ymin)
go NN = V2 ((hw) + xmin) ((h) + ymin)
go SS = V2 ((hw) + xmin) ymin
go EE = V2 ((w) + xmin) ((hh) + ymin)
go WW = V2 xmin ((hh) + ymin)
go NE = V2 (xmaj) (ymaj)
go SE = V2 (xmaj) ymin
go SW = V2 xmin ymin
go NW = V2 xmin (ymaj)
go BLL = V2 xmin 0
go BLC = V2 ((hw) + xmin) 0
go BLR = V2 ((w) + xmin) 0
orientationBounds :: Num u
=> Orientation u -> Point2 u -> BoundingBox u
orientationBounds (Orientation xmin xmaj ymin ymaj) (P2 x y) = BBox llc urc
where
llc = P2 (xxmin) (yymin)
urc = P2 (x+xmaj) (y+ymaj)
extendOrientation :: Num u
=> u -> u -> u -> u -> Orientation u -> Orientation u
extendOrientation dxl dxr dyd dyu (Orientation xmin xmaj ymin ymaj) =
Orientation (xmin+dxl) (xmaj+dxr) (ymin+dyd) (ymaj+dyu)
extendOLeft :: Num u => u -> Orientation u -> Orientation u
extendOLeft u (Orientation xmin xmaj ymin ymaj) =
Orientation (u+xmin) xmaj ymin ymaj
extendORight :: Num u => u -> Orientation u -> Orientation u
extendORight u (Orientation xmin xmaj ymin ymaj) =
Orientation xmin (u+xmaj) ymin ymaj
extendODown :: Num u => u -> Orientation u -> Orientation u
extendODown u (Orientation xmin xmaj ymin ymaj) =
Orientation xmin xmaj (u+ymin) ymaj
extendOUp :: Num u => u -> Orientation u -> Orientation u
extendOUp u (Orientation xmin xmaj ymin ymaj) =
Orientation xmin xmaj ymin (u+ymaj)
padHEven :: (Fractional u, Ord u)
=> u -> Orientation u -> Orientation u
padHEven w ortt@(Orientation xmin xmaj _ _) =
if w > ow then ortt { or_x_minor = xmin + hdx
, or_x_major = xmaj + hdx }
else ortt
where
ow = xmin + xmaj
hdx = 0.5 * (w ow)
padXMinor :: (Num u, Ord u)
=> u -> Orientation u -> Orientation u
padXMinor w ortt@(Orientation xmin xmaj _ _) =
if w > ow then ortt { or_x_minor = xmin + dx } else ortt
where
ow = xmin + xmaj
dx = w ow
padXMajor :: (Num u, Ord u)
=> u -> Orientation u -> Orientation u
padXMajor w ortt@(Orientation xmin xmaj _ _) =
if w > ow then ortt { or_x_major = xmaj + dx } else ortt
where
ow = xmin + xmaj
dx = w ow
padVEven :: (Fractional u, Ord u)
=> u -> Orientation u -> Orientation u
padVEven h ortt@(Orientation _ _ ymin ymaj) =
if h > oh then ortt { or_y_minor = ymin + hdy
, or_y_major = ymaj + hdy }
else ortt
where
oh = ymin + ymaj
hdy = 0.5 * (h oh)
padYMinor :: (Num u, Ord u)
=> u -> Orientation u -> Orientation u
padYMinor h ortt@(Orientation _ _ ymin ymaj) =
if h > oh then ortt { or_y_minor = ymin + dy } else ortt
where
oh = ymin + ymaj
dy = h oh
padYMajor :: (Num u, Ord u)
=> u -> Orientation u -> Orientation u
padYMajor h ortt@(Orientation _ _ ymin ymaj) =
if h > oh then ortt { or_y_major = ymaj + dy } else ortt
where
oh = ymin + ymaj
dy = h oh
spineRight :: (Num u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
spineRight (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
Orientation { or_x_minor = xmin0
, or_x_major = xmaj0 + xmin1 + xmaj1
, or_y_minor = max ymin0 ymin1
, or_y_major = max ymaj0 ymaj1
}
spineBelow :: (Num u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
spineBelow (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
Orientation { or_x_minor = max xmin0 xmin1
, or_x_major = max xmaj0 xmaj1
, or_y_minor = ymin0 + ymaj1 + ymin1
, or_y_major = ymaj0
}
halignBottomO :: (Num u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
halignBottomO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let hr = ymin1 + ymaj1
in Orientation { or_x_minor = xmin0
, or_x_major = xmaj0 + xmin1 + xmaj1
, or_y_minor = ymin0
, or_y_major = max ymaj0 (hr ymin0)
}
halignCenterO :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
halignCenterO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let hl = ymin0 + ymaj0
hr = ymin1 + ymaj1
half_diff = 0.5 * (hr hl)
in Orientation
{ or_x_minor = xmin0
, or_x_major = xmaj0 + xmin1 + xmaj1
, or_y_minor = if hl >= hr then ymin0 else (ymin0 + half_diff)
, or_y_major = if hl >= hr then ymaj0 else (ymaj0 + half_diff)
}
halignTopO :: (Num u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
halignTopO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let hr = ymin1 + ymaj1
in Orientation { or_x_minor = xmin0
, or_x_major = xmaj0 + xmin1 + xmaj1
, or_y_minor = max ymin0 (hr ymaj0)
, or_y_major = ymaj0
}
valignLeftO :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
valignLeftO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let wr = xmin1 + xmaj1
in Orientation { or_x_minor = xmin0
, or_x_major = max xmaj0 (wr xmin0)
, or_y_minor = ymin0 + ymin1 + ymaj1
, or_y_major = ymaj0
}
valignCenterO :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
valignCenterO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let wl = xmin0 + xmaj0
wr = xmin1 + xmaj1
half_diff = 0.5 * (wr wl)
in Orientation
{ or_x_minor = if wl >= wr then xmin0 else (xmin0 + half_diff)
, or_x_major = if wl >= wr then xmaj0 else (xmaj0 + half_diff)
, or_y_minor = ymin0 + ymin1 + ymaj1
, or_y_major = ymaj0
}
valignRightO :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Orientation u
valignRightO (Orientation xmin0 xmaj0 ymin0 ymaj0)
(Orientation xmin1 xmaj1 ymin1 ymaj1) =
let wr = xmin1 + xmaj1
in Orientation { or_x_minor = max xmin0 (wr xmaj0)
, or_x_major = xmaj0
, or_y_minor = ymin0 + ymin1 + ymaj1
, or_y_major = ymaj0
}
upDown :: Num u => u -> u -> u
upDown u d = u d
downUp :: Num u => u -> u -> u
downUp d u = negate d + u
spinemoveH :: Num u => Orientation u -> Orientation u -> Vec2 u
spinemoveH op0 op1 = V2 hdist 0
where
hdist = or_x_major op0 + or_x_minor op1
spinemoveV :: Num u => Orientation u -> Orientation u -> Vec2 u
spinemoveV op0 op1 = V2 0 (negate vdist)
where
vdist = or_y_minor op0 + or_y_major op1
binmoveHBottom :: Num u => Orientation u -> Orientation u -> Vec2 u
binmoveHBottom op0 op1 = V2 hdist vdist
where
hdist = or_x_major op0 + or_x_minor op1
vdist = downUp (or_y_minor op0) (or_y_minor op1)
binmoveHCenter :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Vec2 u
binmoveHCenter (Orientation _ xmaj0 ymin0 ymaj0)
(Orientation xmin1 _ ymin1 ymaj1) =
V2 hdist vdist
where
h0 = ymin0 + ymaj0
h1 = ymin1 + ymaj1
half_diff = abs $ 0.5 * (h1 h0)
hdist = xmaj0 + xmin1
vdist = if h0 >= h1 then downUp ymin0 (half_diff + ymin1)
else upDown (ymaj0 + half_diff) ymaj1
binmoveHTop :: Num u => Orientation u -> Orientation u -> Vec2 u
binmoveHTop op0 op1 = V2 hdist vdist
where
hdist = or_x_major op0 + or_x_minor op1
vdist = upDown (or_y_major op0) (or_y_major op1)
leftRight :: Num u => u -> u -> u
leftRight l r = negate l + r
rightLeft :: Num u => u -> u -> u
rightLeft r l = r l
binmoveVLeft :: Num u => Orientation u -> Orientation u -> Vec2 u
binmoveVLeft op0 op1 = V2 hdist vdist
where
hdist = leftRight (or_x_minor op0) (or_x_minor op1)
vdist = negate $ or_y_minor op0 + or_y_major op1
binmoveVCenter :: (Fractional u, Ord u)
=> Orientation u -> Orientation u -> Vec2 u
binmoveVCenter (Orientation xmin0 xmaj0 ymin0 _)
(Orientation xmin1 xmaj1 _ ymaj1) =
V2 hdist vdist
where
w0 = xmin0 + xmaj0
w1 = xmin1 + xmaj1
half_diff = abs $ 0.5 * (w1 w0)
hdist = if w0 >= w1 then leftRight xmin0 (half_diff + xmin1)
else rightLeft (xmaj0 + half_diff) xmaj1
vdist = negate $ ymin0 + ymaj1
binmoveVRight :: Num u => Orientation u -> Orientation u -> Vec2 u
binmoveVRight op0 op1 = V2 hdist vdist
where
hdist = rightLeft (or_x_major op0) (or_x_major op1)
vdist = negate $ or_y_minor op0 + or_y_major op1