Modified frontend so that updating campaogn progress no longer changes current index of the mission combo box
Updated Animate.lua (forgot to copy it last time)
Mission 1: Fixed a bug where events would cause animations to stutter
Moved a crate
Made the princess and the elder pay attention to Leaks A Lot
Changed the name of the chief to Righteous Beard
Mission 2: -
Mission 3: Removed leftover debug lines
Solved a bug where Dense Cloud could not select weapons during final scene
Made the hogs fave each other during the final animation
Mission 4: Solved a bug where Dense Cloud would appear even if he's dead
{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving #-}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.Monadimport Control.DeepSeqnewtype ElemIndex = ElemIndex Int deriving (Eq, Show, Read, Ord, NFData)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 = 16growFunc :: Int -> IntgrowFunc a = a * 3 `div` 2truncFunc :: Int -> InttruncFunc a | a > growFunc initialSize = (a `div` 2) | otherwise = anewStore :: 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 mtruncateIfNeeded :: MStore e -> IO ()truncateIfNeeded (MStore ref) = do (busyElems, _, arr) <- readIORef ref (_, m') <- IOA.getBounds arr let newM' = truncFunc (m' + 1) - 1 when (newM' < m' && (not $ IntSet.null busyElems) && IntSet.findMax busyElems <= newM') $ do newArr <- IOA.newArray_ (0, newM') sequence_ [IOA.readArray arr i >>= IOA.writeArray newArr i | i <- IntSet.toList busyElems] writeIORef ref (busyElems, IntSet.fromAscList [0..newM'] `IntSet.difference` busyElems, newArr)addElem :: 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 m@(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) truncateIfNeeded mreadElem :: 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