Fix switch detection, cleanup
This commit is contained in:
File diff suppressed because one or more lines are too long
@@ -12,7 +12,7 @@ drawButton bt = case bt ^. btEvent of
|
||||
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
|
||||
ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
|
||||
ButtonAccessTerminal -> mempty
|
||||
ButtonDoNothing -> mempty
|
||||
-- ButtonDoNothing -> mempty
|
||||
|
||||
drawSwitch :: Color -> Color -> Button -> SPic
|
||||
drawSwitch col1 col2 bt
|
||||
|
||||
@@ -8,7 +8,7 @@ import Dodge.WorldEffect
|
||||
|
||||
doButtonEvent :: ButtonEvent -> Button -> World -> World
|
||||
doButtonEvent be = case be of
|
||||
ButtonDoNothing -> const id
|
||||
-- ButtonDoNothing -> const id
|
||||
ButtonPress True _ _ -> const id
|
||||
ButtonPress False f _ -> \b ->
|
||||
doWdWd f
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
@@ -13,8 +13,7 @@ import Dodge.Data.WorldEffect
|
||||
import Geometry.Data
|
||||
|
||||
data ButtonEvent
|
||||
= ButtonDoNothing
|
||||
| ButtonPress
|
||||
= ButtonPress
|
||||
{ _btOn :: Bool
|
||||
, _bpEff :: WdWd
|
||||
, _bpColor :: Color
|
||||
@@ -27,31 +26,16 @@ data ButtonEvent
|
||||
, _btOn :: Bool
|
||||
}
|
||||
| ButtonAccessTerminal
|
||||
--deriving (Eq, Show, Read) --, Generic)
|
||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
||||
|
||||
data Button = Button
|
||||
{
|
||||
-- _btPict :: ButtonDraw --Button -> SPic
|
||||
_btPos :: Point2
|
||||
{ _btPos :: Point2
|
||||
, _btRot :: Float
|
||||
, _btEvent :: ButtonEvent --Button -> World -> World
|
||||
, _btEvent :: ButtonEvent
|
||||
, _btID :: Int
|
||||
-- , _btText :: String
|
||||
-- , _btState :: ButtonState
|
||||
, _btTermMID :: Maybe Int
|
||||
, _btName :: String
|
||||
, _btColor :: Color
|
||||
}
|
||||
--deriving (Eq, Show, Read) --, Generic)
|
||||
--h--deriving (Eq, Show, Read) --Generic, Flat)
|
||||
|
||||
--data ButtonState = BtOn | BtOff | BtInactive
|
||||
-- deriving Eq -- (Eq, Ord, Show, Read) --Generic, Flat)
|
||||
|
||||
makeLenses ''Button
|
||||
makeLenses ''ButtonEvent
|
||||
--deriveJSON defaultOptions ''ButtonDraw
|
||||
--deriveJSON defaultOptions ''ButtonState
|
||||
deriveJSON defaultOptions ''ButtonEvent
|
||||
deriveJSON defaultOptions ''Button
|
||||
|
||||
@@ -54,8 +54,8 @@ defaultButton =
|
||||
, _btID = 0
|
||||
-- , _btState = BtOff
|
||||
, _btTermMID = Nothing
|
||||
, _btName = ""
|
||||
, _btColor = red
|
||||
-- , _btName = ""
|
||||
-- , _btColor = red
|
||||
}
|
||||
|
||||
defaultPP :: PressPlate
|
||||
|
||||
@@ -129,10 +129,10 @@ updateCloseObjects w =
|
||||
$ w ^. cWorld . lWorld . floorItems . unNIntMap
|
||||
isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
|
||||
ypos = _crPos $ you w
|
||||
activeButtons =
|
||||
filter ((/= Just True) . (^? btEvent . btOn))
|
||||
. IM.elems
|
||||
$ w ^. cWorld . lWorld . buttons
|
||||
activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
|
||||
canpress bt = case bt ^. btEvent of
|
||||
ButtonPress {_btOn = t} -> not t
|
||||
_ -> True
|
||||
|
||||
changeSwapSel :: Int -> World -> World
|
||||
changeSwapSel yi w
|
||||
|
||||
@@ -232,7 +232,6 @@ closeButtonToSelectionItem w i = do
|
||||
|
||||
btText :: Button -> String
|
||||
btText bt = case _btEvent bt of
|
||||
ButtonDoNothing -> "UNPRESSABLE BUTTON"
|
||||
ButtonPress {} -> "BUTTON"
|
||||
ButtonSwitch {_btOn = t} -> case t of
|
||||
True -> "SWITCH\\"
|
||||
|
||||
@@ -56,8 +56,6 @@ termButton =
|
||||
, _btEvent = ButtonAccessTerminal
|
||||
, _btID = 0
|
||||
, _btTermMID = Nothing
|
||||
, _btName = ""
|
||||
, _btColor = dark magenta
|
||||
}
|
||||
|
||||
terminalColor :: Color
|
||||
|
||||
Reference in New Issue
Block a user