From ec57713b3d4acea066c30cf4285339303860df01 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sat, 12 Nov 2016 22:25:47 +0100 Subject: Timers for use with probabilistic focus and without --- src/Main.hs | 134 +++++++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 106 insertions(+), 28 deletions(-) (limited to 'src/Main.hs') diff --git a/src/Main.hs b/src/Main.hs index 54ec08a..db49e14 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,6 +36,7 @@ import Data.Maybe import Data.Bool import Data.Monoid (All(..)) import Data.Ord +import Data.Ratio import Data.Foldable (toList) @@ -84,7 +85,7 @@ main = do , helpCommand "help" , cmd "entities" listEntities "List all entities" , cmd "tip" focusTip "Focus the entity at the top of the queue" - , cmd "ptip" pFocusTip "Focus a random entity" + , cmd "pTip" pFocusTip "Focus a random entity" , cmd "focus" setFocus "Focus a specific entity" , cmd "blur" blur "Focus no entity" , cmd "remove" remove "Remove the focused entity from the queue" @@ -98,6 +99,9 @@ main = do , cmd "test" rollTest "Roll a test using the stats of the currently focused entity" , cmd "combat" entitySeqVal "Roll sequence value for the current focus and enter combat" , cmd "combat'" factionSeqVal "Roll sequence values for all members of a faction and have them enter combat" + , cmd "timer" entityTimer "Set a timer associated with the current entity" + , cmd "pTimer" pEntityTimer "Set a timer associated with the current entity. Scale remaining time dynamically with the number of combatants" + , cmd "untimer" clearEntityTimer "Remove the timer associated with the current entity" , cmd "uncombat" clearEntitySeqVal "Drop the focused entity out of combat" , cmd "uncombat'" clearFactionSeqVal "Drop all members of a faction out of combat" , cmd "spend" spendSeq "Spend some of the current focus´ AP" @@ -117,13 +121,19 @@ main = do stateOutline :: Sh GameState String stateOutline = do st <- get - case st of - st | null (st ^. priorityQueue) -> return "" - | otherwise -> unlines <$> mapM table (st ^. gRounds') + time <- use gTimer + + unlines <$> sequence ( ( if not (null $ st ^. timers) || not (null $ st ^. gRounds') + then [ return $ "Round timer: " ++ show time ] + else [] + ) + ++ ( if not (null $ st ^. timers) then [ tTable ] else [] ) + ++ ( if not (null $ st ^. gRounds') then map table (st ^. gRounds') else [] ) + ) where table :: Int -> Sh GameState String table round = do - factions <- map (view faction') <$> use inhabitedFactions + factions <- map (view faction') <$> use combatFactions st <- get let roundStr 0 = "Current Round" @@ -147,6 +157,27 @@ stateOutline = do colsAllG top . ([maybe "" show $ view seqVal seq] :) <$> mapM factionColumn [0..(length factions - 1)] -- layoutTableToString <$> rowGs <*> pure (Just (roundStr round : factions, repeat def)) <*> pure (repeat def) <*> pure unicodeBoldHeaderS tableString <$> pure (repeat def) <*> pure unicodeBoldHeaderS <*> pure (titlesH $ roundStr round : factions) <*> rowGs + tTable :: Sh GameState String + tTable = do + factions <- map (view faction') <$> use combatFactions' + st <- get + let + time = st ^. gTimer + protoRows = groupBy ((==) `on` fst) $ st ^. timers + faction id = fromJust $ view eFaction <$> Map.lookup id (st ^. gEntities) + + rowGs :: Sh GameState [RowGroup] + rowGs = runListT $ do + rowGroup'@((t, _):_) <- ListT $ return protoRows + let + rowGroup = map snd rowGroup' + factionColumn i = runListT $ do + x <- ListT $ return rowGroup + guard $ factionIndex x == i + toDesc x + factionIndex id = fromJust $ elemIndex (view faction' $ faction id) factions + colsAllG top . ([show . round $ t ^. absTime - fromIntegral time] :) <$> mapM factionColumn [0..(length factions - 1)] + tableString <$> pure (repeat def) <*> pure unicodeBoldHeaderS <*> pure (titlesH $ ("Time left") : factions) <*> rowGs focusNotes :: GameState -> String focusNotes st @@ -190,25 +221,53 @@ stateMaintenance = do (_, _, True) -> lift . shellPutStrLn $ name ++ " is destroyed" gFocus' . eSeqVal .= Nothing -- gFocus .= Nothing + void $ do + newCount <- fromIntegral . length <$> use priorityQueue + lastCount <- fromIntegral <$> use gLastCount + time <- use gTimer + when (newCount /= lastCount) $ do + let + scale :: Entity -> Sh GameState Entity + scale entity = (execStateT ?? entity) $ do + eTimer . _Just %= scaleTimer time (newCount % (max 1 lastCount)) + gEntities <~ (mapM scale =<< use gEntities) + gLastCount <~ length <$> use priorityQueue void $ do round <- use gRound let finished sVal = fromMaybe False (previews (seqVal . _Just) (<= 0) sVal) || view (seqRound . _Wrapped) sVal /= round - allFinished <- getAll . foldMapOf (gEntities . each . eStats . sSequence . _Just) (All . finished) <$> get + allFinished <- getAll . foldMapOf (gEntities . each . eSeqVal . _Just) (All . finished) <$> get when allFinished $ do let advanceRound' :: EntityIdentifier -> Entity -> Sh GameState Entity advanceRound' ident entity = fmap (fromMaybe entity . (\(m, s) -> s <$ m)) . (runStateT ?? entity) . runMaybeT $ do - cRound <- MaybeT . preuse $ eStats . sSequence . _Just . seqRound . _Wrapped + cRound <- MaybeT . preuse $ eSeqVal . _Just . seqRound . _Wrapped guard $ cRound < 0 - cVal <- MaybeT . preuse $ eStats . sSequence . _Just . seqVal . _Just + cVal <- MaybeT . preuse $ eSeqVal . _Just . seqVal . _Just name <- lift . lift $ toName ident - nVal' <- MaybeT . preuse $ eStats . sSeqVal - nVal <- MaybeT . focusState eStats $ evalFormula' [name] nVal' - eStats . sSequence . _Just . seqVal . _Just += nVal - eStats . sSequence . _Just . seqRound . _Wrapped += 1 + (newEntity, nVal) <- lift . lift $ rollSeqVal entity name + put $ set eSeqVal nVal newEntity + when (cVal < 0) $ -- Carry over negative values from previous rounds + eSeqVal . _Just . seqVal . _Just += cVal + eSeqVal . _Just . seqRound . _Wrapped += 1 + advanceTimer :: Entity -> Sh GameState Entity + advanceTimer entity = (execStateT ?? entity) $ do + rTime <- lift $ use gTimer + eTimer . _Just . absTime -= fromIntegral rTime gRounds -= 1 - gEntities <~ (imapM advanceRound' =<< use gEntities) + gEntities <~ (mapM advanceTimer =<< imapM advanceRound' =<< use gEntities) + gTimer .= 0 + +rollSeqVal :: Entity -> String -> Sh GameState (Entity, Maybe SeqVal) +rollSeqVal entity name = do + let sVal = fromMaybe (val ignored ["Sequenzwert"] False) $ preview (eStats . sSeqVal) entity + (newEntity, sNum) <- evalFormula [name] entity sVal + round <- use gRound + let val = Just $ def + & set (seqRound . _Wrapped) round + & set seqVal (Just sNum) + & set seqEpsilon (entity ^. eStats . sSeqEpsilon) + return (newEntity, val) -- Query state listFactions, listEntities :: Sh GameState () @@ -220,18 +279,39 @@ focusTip, blur, pFocusTip :: Sh GameState () focusTip = gFocus <~ preuse tip blur = gFocus .= Nothing pFocusTip = do + nextTimer <- preuse $ timers . folding listToMaybe + time <- fromIntegral <$> use gTimer round <- use gRound let eWeight :: Maybe SeqVal -> Int eWeight sVal | preview (_Just . seqRound . _Wrapped) sVal == Just round - , (preview (_Just . seqVal . _Just) -> Just n) <- sVal = n + , (preview (_Just . seqVal . _Just) -> Just n) <- sVal = max 0 n | otherwise = 0 entities <- map (over _2 . view $ eSeqVal . to eWeight) . Map.toList <$> use gEntities - case entities of - [] -> gFocus .= Nothing - _ -> gFocus <~ Just <$> liftIO (enact $ makeEventProb entities) - + case nextTimer of + nextTimer + | Just timer <- nextTimer + , fst $ over _1 (\t -> t ^. absTime <= time) timer + -> gFocus .= Just (snd timer) + | null entities -> gFocus .= Nothing + | otherwise -> gFocus <~ Just <$> liftIO (enact $ makeEventProb entities) + +entityTimer, pEntityTimer :: Completable TimerLength -> Sh GameState () +entityTimer = entityTimer' Constant +pEntityTimer = entityTimer' Scaled +entityTimer' toTimer = withArg $ \(TimerLength origin n) -> do + time <- use gTimer + entities <- length <$> use priorityQueue + let + timer = case origin of + Absolute -> n + Now -> time + n + gFocus' . eTimer .= Just (scaleTimer time (max 1 $ fromIntegral entities) . toTimer $ fromIntegral timer) + +clearEntityTimer :: Sh GameState () +clearEntityTimer = gFocus' . eTimer .= Nothing + -- Manual focus setFocus :: Completable EntityIdentifier -> Sh GameState () setFocus = withArg $ \ident -> gFocus ?= ident @@ -346,21 +426,18 @@ clearFactionSeqVal = withArg $ \qFaction -> use gEntities >>= mapM_ (clearEntity entitySeqVal', clearEntitySeqVal' :: EntityIdentifier -> Sh GameState () entitySeqVal' ident = void . runMaybeT $ do entity <- MaybeT $ preuse (gEntities . ix ident) - let sVal = fromMaybe (val ignored ["Sequenzwert"] False) $ preview (eStats . sSeqVal) entity name <- toName ident - round <- use gRound - (newEntity, sNum) <- evalFormula [name] entity sVal - let val = Just $ def - & set (seqRound . _Wrapped) round - & set seqVal (Just sNum) - & set seqEpsilon (entity ^. eStats . sSeqEpsilon) + (newEntity, val) <- lift $ rollSeqVal entity name gEntities . at ident .= Just (newEntity & set eSeqVal val) - gLog <>= pure (ident, "Sequence: " ++ show sNum) + gLog <>= pure (ident, "Sequence: " ++ show (fromJust $ view seqVal =<< val)) clearEntitySeqVal' ident = gEntities . ix ident . eSeqVal .= Nothing spendSeq :: Int -> String -> Sh GameState () spendSeq n logStr = withFocus $ \focusId -> do - gEntities . ix focusId . eStats . sSequence . _Just . seqVal . _Just -= n + gFocus' . eSeqVal . _Just . seqVal . _Just -= n + hasSeq <- isJust <$> preuse (gFocus' . eSeqVal . _Just . seqVal . _Just) + when hasSeq $ + gTimer += n gLog <>= pure (focusId, logStr) delay :: Sh GameState () @@ -478,4 +555,5 @@ printVal = withArg $ \formula -> withFocus $ \focusId -> do (fromRational prob :: Double) barLength (replicate (round $ fromInteger barLength * normalize prob) '#') lengths = map (length . show . fst) vals - normalize p = p / maximum (map snd vals) + -- normalize p = p / maximum (map snd vals) + normalize = id -- cgit v1.2.3