add PlaySound(soundType, hogGearUID) -- this roundabout way to reference a team seems to be how things are done in lua right now. might need changing in future
module Store( ElemIndex(), MStore(), IStore(), newStore, addElem, removeElem, readElem, writeElem, modifyElem, elemExists, firstIndex, indicesM, withIStore, withIStore2, (!), indices ) whereimport qualified Data.Array.IArray as IAimport qualified Data.Array.IO as IOAimport qualified Data.IntSet as IntSetimport Data.IORefimport Control.Monadnewtype ElemIndex = ElemIndex Int deriving (Eq, Show, Read, Ord)newtype MStore e = MStore (IORef (IntSet.IntSet, IntSet.IntSet, IOA.IOArray Int e))newtype IStore e = IStore (IntSet.IntSet, IA.Array Int e)firstIndex :: ElemIndexfirstIndex = ElemIndex 0-- MStore codeinitialSize :: IntinitialSize = 10growFunc :: Int -> IntgrowFunc a = a * 3 `div` 2newStore :: IO (MStore e)newStore = do newar <- IOA.newArray_ (0, initialSize - 1) new <- newIORef (IntSet.empty, IntSet.fromAscList [0..initialSize - 1], newar) return (MStore new)growStore :: MStore e -> IO ()growStore (MStore ref) = do (busyElems, freeElems, arr) <- readIORef ref (_, m') <- IOA.getBounds arr let newM' = growFunc (m' + 1) - 1 newArr <- IOA.newArray_ (0, newM') sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- [0..m']] writeIORef ref (busyElems, freeElems `IntSet.union` (IntSet.fromAscList [m'+1..newM']), newArr)growIfNeeded :: MStore e -> IO ()growIfNeeded m@(MStore ref) = do (_, freeElems, _) <- readIORef ref when (IntSet.null freeElems) $ growStore maddElem :: MStore e -> e -> IO ElemIndexaddElem m@(MStore ref) element = do growIfNeeded m (busyElems, freeElems, arr) <- readIORef ref let (n, freeElems') = IntSet.deleteFindMin freeElems IOA.writeArray arr n element writeIORef ref (IntSet.insert n busyElems, freeElems', arr) return $ ElemIndex nremoveElem :: MStore e -> ElemIndex -> IO ()removeElem (MStore ref) (ElemIndex n) = do (busyElems, freeElems, arr) <- readIORef ref IOA.writeArray arr n (error $ "Store: no element " ++ show n) writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr)readElem :: MStore e -> ElemIndex -> IO ereadElem (MStore ref) (ElemIndex n) = readIORef ref >>= \(_, _, arr) -> IOA.readArray arr nwriteElem :: MStore e -> ElemIndex -> e -> IO ()writeElem (MStore ref) (ElemIndex n) el = readIORef ref >>= \(_, _, arr) -> IOA.writeArray arr n elmodifyElem :: MStore e -> (e -> e) -> ElemIndex -> IO ()modifyElem (MStore ref) f (ElemIndex n) = do (_, _, arr) <- readIORef ref IOA.readArray arr n >>= IOA.writeArray arr n . felemExists :: MStore e -> ElemIndex -> IO BoolelemExists (MStore ref) (ElemIndex n) = do (_, free, _) <- readIORef ref return $ n `IntSet.notMember` freeindicesM :: MStore e -> IO [ElemIndex]indicesM (MStore ref) = do (busy, _, _) <- readIORef ref return $ map ElemIndex $ IntSet.toList busy-- A way to see MStore elements in pure code via IStorem2i :: MStore e -> IO (IStore e)m2i (MStore ref) = do (a, _, c') <- readIORef ref c <- IOA.unsafeFreeze c' return $ IStore (a, c)i2m :: (MStore e) -> IStore e -> IO ()i2m (MStore ref) (IStore (_, arr)) = do (b, e, _) <- readIORef ref a <- IOA.unsafeThaw arr writeIORef ref (b, e, a)withIStore :: MStore e -> (IStore e -> a) -> IO awithIStore m f = do i <- m2i m let res = f i res `seq` i2m m i return reswithIStore2 :: MStore e1 -> MStore e2 -> (IStore e1 -> IStore e2 -> a) -> IO awithIStore2 m1 m2 f = do i1 <- m2i m1 i2 <- m2i m2 let res = f i1 i2 res `seq` i2m m1 i1 i2m m2 i2 return res-- IStore code(!) :: IStore e -> ElemIndex -> e(!) (IStore (_, arr)) (ElemIndex i) = (IA.!) arr iindices :: IStore e -> [ElemIndex]indices (IStore (busy, _)) = map ElemIndex $ IntSet.toList busy