1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
{-# LANGUAGE CPP #-}
module Mask where
import Control.Monad
import Debug.Trace
import Data.Int
import qualified Data.List as List
import Data.List.Merge
-- Start index , count
newtype Mask = Mask [(Int32,Int32)]
deriving (Eq,Ord,Show)
subtr xs ys =
let xxs = concatMap (\(a,b) -> [(a,1),(b,2)]) xs
yys = concatMap (\(a,b) -> [(a,4),(b,3)]) ys
zzs = mergeL xxs yys -- xxx: we really want (comparing fst)
zs = foldr subtr4 (const []) zzs (False,False)
in filter (uncurry (/=)) $ pairs zs
subtr4 (x,1) f (False,iny) = (if not iny then (x:) else id) $ f (True,iny)
subtr4 (x,2) f (True,iny) = (if not iny then (x:) else id) $ f (False,iny)
subtr4 (x,3) f (inx,True) = (if inx then (x:) else id) $ f (inx,False)
subtr4 (x,4) f (inx,False) = (if inx then (x:) else id) $ f (inx,True)
subtr4 _ f inxy = f inxy
pairs :: [a] -> [(a,a)]
pairs (x:y:ys) = (x,y) : pairs ys
pairs _ = []
union1 ab [] = (ab,[])
union1 (a,b) ((x0,x):xs) =
if x0 <= b
then union1 (a,max x b) xs
else ((a,b),(x0,x):xs)
union [] ys = ys
union xs [] = xs
union xs@((x0,_):_) ys@((y0,_):_) | y0<x0 = union ys xs
union (x:xs) ys =
let (x',ys') = union1 x ys
(z@(_,e),xs') = union1 x' xs
in if all (\(f,_) -> e < f) (take 1 ys' ++ take 1 xs')
then z : union xs' ys'
else union (z:xs') ys'
endpts :: (Int32,Int32) -> (Int32,Int32)
endpts (x0,sz) = (x0,x0 + sz)
sized :: (Int32,Int32) -> (Int32,Int32)
sized (x0,x) = (x0, x - x0)
maskPlus :: Mask -> Mask -> Mask
maskPlus (Mask xs) (Mask ys) =
let zs = sized <$> union (endpts <$> xs) (endpts <$> ys)
in Mask zs
maskSubtract :: Mask -> Mask -> Mask
maskSubtract (Mask xs) (Mask ys) =
let zs = sized <$> subtr (endpts <$> xs) (endpts <$> ys)
in Mask zs
|
