Cleanup
This commit is contained in:
+5
-7
@@ -3,17 +3,17 @@ Module : Dodge.Event
|
|||||||
Description : Direct event handling
|
Description : Direct event handling
|
||||||
|
|
||||||
Deals with direct events.
|
Deals with direct events.
|
||||||
This includes individual key or mouse presses, but /not/ continuous held down input.
|
This could include individual key or mouse presses.
|
||||||
We cannot handle multiple keys held down at once here,
|
However, we cannot handle multiple keys held down at once here,
|
||||||
(eg left mouse button + right mouse button)
|
(eg left mouse button + right mouse button)
|
||||||
because these are separate events.
|
because these are separate events.
|
||||||
Instead we store the events in a set, and deal with the combinations in
|
Nor could we handle continuous mouse button input.
|
||||||
"Dodge.Update"; in particular see 'updatePressedButtons'.
|
Instead we store button presses (in a Map) and deal with the combinations in
|
||||||
|
the simulation step; in particular see 'updatePressedButtons'.
|
||||||
-}
|
-}
|
||||||
module Dodge.Event
|
module Dodge.Event
|
||||||
( handleEvent
|
( handleEvent
|
||||||
) where
|
) where
|
||||||
import Dodge.Terminal
|
|
||||||
import Dodge.InputFocus
|
import Dodge.InputFocus
|
||||||
import Dodge.Combine
|
import Dodge.Combine
|
||||||
import Dodge.Event.Keyboard
|
import Dodge.Event.Keyboard
|
||||||
@@ -26,13 +26,11 @@ import Dodge.Data
|
|||||||
import Dodge.PreloadData
|
import Dodge.PreloadData
|
||||||
--import Dodge.Creature.Action
|
--import Dodge.Creature.Action
|
||||||
import Dodge.Inventory
|
import Dodge.Inventory
|
||||||
import Dodge.Inventory.Add
|
|
||||||
import Dodge.SoundLogic
|
import Dodge.SoundLogic
|
||||||
--import Geometry
|
--import Geometry
|
||||||
--import Preload.Update
|
--import Preload.Update
|
||||||
--import Dodge.FloorItem
|
--import Dodge.FloorItem
|
||||||
import qualified IntMapHelp as IM
|
import qualified IntMapHelp as IM
|
||||||
import ListHelp
|
|
||||||
|
|
||||||
--import Data.Monoid
|
--import Data.Monoid
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
|
|||||||
@@ -25,7 +25,6 @@ updateUsingInput w = case _hudElement $ _hud w of
|
|||||||
DisplayCarte
|
DisplayCarte
|
||||||
-> updatePressedButtonsCarte (_mouseButtons w) w
|
-> updatePressedButtonsCarte (_mouseButtons w) w
|
||||||
|
|
||||||
-- ugly check for subinventory inventory hammer, this should change
|
|
||||||
updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World
|
updatePressedButtons :: SubInventory -> M.Map MouseButton Bool -> World -> World
|
||||||
updatePressedButtons subinv pkeys w = case subinv of
|
updatePressedButtons subinv pkeys w = case subinv of
|
||||||
NoSubInventory
|
NoSubInventory
|
||||||
|
|||||||
@@ -16,7 +16,7 @@ import Geometry
|
|||||||
|
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Streaming
|
import StreamingHelp
|
||||||
import qualified Streaming.Prelude as S
|
import qualified Streaming.Prelude as S
|
||||||
|
|
||||||
{- List those objects that appear on a line. -}
|
{- List those objects that appear on a line. -}
|
||||||
@@ -24,12 +24,12 @@ thingsHit
|
|||||||
:: Point2 -- ^ Line start point
|
:: Point2 -- ^ Line start point
|
||||||
-> Point2 -- ^ Line end point
|
-> Point2 -- ^ Line end point
|
||||||
-> World
|
-> World
|
||||||
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
|
-> StreamOf (Point2, Either Creature Wall)
|
||||||
thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
thingsHit sp ep w = void $ S.mergeOn (dist sp . fst)
|
||||||
(S.map (second Left) (crsHit sp ep w))
|
(S.map (second Left) (crsHit sp ep w))
|
||||||
(S.map (second Right) (wlsHit sp ep w))
|
(S.map (second Right) (wlsHit sp ep w))
|
||||||
|
|
||||||
crsHit :: Point2 -> Point2 -> World -> Stream (Of (Point2, Creature)) Identity ()
|
crsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Creature)
|
||||||
crsHit sp ep
|
crsHit sp ep
|
||||||
| sp == ep = const mempty
|
| sp == ep = const mempty
|
||||||
| otherwise = sortStreamOn (dist sp . fst)
|
| otherwise = sortStreamOn (dist sp . fst)
|
||||||
@@ -48,14 +48,14 @@ thingsHitExceptCr
|
|||||||
-> Point2 -- ^ Line start point
|
-> Point2 -- ^ Line start point
|
||||||
-> Point2 -- ^ Line end point
|
-> Point2 -- ^ Line end point
|
||||||
-> World
|
-> World
|
||||||
-> Stream (Of (Point2, Either Creature Wall)) Identity ()
|
-> StreamOf (Point2, Either Creature Wall)
|
||||||
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
|
||||||
thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
thingsHitExceptCr (Just cid) sp ep = S.filter crNotCid . thingsHit sp ep
|
||||||
where
|
where
|
||||||
crNotCid (_,Left cr) = _crID cr /= cid
|
crNotCid (_,Left cr) = _crID cr /= cid
|
||||||
crNotCid _ = True
|
crNotCid _ = True
|
||||||
|
|
||||||
wlsHit :: Point2 -> Point2 -> World -> Stream (Of (Point2, Wall)) Identity ()
|
wlsHit :: Point2 -> Point2 -> World -> StreamOf (Point2, Wall)
|
||||||
wlsHit sp ep
|
wlsHit sp ep
|
||||||
| sp == ep = const mempty
|
| sp == ep = const mempty
|
||||||
| otherwise = sortStreamOn (dist sp . fst)
|
| otherwise = sortStreamOn (dist sp . fst)
|
||||||
|
|||||||
Reference in New Issue
Block a user