prune dead code
[maximus:mandulia.git] / src / Bounds.hs
1 {-
2 Mandulia -- Mandelbrot/Julia explorer
3 Copyright (C) 2010  Claude Heiland-Allen <claudiusmaximus@goto10.org>
4
5 This program is free software: you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation, either version 3 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program.  If not, see <http://www.gnu.org/licenses/>.
17 -}
18
19 module Bounds(
20   Bounds(), bounds, corners, center,
21   bottomLeft, bottomRight, topLeft, topRight,
22   left, right, above, below,
23   leftOrEqual, rightOrEqual, aboveOrEqual, belowOrEqual,
24   outside, inside, insideOrEqual, overlap,
25   transform, transform', expand, diagonal,
26   into
27 ) where
28
29 import Data.List (foldl')
30
31 import Vector
32
33 data Bounds = Bounds{ bottomLeft :: !V, topRight :: !V }
34   deriving (Show, Read, Eq, Ord)
35
36 topLeft :: Bounds -> V
37 topLeft box =
38   let V x _ _ = bottomLeft box
39       V _ y _ = topRight   box
40   in  V x y 1
41
42 bottomRight :: Bounds -> V
43 bottomRight box =
44   let V x _ _ = topRight   box
45       V _ y _ = bottomLeft box
46   in  V x y 1
47
48 bounds :: [V] -> Bounds
49 bounds [] = error "Bounds.bounds []"
50 bounds (V u v _ : vs) =
51   let f (a, b, c, d) (V x y _) = (min a x, max b x, min c y, max d y)
52       (x0, x1, y0, y1) = foldl' f (u, u, v, v) vs
53   in  Bounds{ bottomLeft = V x0 y0 1, topRight = V x1 y1 1 }
54
55 corners :: Bounds -> [V]
56 corners box =
57   map ($ box) [topLeft, topRight, bottomLeft, bottomRight]
58
59 center :: Bounds -> V
60 center box = (bottomLeft box ^+^ topRight box) ^/ 2
61
62 expand :: R -> Bounds -> Bounds
63 expand z box =
64   let c = center box
65       t v = ((v ^-^ c) ^* z) ^+^ c
66   in  bounds . map (t . ($ box)) $ [bottomLeft, topRight]
67
68 left  :: V -> V -> Bool
69 left  (V u _ _) (V x _ _) = u < x
70
71 right :: V -> V -> Bool
72 right (V u _ _) (V x _ _) = u > x
73
74 above :: V -> V -> Bool
75 above (V _ v _) (V _ y _) = v > y
76
77 below :: V -> V -> Bool
78 below (V _ v _) (V _ y _) = v < y
79
80 leftOrEqual  :: V -> V -> Bool
81 leftOrEqual  (V u _ _) (V x _ _) = u <= x
82
83 rightOrEqual :: V -> V -> Bool
84 rightOrEqual (V u _ _) (V x _ _) = u >= x
85
86 aboveOrEqual :: V -> V -> Bool
87 aboveOrEqual (V _ v _) (V _ y _) = v >= y
88
89 belowOrEqual :: V -> V -> Bool
90 belowOrEqual (V _ v _) (V _ y _) = v <= y
91
92 outside :: Bounds -> Bounds -> Bool
93 outside box region =
94   bottomLeft box `above` topRight   region ||
95   bottomLeft box `right` topRight   region ||
96   topRight   box `below` bottomLeft region ||
97   topRight   box `left`  bottomLeft region
98
99 inside  :: Bounds -> Bounds -> Bool
100 inside  box region =
101   bottomLeft box `above` bottomLeft region &&
102   bottomLeft box `right` bottomLeft region &&
103   topRight   box `below` topRight   region &&
104   topRight   box `left`  topRight   region
105
106 insideOrEqual :: Bounds -> Bounds -> Bool
107 insideOrEqual box region =
108   bottomLeft box `aboveOrEqual` bottomLeft region &&
109   bottomLeft box `rightOrEqual` bottomLeft region &&
110   topRight   box `belowOrEqual` topRight   region &&
111   topRight   box `leftOrEqual`  topRight   region
112
113 overlap :: Bounds -> Bounds -> Bool
114 overlap box region =
115   not (box `inside` region || box `outside` region)
116
117 transform :: M -> Bounds -> Bounds
118 transform m = bounds . map (m ^^*^) . corners
119
120 -- transform' precondition: m's rotation is a multiple of pi/2
121 transform' :: M -> Bounds -> Bounds
122 transform' m bs = bounds [ m ^^*^ bottomLeft bs, m ^^*^ topRight bs ]
123
124 diagonal :: Bounds -> R
125 diagonal box = topRight box ^|-|^ bottomLeft box
126
127 into :: Bounds -> Bounds -> M
128 into box region =
129   let V x0 y0 _ = center box
130       V x1 y1 _ = center region
131       s = diagonal region / diagonal box
132   in  translate x1 y1 ^^*^^ scale s s ^^*^^ translate (-x0) (-y0)