diff --git a/src/Dodge/BlBl.hs b/src/Dodge/BlBl.hs new file mode 100644 index 000000000..74cfdc5a3 --- /dev/null +++ b/src/Dodge/BlBl.hs @@ -0,0 +1,9 @@ +module Dodge.BlBl (doBlBl) where + +import Dodge.Data.BlBl + +doBlBl :: BlBl -> Bool -> Bool +doBlBl bb = case bb of + BlNegate -> not + BlConst bl -> const bl + BlId -> id diff --git a/src/Dodge/Data/BlBl.hs b/src/Dodge/Data/BlBl.hs new file mode 100644 index 000000000..459b48b84 --- /dev/null +++ b/src/Dodge/Data/BlBl.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.BlBl where + +import Data.Aeson +import Data.Aeson.TH + +data BlBl + = BlNegate + | BlConst Bool + | BlId + deriving (Eq, Ord, Show, Read) --Generic, Flat) + +deriveJSON defaultOptions ''BlBl diff --git a/src/Dodge/Data/Wall/Structure.hs b/src/Dodge/Data/Wall/Structure.hs new file mode 100644 index 000000000..56de8e4eb --- /dev/null +++ b/src/Dodge/Data/Wall/Structure.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE StrictData #-} +{-# LANGUAGE TemplateHaskell #-} + +module Dodge.Data.Wall.Structure + where +import Control.Lens +import Data.Aeson +import Data.Aeson.TH + +data WallStructure + = StandaloneWall + | DoorPart {_wsDoor :: Int} + | MachinePart {_wsMachine :: Int} + | BlockPart {_wsBlock :: Int} + | CreaturePart { _wlStCreature :: Int } + deriving (Eq, Ord, Show, Read) --Generic, Flat) + +makeLenses ''WallStructure +deriveJSON defaultOptions ''WallStructure diff --git a/src/Dodge/SelectedClose.hs b/src/Dodge/SelectedClose.hs new file mode 100644 index 000000000..9e396108e --- /dev/null +++ b/src/Dodge/SelectedClose.hs @@ -0,0 +1,25 @@ +module Dodge.SelectedClose (getSelectedCloseObj,interactWithCloseObj) where + +import Dodge.Button.Event +import Dodge.Inventory.Add +import Control.Lens +import Dodge.Data.World +import NewInt + +interactWithCloseObj :: Either FloorItem Button -> World -> World +interactWithCloseObj e w = worldEventFlags . at InventoryChange ?~ () $ case e of + (Left flit) -> pickUpItem 0 flit w + (Right but) -> doButtonEvent (_btEvent but) but w + + +getSelectedCloseObj :: World -> Maybe (Either FloorItem Button) +getSelectedCloseObj w = do + (i, j, _) <- w ^? hud . hudElement . diSelection . _Just + case i of + 3 -> do + NInt k <- w ^? hud . closeItems . ix j + fmap Left $ w ^? cWorld . lWorld . floorItems . unNIntMap . ix k + 5 -> do + k <- w ^? hud . closeButtons . ix j + fmap Right $ w ^? cWorld . lWorld . buttons . ix k + _ -> Nothing