justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Simplify buttons

Browse Source
This commit is contained in:
justin
2025-06-25 21:37:32 +01:00
parent 6e9d4918a1
commit a9cae4d409
13 changed files with 130 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Button/Draw.hs
+3 -3
View File
@@ -10,13 +10,13 @@ import Control.Lens
drawButton :: Button -> SPic
drawButton bt = case bt ^. btEvent of
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
ButtonSimpleSwith {_bssColor1 = col1, _bssColor2 = col2} -> drawSwitch col1 col2 bt
ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
ButtonAccessTerminal -> mempty
ButtonDoNothing -> mempty
drawSwitch :: Color -> Color -> Button -> SPic
drawSwitch col1 col2 bt
| _btState bt == BtOff = flick $ pi / 4
| bt ^? btEvent . btOn == Just False = flick $ pi / 4
| otherwise = flick (negate (pi / 4))
where
flick a = noPic
@@ -33,6 +33,6 @@ defaultDrawButton col bt = noPic
)
where
buttonGeometry
| _btState bt == BtOff = rectNSWE 10 (-1) (- width) width
| bt ^? btEvent . btOn == Just False = rectNSWE 10 (-1) (- width) width
| otherwise = rectNSWE 2 (-1) (- width) width
width = 8
src/Dodge/Button/Event.hs
+10 -13
View File
@@ -9,26 +9,23 @@ import Dodge.WorldEffect
doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent be = case be of
ButtonDoNothing -> const id
ButtonPress newstate newevent thesound f c -> \b ->
ButtonPress True _ _ -> const id
ButtonPress False f _ -> \b ->
doWdWd f
. set (cWorld . lWorld . buttons . ix (_btID b) . btState) newstate
. set (cWorld . lWorld . buttons . ix (_btID b) . btEvent) newevent
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
ButtonSimpleSwith oneff offeff _ _ -> flipSwitch oneff offeff
. set (cWorld . lWorld . buttons . ix (_btID b) . btEvent . btOn) True
. soundStart (LeverSound 0) (_btPos b) click1S Nothing
ButtonSwitch oneff offeff _ _ _ -> flipSwitch oneff offeff
ButtonAccessTerminal -> accessTerminal . _btTermMID
flipSwitch :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt
| _btState bt == BtOff =
doWdWd oneff . dosound
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnon
| otherwise =
| _btOn (_btEvent bt) =
doWdWd offeff . dosound
. over (cWorld . lWorld . buttons . ix (_btID bt)) turnoff
. set (cWorld . lWorld . buttons . ix (_btID bt) . btEvent . btOn) False
| otherwise =
doWdWd oneff . dosound
. set (cWorld . lWorld . buttons . ix (_btID bt) . btEvent . btOn) True
where
turnon = (btState .~ BtOn)
turnoff = (btState .~ BtOff)
dosound = soundWithStatus ToStart (LeverSound 0) (_btPos bt) click1S Nothing
-- switchEffect b = case _btState b of
src/Dodge/Data/Button.hs
+9 -17
View File
@@ -11,28 +11,20 @@ import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.WorldEffect
import Geometry.Data
import Sound.Data
--data ButtonDraw
-- = DefaultDrawButton Color
-- | DefaultDrawSwitch Color Color
-- | DrawNoButton
-- --deriving (Eq, Ord, Show, Read) --Generic, Flat)
data ButtonEvent
= ButtonDoNothing
| ButtonPress
{ _bpState :: ButtonState
, _bpEvent :: ButtonEvent
, _bpSound :: SoundID
{ _btOn :: Bool
, _bpEff :: WdWd
, _bpColor :: Color
}
| ButtonSimpleSwith
| ButtonSwitch
{ _bonEff :: WdWd
, _boffEff :: WdWd
, _bssColor1 :: Color
, _bssColor2 :: Color
, _bsColor1 :: Color
, _bsColor2 :: Color
, _btOn :: Bool
}
| ButtonAccessTerminal
--deriving (Eq, Show, Read) --, Generic)
@@ -46,7 +38,7 @@ data Button = Button
, _btEvent :: ButtonEvent --Button -> World -> World
, _btID :: Int
-- , _btText :: String
, _btState :: ButtonState
-- , _btState :: ButtonState
, _btTermMID :: Maybe Int
, _btName :: String
, _btColor :: Color
@@ -54,12 +46,12 @@ data Button = Button
--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)
--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 ''ButtonState
deriveJSON defaultOptions ''ButtonEvent
deriveJSON defaultOptions ''Button
src/Dodge/Data/WorldEffect.hs
+1 -1
View File
@@ -55,7 +55,7 @@ data WdBl
| WdBlNegate WdBl
| WdBlCrFilterNearPoint Float Point2 CrBl
| WdBlBtOn Int
| WdBlBtNotOff Int
-- | WdBlBtNotOff Int
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data WdP2f
src/Dodge/Default.hs
+2 -4
View File
@@ -18,7 +18,6 @@ import Dodge.Default.Creature
import Dodge.Default.Item
import Dodge.Default.Terminal
import Dodge.Default.Wall
import Dodge.SoundLogic
import Geometry
import Picture
@@ -51,10 +50,9 @@ defaultButton =
Button
{ _btPos = V2 0 0
, _btRot = 0
, _btEvent = ButtonPress BtInactive ButtonDoNothing click1S NoWorldEffect
(dark red)
, _btEvent = ButtonPress False NoWorldEffect (dark red)
, _btID = 0
, _btState = BtOff
-- , _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
src/Dodge/Inventory.hs
+1 -1
View File
@@ -130,7 +130,7 @@ updateCloseObjects w =
isclose pos = dist ypos pos < 40 && hasButtonLOS ypos pos w
ypos = _crPos $ you w
activeButtons =
filter ((/=) BtInactive . _btState)
filter ((/= Just True) . (^? btEvent . btOn))
. IM.elems
$ w ^. cWorld . lWorld . buttons
src/Dodge/Inventory/SelectionList.hs
+3 -4
View File
@@ -234,10 +234,9 @@ btText :: Button -> String
btText bt = case _btEvent bt of
ButtonDoNothing -> "UNPRESSABLE BUTTON"
ButtonPress {} -> "BUTTON"
ButtonSimpleSwith {} -> case _btState bt of
BtOn -> "SWITCH\\"
BtOff -> "SWITCH/"
BtInactive -> "INACTIVE SWITCH"
ButtonSwitch {_btOn = t} -> case t of
True -> "SWITCH\\"
False -> "SWITCH/"
ButtonAccessTerminal -> "TERMINAL"
closeItemToTextPictures :: FloorItem -> ([String], Color)
src/Dodge/LevelGen/Switch.hs
+51 -43
View File
@@ -1,55 +1,63 @@
module Dodge.LevelGen.Switch
( makeSwitch
, makeButton
, makeSwitchSPic
, drawSwitchWire
) where
module Dodge.LevelGen.Switch (
makeSwitch,
makeButton,
makeSwitchSPic,
drawSwitchWire,
) where
import Dodge.Data.Button
import Dodge.Data.WorldEffect
import Dodge.Default
import Dodge.SoundLogic
import Picture
import ShapePicture
import Shape
import Geometry
import Picture
import Shape
import ShapePicture
import Control.Lens
makeButton
:: Color
-> WdWd -- ^ Effect when pressed
-> Button
makeButton col eff = defaultButton
{ _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff col
, _btState = BtOff
}
makeButton ::
Color ->
-- | Effect when pressed
WdWd ->
Button
makeButton col eff =
defaultButton
{ -- { _btEvent = ButtonPress BtInactive ButtonDoNothing click1S eff col
_btEvent = ButtonPress False eff col
-- , _btState = BtOff
}
-- TODO remove duplication
drawSwitchWire :: Color -> Color -> Button -> SPic
drawSwitchWire col1 col2 bt
| _btState bt == BtOff = flick $ pi/4
| otherwise = flick (negate (pi/4))
| bt ^? btEvent . btOn == Just False = flick $ pi / 4
| otherwise = flick (negate (pi / 4))
where
flick a = noPic ( mconcat
[ colorSH col1 . translateSHz 10 . upperBox Small Typical 10 $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperBox Small Typical 2
$ rectNSWE 10 0 (-2) 2
]
)
flick a =
noPic
( mconcat
[ colorSH col1 . translateSHz 10 . upperBox Small Typical 10 $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperBox Small Typical 2 $
rectNSWE 10 0 (-2) 2
]
)
makeSwitchSPic
:: Color
-> Color
-> WdWd -- ^ Switch on effect
-> WdWd -- ^ Switch off effect
-> Button
makeSwitchSPic c1 c2 effOn effOff = defaultButton
{ _btEvent = ButtonSimpleSwith effOn effOff c1 c2
, _btState = BtOff
}
makeSwitch
:: Color
-> Color
-> WdWd -- ^ Switch on effect
-> WdWd -- ^ Switch off effect
-> Button
makeSwitchSPic ::
Color ->
Color ->
-- | Switch on effect
WdWd ->
-- | Switch off effect
WdWd ->
Button
makeSwitchSPic c1 c2 effOn effOff =
defaultButton & btEvent .~ ButtonSwitch effOn effOff c1 c2 False
makeSwitch ::
Color ->
Color ->
-- | Switch on effect
WdWd ->
-- | Switch off effect
WdWd ->
Button
makeSwitch col1 col2 = makeSwitchSPic col1 col2
src/Dodge/Placement/Instance/Terminal.hs
-1
View File
@@ -55,7 +55,6 @@ termButton =
, _btRot = 0
, _btEvent = ButtonAccessTerminal
, _btID = 0
, _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = dark magenta
src/Dodge/Room/LongDoor.hs
+4 -2
View File
@@ -73,7 +73,8 @@ twinSlowDoorRoom w h x =
thedoor btid =
defaultDoor
& drSpeed .~ wlSpeed
& drTrigger .~ WdBlBtNotOff btid
-- & drTrigger .~ WdBlBtNotOff btid
& drTrigger .~ WdBlBtOn btid
col = dim $ dim $ bright red
twinSlowDoorChasers :: RandomGen g => State g Room
@@ -134,7 +135,8 @@ addButtonSlowDoor x h rm = do
putDoubleDoorThen
DoorObstacle
thewall
(WdBlBtNotOff $ fromJust $ _plMID btplmnt)
-- (WdBlBtNotOff $ fromJust $ _plMID btplmnt)
(WdBlBtOn $ fromJust $ _plMID btplmnt)
30
(V2 0 h)
(V2 x h)
src/Dodge/WorldBool.hs
+2 -4
View File
@@ -15,8 +15,6 @@ doWdBl wb w = case wb of
dr <- w ^? cWorld . lWorld . doors . ix i
return (DoorHalfway == _drStatus dr)
WdBlCrFilterNearPoint r p t -> any (crNearPoint r p) (IM.filter (doCrBl t) (w ^. cWorld . lWorld . creatures))
--WdBlBtOn btid -> _btState (_buttons (_cWorld w) IM.! btid) == BtOn -- unsafe
WdBlBtOn btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btState) == BtOn -- unsafe
--WdBlBtNotOff btid -> _btState (_buttons (_cWorld w) IM.! btid) /= BtOff -- unsafe
WdBlBtNotOff btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btState) /= BtOff -- unsafe
WdBlBtOn btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btEvent . btOn) -- unsafe
-- WdBlBtNotOff btid -> (w ^?! cWorld . lWorld . buttons . ix btid . btState) /= BtOff -- unsafe
WdBlNegate x -> not $ doWdBl x w