Spatial.hs

   1 module Spatial where
   2
   3 import Data.Set (Set)
   4 import qualified Data.Set as Set
   5 import Data.IntMap (IntMap)
   6 import qualified Data.IntMap as IM
   7 import Data.Maybe
   8 import qualified Data.Stream as Sm
   9 import Data.List
  10
  11 import Piece
  12 import Coord
  13 import Image
  14 import TwoIntSet
  15
  16 {-
  17 data structure to hide the details of spatial search
  18 and collision semantics
  19
  20 at first it will be inefficient, hopefully later it
  21 can be replaced with a real spatial search structure
  22 like a quadtree (somehow)
  23 -}
  24
  25
  26 data Spatial = Spatial {
  27   piecemap :: IntMap Piece,
  28   collisions :: TwoIntSet
  29 }
  30
  31 --
  32 internalInteractions :: Spatial ->([(Piece,Piece)], [(Piece,Piece)], Spatial)
  33 internalInteractions (Spatial pm cols) = (os, ds, Spatial pm' cols') where
  34   os = map f (Set.elems diff)
  35   ds = []
  36   cols' = s1
  37   pm' = pm
  38   s0 = cols
  39   diff = s1 Set.\\ s0
  40   s1 = Set.fromList intpairs
  41   f (Two (n,m)) = (l n, l m)
  42   l x = fromMaybe (error emsg) (IM.lookup x pm)
  43   emsg = "???"
  44   intpairs = map (\(p,q) -> Two (key p, key q)) overlaps
  45   overlaps = computeCollisions pm
  46
  47 moveEverything :: Spatial -> Spatial
  48 moveEverything s = s { piecemap = m' } where
  49   m = piecemap s
  50   m' = IM.filter f . IM.map g . IM.filter h $ m
  51   h = isJust . absolute m
  52   g p = p {
  53     path = tail (path p),
  54     graphics = Sm.tail (graphics p),
  55     wakeup = IM.map Sm.tail (wakeup p)
  56   }
  57   f = not . null . path
  58
  59
  60 allPieces :: Spatial -> [Piece]
  61 allPieces s = IM.elems (piecemap s)
  62
  63 pokePiece :: Piece -> Collision -> Spatial -> (Spatial, [Operation])
  64 pokePiece p c s = (s', rs) where
  65   m = piecemap s
  66   (p',rs) = (transfer p) p c
  67   m' =
  68     if null (path p')
  69       then IM.delete (key p') m
  70       else IM.insert (key p') p' m
  71   s' = s { piecemap = m' }
  72
  73 spawnPieces :: [Piece] -> Spatial -> Spatial
  74 spawnPieces ps s = s' where
  75   s' = s
  76
  77 --
  78
  79
  80 snapShotPieces :: Spatial -> [(Image, Coord)]
  81 snapShotPieces s = catMaybes mbyImgXys where
  82   pcs = sort (allPieces s)
  83   mbyImgXys = map f pcs
  84   f p = absolute (piecemap s)  p >>= \xy -> return (Sm.head (graphics p), xy)
  85
  86
  87
  88 -- this will crash if there is cyclic dependency in
  89 -- relative piece positions
  90 absolute :: IntMap Piece -> Piece -> Maybe Coord
  91 absolute m p = do
  92   x <- listToMaybe (path p)
  93   case anchor p of
  94     Nothing -> return x
  95     Just n -> do
  96       op <- IM.lookup n m
  97       o <- absolute m op
  98       return (o + x)
  99
 100
 101 absoluteBound :: IntMap Piece -> Piece -> Bound
 102 absoluteBound m p = (o + xy, wh) where
 103   o = fromMaybe (error emsg) (absolute m p)
 104   (xy,wh) = bounding p
 105   emsg = "absoluteBound of nowhere"
 106
 107
 108 areColliding :: IntMap Piece -> Piece -> Piece -> Bool
 109 areColliding m p1 p2 = overlap (absoluteBound m p1) (absoluteBound m p2)
 110
 111 computeCollisions :: IntMap Piece -> [(Piece, Piece)]
 112 computeCollisions m =
 113   [
 114     (x,y) |
 115     (x:xs) <- tails (IM.elems m),
 116     y <- xs,
 117     areColliding m x y
 118   ]