Start splitting off creature control more sensibly

This commit is contained in:
2023-02-19 11:45:51 +00:00
parent a88755bd75
commit 2b0b54f1cd
2 changed files with 14 additions and 8 deletions
+8 -1
View File
@@ -19,13 +19,20 @@ import qualified SDL
-- | The AI equivalent for your control. -- | The AI equivalent for your control.
yourControl :: Creature -> World -> World yourControl :: Creature -> World -> World
yourControl cr w yourControl cr w
| inTermFocus w = w & updateUsingInput -- do we really want to do this?
| inputFocus w = w | inputFocus w = w
| intopinv = w & cWorld . lWorld . creatures . ix (_crID cr)
%~ wasdWithAiming w (_mvSpeed $ _crMvType cr)
| otherwise = | otherwise =
w w
& cWorld . lWorld . creatures . ix (_crID cr) & cWorld . lWorld . creatures . ix (_crID cr)
%~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w))) %~ (wasdWithAiming w (_mvSpeed $ _crMvType cr) . mouseActionsCr (_mouseButtons (_input w)))
& updateUsingInput & updateUsingInput
where
intopinv = fromMaybe False $ do
subinv <- w ^? hud . hudElement . subInventory
Just $ case subinv of
NoSubInventory -> True
_ -> False
--dimCreatureLight :: Creature -> World -> World --dimCreatureLight :: Creature -> World -> World
--dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr) --dimCreatureLight cr = cWorld . lWorld . tempLightSources .:~ tlsTimeRadColPos 1 300 0.1 (addZ 100 $ _crPos cr)
+6 -7
View File
@@ -20,7 +20,7 @@ scrollSelectionSections yi sss
-- when is this used? it needs to correctly set the cursor -- when is this used? it needs to correctly set the cursor
firstPosSelectionSections :: SelectionSections a -> SelectionSections a firstPosSelectionSections :: SelectionSections a -> SelectionSections a
firstPosSelectionSections sss = fromMaybe sss $ do firstPosSelectionSections sss = fromMaybe sss $ do
(i, j, si) <- ssLookupMin sss (i, j, _) <- ssLookupMin sss
return $ return $
sss sss
& sssSelPos ?~ (i, j) & sssSelPos ?~ (i, j)
@@ -34,7 +34,7 @@ firstPosSelectionSections sss = fromMaybe sss $ do
scrollUpSelectionSections :: SelectionSections a -> SelectionSections a scrollUpSelectionSections :: SelectionSections a -> SelectionSections a
scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
(i, j) <- sss ^? sssSelPos . _Just (i, j) <- sss ^? sssSelPos . _Just
(i', j', si) <- ssLookupUp i j sss (i', j', _) <- ssLookupUp i j sss
return $ sss & sssSelPos ?~ (i', j') return $ sss & sssSelPos ?~ (i', j')
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) -- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
@@ -42,8 +42,7 @@ scrollUpSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
scrollDownSelectionSections :: SelectionSections a -> SelectionSections a scrollDownSelectionSections :: SelectionSections a -> SelectionSections a
scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do scrollDownSelectionSections sss = fromMaybe (firstPosSelectionSections sss) $ do
(i, j) <- sss ^? sssSelPos . _Just (i, j) <- sss ^? sssSelPos . _Just
-- j <- sss ^? sssSections . ix i . ssCursor . _Just . scurSel (i', j', _) <- ssLookupDown i j sss
(i', j', si) <- ssLookupDown i j sss
return $ sss & sssSelPos ?~ (i', j') return $ sss & sssSelPos ?~ (i', j')
-- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si) -- & sssSections . ix i' . ssCursor ?~ SectionCursor j' j' (_siHeight si) (_siColor si)
@@ -53,7 +52,7 @@ ssSetCursor ::
SelectionSections a -> SelectionSections a ->
SelectionSections a SelectionSections a
ssSetCursor f sss = fromMaybe sss $ do ssSetCursor f sss = fromMaybe sss $ do
(i, j, si) <- f sss (i, j, _) <- f sss
return $ return $
sss sss
& sssSelPos ?~ (i, j) & sssSelPos ?~ (i, j)
@@ -120,5 +119,5 @@ ssLookupGE' i sss = do
Just (j', si) -> return (i', j', si) Just (j', si) -> return (i', j', si)
Nothing -> ssLookupGT' i' sss Nothing -> ssLookupGT' i' sss
getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int --getIthPos :: Int -> IM.IntMap (SelectionItem a) -> Int
getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm --getIthPos i sm = sum . fmap _siHeight . fst $ IM.split i sm