Fix switch detection, cleanup

This commit is contained in:
2025-06-25 21:49:11 +01:00
parent a9cae4d409
commit 2f130c5bed
8 changed files with 13 additions and 32 deletions
+1 -1
View File
File diff suppressed because one or more lines are too long
+1 -1
View File
@@ -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
+1 -1
View File
@@ -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
+4 -20
View File
@@ -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
+2 -2
View File
@@ -54,8 +54,8 @@ defaultButton =
, _btID = 0
-- , _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
-- , _btName = ""
-- , _btColor = red
}
defaultPP :: PressPlate
+4 -4
View File
@@ -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
-1
View File
@@ -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\\"
-2
View File
@@ -56,8 +56,6 @@ termButton =
, _btEvent = ButtonAccessTerminal
, _btID = 0
, _btTermMID = Nothing
, _btName = ""
, _btColor = dark magenta
}
terminalColor :: Color