mandulia-0.8.0.1: src/Bounds.hs

{-
Mandulia -- Mandelbrot/Julia explorer
Copyright (C) 2010  Claude Heiland-Allen <claude@mathr.co.uk>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module Bounds(
  Bounds(), bounds, corners, center,
  bottomLeft, bottomRight, topLeft, topRight,
  left, right, above, below,
  leftOrEqual, rightOrEqual, aboveOrEqual, belowOrEqual,
  outside, inside, insideOrEqual, overlap,
  transform, transform', expand, diagonal,
  into
) where

import Data.List (foldl')

import Vector

data Bounds = Bounds{ bottomLeft :: !V, topRight :: !V }
  deriving (Show, Read, Eq, Ord)

topLeft :: Bounds -> V
topLeft box =
  let V x _ _ = bottomLeft box
      V _ y _ = topRight   box
  in  V x y 1

bottomRight :: Bounds -> V
bottomRight box =
  let V x _ _ = topRight   box
      V _ y _ = bottomLeft box
  in  V x y 1

bounds :: [V] -> Bounds
bounds [] = error "Bounds.bounds []"
bounds (V u v _ : vs) =
  let f (a, b, c, d) (V x y _) = (min a x, max b x, min c y, max d y)
      (x0, x1, y0, y1) = foldl' f (u, u, v, v) vs
  in  Bounds{ bottomLeft = V x0 y0 1, topRight = V x1 y1 1 }

corners :: Bounds -> [V]
corners box =
  map ($ box) [topLeft, topRight, bottomLeft, bottomRight]

center :: Bounds -> V
center box = (bottomLeft box ^+^ topRight box) ^/ 2

expand :: R -> Bounds -> Bounds
expand z box =
  let c = center box
      t v = ((v ^-^ c) ^* z) ^+^ c
  in  bounds . map (t . ($ box)) $ [bottomLeft, topRight]

left  :: V -> V -> Bool
left  (V u _ _) (V x _ _) = u < x

right :: V -> V -> Bool
right (V u _ _) (V x _ _) = u > x

above :: V -> V -> Bool
above (V _ v _) (V _ y _) = v > y

below :: V -> V -> Bool
below (V _ v _) (V _ y _) = v < y

leftOrEqual  :: V -> V -> Bool
leftOrEqual  (V u _ _) (V x _ _) = u <= x

rightOrEqual :: V -> V -> Bool
rightOrEqual (V u _ _) (V x _ _) = u >= x

aboveOrEqual :: V -> V -> Bool
aboveOrEqual (V _ v _) (V _ y _) = v >= y

belowOrEqual :: V -> V -> Bool
belowOrEqual (V _ v _) (V _ y _) = v <= y

outside :: Bounds -> Bounds -> Bool
outside box region =
  bottomLeft box `above` topRight   region ||
  bottomLeft box `right` topRight   region ||
  topRight   box `below` bottomLeft region ||
  topRight   box `left`  bottomLeft region

inside  :: Bounds -> Bounds -> Bool
inside  box region =
  bottomLeft box `above` bottomLeft region &&
  bottomLeft box `right` bottomLeft region &&
  topRight   box `below` topRight   region &&
  topRight   box `left`  topRight   region

insideOrEqual :: Bounds -> Bounds -> Bool
insideOrEqual box region =
  bottomLeft box `aboveOrEqual` bottomLeft region &&
  bottomLeft box `rightOrEqual` bottomLeft region &&
  topRight   box `belowOrEqual` topRight   region &&
  topRight   box `leftOrEqual`  topRight   region

overlap :: Bounds -> Bounds -> Bool
overlap box region =
  not (box `inside` region || box `outside` region)

transform :: M -> Bounds -> Bounds
transform m = bounds . map (m ^^*^) . corners

-- transform' precondition: m's rotation is a multiple of pi/2
transform' :: M -> Bounds -> Bounds
transform' m bs = bounds [ m ^^*^ bottomLeft bs, m ^^*^ topRight bs ]

diagonal :: Bounds -> R
diagonal box = topRight box ^|-|^ bottomLeft box

into :: Bounds -> Bounds -> M
into box region =
  let V x0 y0 _ = center box
      V x1 y1 _ = center region
      s = diagonal region / diagonal box
  in  translate x1 y1 ^^*^^ scale s s ^^*^^ translate (-x0) (-y0)