Compare commits
4 Commits
2f4fcb42e5
...
5ccbfa1f91
| Author | SHA1 | Date | |
|---|---|---|---|
| 5ccbfa1f91 | |||
| b07280e50c | |||
| 2f9cea1b69 | |||
| b8581a7862 |
File diff suppressed because one or more lines are too long
@@ -11,8 +11,7 @@ drawButton :: Button -> SPic
|
||||
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
|
||||
ButtonAccessTerminal _ -> mempty
|
||||
|
||||
drawSwitch :: Color -> Color -> Button -> SPic
|
||||
drawSwitch col1 col2 bt
|
||||
|
||||
@@ -5,7 +5,6 @@ import Control.Lens
|
||||
import Dodge.Data.World
|
||||
import Dodge.SoundLogic
|
||||
import Dodge.WorldEffect
|
||||
import Sound.Data
|
||||
|
||||
doButtonEvent :: ButtonEvent -> Button -> World -> World
|
||||
doButtonEvent = \case
|
||||
@@ -13,10 +12,10 @@ doButtonEvent = \case
|
||||
ButtonPress False f _ -> buttonFlip f
|
||||
ButtonSwitch _ f _ _ True -> buttonFlip f
|
||||
ButtonSwitch f _ _ _ False -> buttonFlip f
|
||||
ButtonAccessTerminal -> accessTerminal . _btTermMID
|
||||
ButtonAccessTerminal tid -> const $ accessTerminal tid
|
||||
|
||||
buttonFlip :: WdWd -> Button -> World -> World
|
||||
buttonFlip f bt =
|
||||
doWdWd f
|
||||
. soundWithStatus ToStart (LeverSound 0) (bt ^. btPos) click1S Nothing
|
||||
. soundStart (ButtonSound (bt ^. btID)) (bt ^. btPos) click1S Nothing
|
||||
. over (cWorld . lWorld . buttons . ix (bt ^. btID) . btEvent . btOn) not
|
||||
|
||||
@@ -21,14 +21,14 @@ combineList :: World -> [SelectionItem CombinableItem]
|
||||
combineList = map f . combineItemListYouX
|
||||
where
|
||||
f (is, itm) =
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = basicItemDisplay itm
|
||||
, _siHeight = itInvHeight itm
|
||||
, _siWidth = 15
|
||||
, _siIsSelectable = True
|
||||
, _siColor = itemInvColor $ baseCI itm
|
||||
, _siOffX = 0
|
||||
, _siPayload = CombinableItem is itm
|
||||
, _siPayload = Just $ CombinableItem is itm
|
||||
}
|
||||
|
||||
combineItemListYouX :: World -> [([Int], Item)]
|
||||
|
||||
@@ -25,14 +25,13 @@ data ButtonEvent
|
||||
, _bsColor2 :: Color
|
||||
, _btOn :: Bool
|
||||
}
|
||||
| ButtonAccessTerminal
|
||||
| ButtonAccessTerminal {_btTermID :: Int}
|
||||
|
||||
data Button = Button
|
||||
{ _btPos :: Point2
|
||||
, _btRot :: Float
|
||||
, _btEvent :: ButtonEvent
|
||||
, _btID :: Int
|
||||
, _btTermMID :: Maybe Int
|
||||
}
|
||||
|
||||
makeLenses ''Button
|
||||
|
||||
@@ -5,6 +5,7 @@
|
||||
|
||||
module Dodge.Data.Input where
|
||||
|
||||
import Dodge.Data.Terminal.Status
|
||||
import Control.Lens
|
||||
import qualified Data.Map.Strict as M
|
||||
import Geometry.Data
|
||||
@@ -28,9 +29,8 @@ data MouseContext
|
||||
| OverCombCombine { _mcoCombCombine :: (Int,Int)}
|
||||
| OverCombFilter
|
||||
| OverCombEscape
|
||||
| OverTerminalReturn {_mcoTermID :: Int}
|
||||
| OverTerminalContinue {_mcoTermID :: Int}
|
||||
| OverTerminalEscape
|
||||
| OverTerminal {_mcoTermID :: Int, _mcoTermStatus :: TerminalStatus}
|
||||
| OutsideTerminal
|
||||
| MouseGameRotate
|
||||
deriving (Show)
|
||||
|
||||
|
||||
@@ -41,22 +41,14 @@ data SelectionWidth
|
||||
| UseItemWidth
|
||||
|
||||
data SelectionItem a
|
||||
= SelectionItem
|
||||
{ _siPictures :: [String]
|
||||
, _siHeight :: Int
|
||||
, _siWidth :: Int
|
||||
, _siIsSelectable :: Bool
|
||||
, _siColor :: Color
|
||||
, _siOffX :: Int
|
||||
, _siPayload :: a
|
||||
}
|
||||
| SelectionInfo
|
||||
= SelItem
|
||||
{ _siPictures :: [String]
|
||||
, _siHeight :: Int
|
||||
, _siWidth :: Int
|
||||
, _siIsSelectable :: Bool
|
||||
, _siColor :: Color
|
||||
, _siOffX :: Int
|
||||
, _siPayload :: Maybe a
|
||||
}
|
||||
|
||||
makeLenses ''ListDisplayParams
|
||||
|
||||
@@ -34,7 +34,7 @@ data SoundOrigin
|
||||
| GlassBreakSound Int
|
||||
| MaterialSound Material Int
|
||||
| TeleSound Int
|
||||
| LeverSound Int
|
||||
| ButtonSound Int
|
||||
| Explosion Int
|
||||
| Tap Int
|
||||
| EBSound Int
|
||||
|
||||
@@ -89,7 +89,8 @@ data TCom = TCInfo String String -- this may not be necessary, to revisit
|
||||
|
||||
data TmWdWd
|
||||
= TmWdId
|
||||
| TmWdWdDisconnectTerminal
|
||||
| TmWdWdPowerDownTerminal
|
||||
| TmWdWdDeactivateTerminal
|
||||
| TmWdWdfromWdWd WdWd
|
||||
| TmWdWdTermSound SoundID
|
||||
| TmWdWdDoDeathTriggers
|
||||
|
||||
@@ -9,10 +9,11 @@ import Data.Aeson.TH
|
||||
|
||||
data TerminalStatus
|
||||
= TerminalOff
|
||||
| TerminalDeactivated
|
||||
| TerminalLineRead
|
||||
| TerminalTextInput {_tiText :: String}
|
||||
| TerminalPressTo {_tptString :: String}
|
||||
deriving (Eq)
|
||||
deriving (Eq,Show)
|
||||
|
||||
makeLenses ''TerminalStatus
|
||||
deriveJSON defaultOptions ''TerminalStatus
|
||||
|
||||
@@ -22,7 +22,7 @@ data WdWd
|
||||
| SetTrigger Bool Int
|
||||
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
|
||||
| SetLSCol Point3 Int
|
||||
| AccessTerminal (Maybe Int)
|
||||
| AccessTerminal Int
|
||||
| UnlockInv
|
||||
| SoundStart SoundOrigin Point2 SoundID (Maybe Int)
|
||||
| MakeStartCloudAt Point3
|
||||
|
||||
@@ -46,16 +46,11 @@ defaultMachine =
|
||||
}
|
||||
|
||||
defaultButton :: Button
|
||||
defaultButton =
|
||||
Button
|
||||
{ _btPos = V2 0 0
|
||||
defaultButton = Button
|
||||
{ _btPos = 0
|
||||
, _btRot = 0
|
||||
, _btEvent = ButtonPress False NoWorldEffect (dark red)
|
||||
, _btID = 0
|
||||
-- , _btState = BtOff
|
||||
, _btTermMID = Nothing
|
||||
-- , _btName = ""
|
||||
-- , _btColor = red
|
||||
}
|
||||
|
||||
defaultPP :: PressPlate
|
||||
|
||||
@@ -65,12 +65,12 @@ updateCombineSections w cfig =
|
||||
sclose'
|
||||
| null sclose =
|
||||
IM.singleton 0 $
|
||||
SelectionInfo ["No possible combinations"] 1 25 False white 0
|
||||
SelItem ["No possible combinations"] 1 25 False white 0 Nothing
|
||||
| otherwise = sclose
|
||||
|
||||
regexCombs :: IM.IntMap Item -> SelectionItem CombinableItem -> String -> Bool
|
||||
regexCombs inv ci = \case
|
||||
'#' : str -> any (g str) (_ciInvIDs $ _siPayload ci)
|
||||
'#' : str -> any (g str) (_ciInvIDs $ fromJust $ _siPayload ci)
|
||||
str -> (regexList str . _siPictures) ci
|
||||
where
|
||||
g str i = maybe False (regexList str . basicItemDisplay) (inv ^? ix i)
|
||||
@@ -129,7 +129,7 @@ updateDisplaySections w cfig =
|
||||
[ invhead
|
||||
, sinv
|
||||
, IM.singleton 0
|
||||
$ SelectionItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 ()
|
||||
$ SelItem [displayFreeSlots (crNumFreeSlots cr)] 1 15 True invDimColor 2 Nothing
|
||||
, nearbyhead
|
||||
, sclose
|
||||
, interfaceshead
|
||||
@@ -153,7 +153,7 @@ updateDisplaySections w cfig =
|
||||
btitems =
|
||||
IM.fromDistinctAscList . zip [0 ..] $
|
||||
mapMaybe (closeButtonToSelectionItem w) (w ^. hud . closeButtons)
|
||||
makehead str = IM.singleton 0 $ SelectionInfo [str] 1 15 False white 0
|
||||
makehead str = IM.singleton 0 $ SelItem [str] 1 15 False white 0 Nothing
|
||||
invhead = if null sfinv then makehead "INVENTORY" else sfinv
|
||||
cr = you w
|
||||
closeitms =
|
||||
@@ -179,13 +179,14 @@ filterSectionsPair infocus filtfn itms filtdescription mfilt = (filtsis, itms')
|
||||
return $
|
||||
IM.singleton
|
||||
0
|
||||
$ SelectionInfo
|
||||
$ SelItem
|
||||
[filtdescription ++ " FILTER/" ++ str ++ [filtcurs], numfiltitems]
|
||||
2
|
||||
(length (filtdescription ++ " FILTER/" ++ str ++ [filtcurs]))
|
||||
True
|
||||
white
|
||||
0
|
||||
Nothing
|
||||
itms' = maybe id (IM.filter . filtfn) mfilt itms
|
||||
numfiltitems = " " ++ show (length itms - length itms') ++ " FILTERED"
|
||||
|
||||
|
||||
@@ -116,7 +116,6 @@ rmInvItem cid invid w =
|
||||
| x > invid || Just x == maxk = max 0 $ x - 1
|
||||
| otherwise = x
|
||||
|
||||
|
||||
-- this looks ugly...
|
||||
updateCloseObjects :: World -> World
|
||||
updateCloseObjects w =
|
||||
@@ -137,6 +136,9 @@ updateCloseObjects w =
|
||||
activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
|
||||
canpress bt = case bt ^. btEvent of
|
||||
ButtonPress {_btOn = t} -> not t
|
||||
ButtonAccessTerminal tid -> fromMaybe False $ do
|
||||
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
|
||||
return (x /= TerminalDeactivated)
|
||||
_ -> True
|
||||
|
||||
changeSwapSel :: Int -> World -> World
|
||||
|
||||
@@ -31,14 +31,14 @@ import Picture.Base
|
||||
|
||||
invSelectionItem :: World -> Int -> LocationDT OItem -> SelectionItem ()
|
||||
invSelectionItem w indent loc =
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = itemDisplay w cr ci
|
||||
, _siHeight = itInvHeight $ ci ^. _1
|
||||
, _siWidth = 15
|
||||
, _siIsSelectable = True
|
||||
, _siColor = itemInvColor ci
|
||||
, _siOffX = indent
|
||||
, _siPayload = ()
|
||||
, _siPayload = Nothing
|
||||
}
|
||||
where
|
||||
ci = (a,b)
|
||||
@@ -207,35 +207,35 @@ closeItemToSelectionItem w (NInt i) = do
|
||||
e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
|
||||
let (pics, col) = closeItemToTextPictures e
|
||||
return
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = pics
|
||||
, _siHeight = length pics
|
||||
, _siWidth = 15
|
||||
, _siIsSelectable = True
|
||||
, _siColor = col
|
||||
, _siOffX = 0
|
||||
, _siPayload = ()
|
||||
, _siPayload = Nothing
|
||||
}
|
||||
|
||||
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
|
||||
closeButtonToSelectionItem w i = do
|
||||
bt <- w ^? cWorld . lWorld . buttons . ix i
|
||||
return
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = [btText bt]
|
||||
, _siHeight = 1
|
||||
, _siWidth = 15
|
||||
, _siIsSelectable = True
|
||||
, _siColor = yellow
|
||||
, _siOffX = 0
|
||||
, _siPayload = ()
|
||||
, _siPayload = Nothing
|
||||
}
|
||||
|
||||
btText :: Button -> String
|
||||
btText bt = case _btEvent bt of
|
||||
ButtonPress {} -> "BUTTON"
|
||||
ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
|
||||
ButtonAccessTerminal -> "TERMINAL"
|
||||
ButtonAccessTerminal {} -> "TERMINAL"
|
||||
|
||||
closeItemToTextPictures :: FloorItem -> ([String], Color)
|
||||
closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
|
||||
|
||||
@@ -96,14 +96,14 @@ menuOptionToSelectionItem ::
|
||||
MenuOption ->
|
||||
SelectionItem (Universe -> Universe, Universe -> Universe)
|
||||
menuOptionToSelectionItem w padAmount mo =
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = [optionText]
|
||||
, _siHeight = 1
|
||||
, _siWidth = 50
|
||||
, _siIsSelectable = isselectable
|
||||
, _siColor = thecol
|
||||
, _siOffX = 0
|
||||
, _siPayload = (f, g)
|
||||
, _siPayload = Just (f, g)
|
||||
}
|
||||
where
|
||||
isselectable = case _moString mo w of
|
||||
|
||||
@@ -17,7 +17,7 @@ putTerminal :: Color -> Machine -> Terminal -> Placement
|
||||
putTerminal col mc tm =
|
||||
ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
|
||||
\tmpl -> Just $
|
||||
ps0PushPS (PutButton termButton) $
|
||||
ps0PushPS (PutButton defaultButton) $
|
||||
\btpl -> Just $
|
||||
pt0
|
||||
( PutMachine
|
||||
@@ -34,7 +34,7 @@ putTerminal col mc tm =
|
||||
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
|
||||
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
|
||||
& cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
|
||||
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
|
||||
& cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal tmid
|
||||
where
|
||||
tmid = fromJust (_plMID tmpl)
|
||||
btid = fromJust (_plMID btpl)
|
||||
@@ -48,15 +48,5 @@ putMessageTerminal col =
|
||||
& mcType .~ McTerminal
|
||||
& mcHP .~ 100
|
||||
|
||||
termButton :: Button
|
||||
termButton =
|
||||
Button
|
||||
{ _btPos = 0
|
||||
, _btRot = 0
|
||||
, _btEvent = ButtonAccessTerminal
|
||||
, _btID = 0
|
||||
, _btTermMID = Nothing
|
||||
}
|
||||
|
||||
terminalColor :: Color
|
||||
terminalColor = dark magenta
|
||||
|
||||
+18
-24
@@ -1,10 +1,7 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Dodge.Render.HUD (
|
||||
drawHUD,
|
||||
) where
|
||||
module Dodge.Render.HUD (drawHUD) where
|
||||
|
||||
import Dodge.Data.Terminal.Status
|
||||
import Control.Applicative
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
@@ -23,6 +20,7 @@ import Dodge.Data.Config
|
||||
import Dodge.Data.DoubleTree
|
||||
import Dodge.Data.EquipType
|
||||
import Dodge.Data.SelectionList
|
||||
import Dodge.Data.Terminal.Status
|
||||
import Dodge.Data.World
|
||||
import Dodge.DoubleTree
|
||||
import Dodge.Equipment.Text
|
||||
@@ -34,7 +32,6 @@ import Dodge.Item.InvSize
|
||||
import Dodge.Item.Location
|
||||
import Dodge.ListDisplayParams
|
||||
import Dodge.Render.Connectors
|
||||
--import Dodge.Render.HUD.Carte
|
||||
import Dodge.Render.List
|
||||
import Dodge.ScreenPos
|
||||
import Dodge.SelectionSections
|
||||
@@ -105,9 +102,7 @@ getRootItemBounds i inv = do
|
||||
drawMouseOver :: Configuration -> World -> Picture
|
||||
drawMouseOver cfig w =
|
||||
concat
|
||||
( invsel <|> combinvsel
|
||||
<|> drawDragSelecting cfig w
|
||||
)
|
||||
(invsel <|> combinvsel <|> drawDragSelecting cfig w)
|
||||
<> concat (drawDragSelected cfig w)
|
||||
where
|
||||
invsel = do
|
||||
@@ -211,14 +206,14 @@ drawExamineInventory cfig w =
|
||||
)
|
||||
where
|
||||
f str =
|
||||
SelectionItem
|
||||
SelItem
|
||||
{ _siPictures = [str]
|
||||
, _siWidth = 55
|
||||
, _siHeight = 1
|
||||
, _siIsSelectable = True
|
||||
, _siColor = white
|
||||
, _siOffX = 0
|
||||
, _siPayload = ()
|
||||
, _siPayload = Nothing
|
||||
}
|
||||
|
||||
closeObjectInfo :: Int -> Either FloorItem Button -> String
|
||||
@@ -240,11 +235,10 @@ yourAugmentedItem f x g w = case you w ^? crManipulation . manObject of
|
||||
j <- w ^? hud . closeItems . ix i . unNInt
|
||||
flit <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix j
|
||||
return . g $ Left flit
|
||||
-- g . Left $ w ^?! hud . closeItems . ix i
|
||||
Just (SelCloseButton i) -> fromMaybe x $ do
|
||||
j <- w ^? hud . closeButtons . ix i
|
||||
flit <- w ^? cWorld . lWorld . buttons . ix j
|
||||
return . g $ Right flit
|
||||
but <- w ^? cWorld . lWorld . buttons . ix j
|
||||
return . g $ Right but
|
||||
_ -> x
|
||||
|
||||
drawRBOptions :: Configuration -> World -> Picture
|
||||
@@ -343,13 +337,12 @@ combineInventoryExtra ::
|
||||
Configuration ->
|
||||
World ->
|
||||
Picture
|
||||
combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
|
||||
combineInventoryExtra sss msel cfig w = fold $ do
|
||||
(i, j) <- msel
|
||||
si <- sss ^? ix i . ssItems . ix j
|
||||
let col = _siColor si
|
||||
lnks <- si ^? siPayload . ciInvIDs
|
||||
return (lnkMidPosInvSelsCol cfig w j col lnks)
|
||||
<> foldMap invcursor lnks
|
||||
lnks <- si ^? siPayload . _Just . ciInvIDs
|
||||
return (lnkMidPosInvSelsCol cfig w j col lnks) <> foldMap invcursor lnks
|
||||
where
|
||||
invcursor i = do
|
||||
sss' <- w ^? hud . hudElement . diSections
|
||||
@@ -362,32 +355,33 @@ combineInventoryExtra sss msel cfig w = fromMaybe mempty $ do
|
||||
(Just (0, i))
|
||||
|
||||
drawTerminalDisplay :: Int -> Configuration -> LWorld -> Picture
|
||||
drawTerminalDisplay tid cfig w = fromMaybe mempty $ do
|
||||
drawTerminalDisplay tid cfig w = fold $ do
|
||||
tm <- w ^? terminals . ix tid
|
||||
let tsize = getMaxLinesTM + 1
|
||||
return $
|
||||
invHead cfig ("T-" ++ show tid)
|
||||
<> drawSelectionList secondColumnParams cfig (thesellist tm)
|
||||
<> drawSelectionList secondColumnParams cfig (f tm)
|
||||
<> color
|
||||
(withAlpha 0.5 green) -- consider integrating termScreenColor somehow
|
||||
(drawSelectionListBackground secondColumnParams cfig tsize)
|
||||
<> color (dark $ _tmExternalColor tm) (drawTitleBackground cfig)
|
||||
where
|
||||
toselitm (str, col) = SelectionItem [str] 1 55 True col 0 ()
|
||||
toselitm (str, col) = SelItem [str] 1 55 True col 0 Nothing
|
||||
-- not sure if the width (55) is correct here
|
||||
thesellist tm = thelist tm
|
||||
thelist tm =
|
||||
f tm =
|
||||
map toselitm . displayTermInput tm
|
||||
. reverse
|
||||
. take getMaxLinesTM
|
||||
$ _tmDisplayedLines tm
|
||||
displayTermInput tm = case _tmStatus tm of
|
||||
TerminalOff -> id
|
||||
TerminalDeactivated -> id
|
||||
TerminalLineRead -> id
|
||||
TerminalTextInput s ->
|
||||
(++ [(getPromptTM ++ s ++ [cFilledRect], white)])
|
||||
TerminalPressTo s ->
|
||||
(++ [(getPromptTM ++ "PRESS TO "++s, white)])
|
||||
(++ [(getPromptTM ++ "PRESS TO " ++ s, white)])
|
||||
|
||||
-- | hasfoc = clockCycle 10 (V.fromList [[cFilledRect] , "."]) w
|
||||
|
||||
lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
|
||||
@@ -505,4 +499,4 @@ selNumPosCardinal card cfig ldp sss i j = do
|
||||
ygap = _ldpVerticalGap ldp
|
||||
|
||||
selSecSelCol :: Int -> Int -> IM.IntMap (SelectionSection a) -> Maybe Color
|
||||
selSecSelCol i j sss = sss ^? ix i . ssItems . ix j . siColor
|
||||
selSecSelCol i j = (^? ix i . ssItems . ix j . siColor)
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Dodge.Render.Picture (
|
||||
fixedCoordPictures,
|
||||
) where
|
||||
@@ -109,9 +110,8 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
|
||||
OverCombFilter{} -> drawJumpDown 5
|
||||
OverCombCombine{} -> drawGapPlus 5
|
||||
OverCombEscape -> rotate (pi / 4) $ drawPlus 5
|
||||
OverTerminalContinue{} -> drawReturn 5
|
||||
OverTerminalReturn{} -> drawReturn 5
|
||||
OverTerminalEscape -> rotate (pi / 4) $ drawPlus 5
|
||||
OverTerminal _ ts -> drawCursorByTerminalStatus ts
|
||||
OutsideTerminal -> rotate (pi / 4) $ drawPlus 5
|
||||
MouseGameRotate -> rotate a (drawVerticalDoubleArrow 5)
|
||||
where
|
||||
w = u ^. uvWorld
|
||||
@@ -122,6 +122,21 @@ mouseCursorType u = case u ^. uvWorld . input . mouseContext of
|
||||
argV (w ^. cWorld . lWorld . lAimPos -.- cpos)
|
||||
- w ^. wCam . camRot
|
||||
|
||||
drawCursorByTerminalStatus :: TerminalStatus -> Picture
|
||||
drawCursorByTerminalStatus = \case
|
||||
TerminalPressTo "QUIT" -> drawQuitTerminal 5
|
||||
TerminalPressTo _ -> drawArrowDown 5
|
||||
TerminalTextInput "QUIT" -> drawQuitTerminal 5
|
||||
TerminalTextInput{} -> drawReturn 5
|
||||
_ -> drawEmptySet 5
|
||||
|
||||
drawQuitTerminal :: Float -> Picture
|
||||
drawQuitTerminal x = fold
|
||||
[ line [V2 x x, V2 (- x) (- x)]
|
||||
, line [V2 x (-x), V2 (- x) x]
|
||||
, polygonWire (square x)
|
||||
]
|
||||
|
||||
drawEmptySet :: Float -> Picture
|
||||
drawEmptySet x =
|
||||
fold
|
||||
@@ -202,6 +217,14 @@ drawVerticalDoubleArrow x =
|
||||
z = 1.5 * x
|
||||
w = 0.6 * x
|
||||
|
||||
drawArrowDown :: Float -> Picture
|
||||
drawArrowDown x =
|
||||
line [V2 0 z, V2 0 (- z)]
|
||||
<> line [V2 (- w) (w - z), V2 0 (- z), V2 w (w - z)]
|
||||
where
|
||||
z = 1 * x
|
||||
w = 0.6 * x
|
||||
|
||||
drawDragDrop :: Float -> Picture
|
||||
drawDragDrop x =
|
||||
line (fmap (+ V2 z (- x)) [V2 (- x) x, V2 0 x, V2 0 (- x)])
|
||||
|
||||
@@ -26,7 +26,7 @@ rezBox :: LightSource -> Room
|
||||
rezBox ls =
|
||||
roomRect 40 60 1 1
|
||||
& rmPmnts .~ [sPS (V2 20 1) 0 $ PutLS ls
|
||||
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDisconnectTerminal])
|
||||
, putMessageTerminal terminalColor (defaultTerminal & tmBootLines .~ (makeTermPara s) <> tlSetStatus (TerminalPressTo "QUIT") <> [TLine 1 [] TmWdWdDeactivateTerminal])
|
||||
& plSpot .~ PS (V2 20 0) 0
|
||||
]
|
||||
& restrictInLinks (\(V2 _ h, _) -> h < 1)
|
||||
@@ -35,6 +35,9 @@ rezBox ls =
|
||||
where
|
||||
s = "RESPAWN POINT SET AT THIS LOCATION."
|
||||
|
||||
tutorialMessage1 :: String
|
||||
tutorialMessage1 = "SYNTHESIS SUCCESSFUL. MOVEMENT TEST 1 INITIATED [WASD]. INTERACTION TEST 1 IN QUEUE [SPACE]."
|
||||
|
||||
rezBox' :: RandomGen g => State g (MetaTree Room String)
|
||||
rezBox' = do
|
||||
col <- rezColor
|
||||
|
||||
@@ -11,7 +11,7 @@ module Dodge.SoundLogic (
|
||||
soundContinueVol,
|
||||
soundMultiFrom,
|
||||
stopSoundFrom,
|
||||
soundWithStatus,
|
||||
-- soundWithStatus,
|
||||
|
||||
-- * helper to determine the angle of a sound given a world position
|
||||
soundAngle,
|
||||
|
||||
+43
-200
@@ -3,7 +3,6 @@
|
||||
module Dodge.Terminal (
|
||||
makeTermLine,
|
||||
connectionBlurbLines,
|
||||
disconnectTerminal,
|
||||
textTerminal,
|
||||
simpleTermMessage,
|
||||
damageCodeCommand,
|
||||
@@ -13,19 +12,15 @@ module Dodge.Terminal (
|
||||
toggleCommand,
|
||||
terminalReturnEffect,
|
||||
getCommands,
|
||||
makeColorTermPara,
|
||||
commandColor,
|
||||
tabComplete,
|
||||
tlSetStatus,
|
||||
) where
|
||||
|
||||
--import Dodge.Data.WorldEffect
|
||||
|
||||
import qualified Data.Map.Strict as M
|
||||
import Color
|
||||
import Data.Char
|
||||
import qualified Data.List as List
|
||||
import Color
|
||||
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
|
||||
import qualified Data.Map.Strict as M
|
||||
--import Control.Monad
|
||||
--import Data.Char
|
||||
--import qualified Data.Map.Strict as M
|
||||
@@ -41,10 +36,7 @@ import LensHelp
|
||||
import Sound.Data
|
||||
|
||||
textTerminal :: Terminal
|
||||
textTerminal =
|
||||
defaultTerminal
|
||||
{ _tmBootLines = connectionBlurb
|
||||
}
|
||||
textTerminal = defaultTerminal{_tmBootLines = connectionBlurb}
|
||||
|
||||
connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
|
||||
connectionBlurbLines tls =
|
||||
@@ -54,53 +46,6 @@ connectionBlurbLines tls =
|
||||
++ tls
|
||||
++ [TLine 10 [TerminalLineConst "READY FOR INPUT" termTextColor] (TmTmSetStatus (TerminalTextInput ""))]
|
||||
|
||||
-- ++ [TerminalLineEffect 0 (TmTmSetStatus (TerminalTextInput "" 0))]
|
||||
|
||||
--quitCommand :: TerminalCommand
|
||||
--quitCommand =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "QUIT"
|
||||
-- , _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
|
||||
-- , _tcHelp = "Disconnects the terminal."
|
||||
-- , _tcEffect = TerminalCommandArguments $ NoArguments [TLine 0 [] TmWdWdDisconnectTerminal]
|
||||
-- }
|
||||
|
||||
--helpCommand :: TerminalCommand
|
||||
--helpCommand =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "HELP"
|
||||
-- , _tcAlias = ["H", "MAN"]
|
||||
-- , _tcHelp = "Displays help for a specific command."
|
||||
-- , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
|
||||
-- }
|
||||
|
||||
--getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine]
|
||||
--getCommandsHelp tm w = foldr f mempty $ getCommands tm
|
||||
-- where
|
||||
-- f tc =
|
||||
-- M.insert
|
||||
-- (_tcString tc)
|
||||
-- ( [ makeTermLine "Command:"
|
||||
-- , makeColorTermLine commandColor (_tcString tc)
|
||||
-- , makeTermLine "Aliases:"
|
||||
-- , makeColorTermLine commandColor (unwords (_tcAlias tc))
|
||||
-- ]
|
||||
-- ++ case argumentHelp tc tm w of
|
||||
-- (arghelp, Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp
|
||||
-- (arghelp, Just args) ->
|
||||
-- makeTermPara (_tcHelp tc ++ " " ++ arghelp)
|
||||
-- ++ [makeColorTermLine commandColor $ unwords args]
|
||||
-- )
|
||||
|
||||
--commandsCommand :: TerminalCommand
|
||||
--commandsCommand =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "COMMANDS"
|
||||
-- , _tcAlias = ["COMMAND", "COM"]
|
||||
-- , _tcHelp = "Displays available commands."
|
||||
-- , _tcEffect = TerminalCommandEffectCommands
|
||||
-- }
|
||||
|
||||
connectionBlurb :: [TerminalLine]
|
||||
connectionBlurb = connectionBlurbLines []
|
||||
|
||||
@@ -122,30 +67,38 @@ getCommand tm = \case
|
||||
TCSensorInfo -> sensorCommand
|
||||
|
||||
damageCodeCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound..]
|
||||
damageCodeCommand = PTE.singleton "DAMAGECODE" $ PTE.fromList $ mapMaybe f [minBound ..]
|
||||
where
|
||||
f :: SensorType -> Maybe (String, [TerminalLine])
|
||||
f st = do
|
||||
s <- g st
|
||||
return (s, [TLine 0 [] $ TmGetDamageCoding st])
|
||||
g = fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
|
||||
. reverse . show
|
||||
g =
|
||||
fmap (map toUpper) . fmap reverse . List.stripPrefix (reverse "Sensor")
|
||||
. reverse
|
||||
. show
|
||||
|
||||
-- ugly, when changing check getSensorInfo
|
||||
sensorCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
sensorCommand = PTE.singleton "SENSOR" $ PTE.fromList
|
||||
[("REQUIREMENT", [])
|
||||
,("DISTANCE",[])
|
||||
,("STATUS",[])
|
||||
]
|
||||
sensorCommand =
|
||||
PTE.singleton "SENSOR" $
|
||||
PTE.fromList
|
||||
[ ("REQUIREMENT", [])
|
||||
, ("DISTANCE", [])
|
||||
, ("STATUS", [])
|
||||
]
|
||||
|
||||
toggleCommand :: Terminal -> PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
toggleCommand tm = PTE.singleton "TOGGLE" $ PTE.fromList $
|
||||
M.toList $ fmap f $ tm ^. tmToggles
|
||||
toggleCommand tm =
|
||||
PTE.singleton "TOGGLE" $
|
||||
PTE.fromList $
|
||||
M.toList $ fmap f $ tm ^. tmToggles
|
||||
where
|
||||
f x = [TLine 1
|
||||
[TerminalLineConst "TOGGLE DONE!" termTextColor]
|
||||
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
|
||||
f x =
|
||||
[ TLine
|
||||
1
|
||||
[TerminalLineConst "TOGGLE DONE!" termTextColor]
|
||||
(TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
|
||||
]
|
||||
|
||||
helpCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
@@ -158,7 +111,7 @@ helpStrings =
|
||||
]
|
||||
|
||||
quitCommand :: PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
|
||||
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdDisconnectTerminal])
|
||||
quitCommand = PTE.singleton "QUIT" (PTE.singleton "" [TLine 0 [] TmWdWdPowerDownTerminal])
|
||||
|
||||
makeTermLine :: String -> TerminalLine
|
||||
makeTermLine = makeColorTermLine termTextColor
|
||||
@@ -191,96 +144,13 @@ tabComplete s' tm = case PTE.lookup s $ getCommands tm of
|
||||
[] -> tm
|
||||
[x] -> tm & tmStatus . tiText .~ (y ++ x)
|
||||
xs ->
|
||||
tm & tmStatus .~ TerminalLineRead
|
||||
tm & tmStatus .~ TerminalLineRead
|
||||
& tmFutureLines
|
||||
.~ (makeColorTermPara
|
||||
commandColor
|
||||
(unwords xs) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
|
||||
|
||||
--doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments
|
||||
--doTerminalCommandEffect tce = case tce of
|
||||
-- TerminalCommandArguments eas -> \_ _ -> eas
|
||||
-- TerminalCommandEffectDamageCoding -> \_ -> OneArgument "a damage type" . getDamageCoding
|
||||
-- TerminalCommandEffectSensorParameter -> \tm -> OneArgument "a sensor parameter" . sensorInfoMap tm
|
||||
-- TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "a linked object" (togglesToEffects tm)
|
||||
-- TerminalCommandEffectHelp -> \tm -> OneArgument "an available command" . getCommandsHelp tm
|
||||
-- TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str)
|
||||
-- TerminalCommandEffectCommands -> \tm _ ->
|
||||
-- NoArguments
|
||||
-- ( makeTermLine "Available commands:" :
|
||||
-- makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm))
|
||||
-- )
|
||||
-- TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TLine 0 [] (TmWdWdfromWdWd eff) : map makeTermLine followingLines
|
||||
-- TerminalCommandEffectNone -> \_ _ -> NoArguments []
|
||||
|
||||
--argumentHelp :: TerminalCommand -> Terminal -> World -> (String, Maybe [String])
|
||||
--argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
|
||||
-- NoArguments{} -> ("Any arguments provided to this command are ignored.", Nothing)
|
||||
-- OneArgument argtype argm ->
|
||||
-- ( "Expects " ++ argtype ++ " as argument. Available arguments: "
|
||||
-- , Just (M.keys argm)
|
||||
-- )
|
||||
|
||||
--infoCommand :: String -> TerminalCommand
|
||||
--infoCommand str =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "INFORMATION"
|
||||
-- , _tcAlias = ["INFO", "I"]
|
||||
-- , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
|
||||
-- , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str)
|
||||
-- }
|
||||
|
||||
--singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand
|
||||
--singleCommand followingLines command aliases htext eff =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = command
|
||||
-- , _tcAlias = aliases
|
||||
-- , _tcHelp = htext
|
||||
-- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
|
||||
-- }
|
||||
|
||||
--getDamageCoding :: World -> M.Map String [TerminalLine]
|
||||
--getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
|
||||
|
||||
--sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine]
|
||||
--sensorInfoMap tm w =
|
||||
-- M.fromList
|
||||
-- [ ("Requirement", getSensor _proxRequirement tm w)
|
||||
-- , ("Distance", getSensor _proxDist tm w)
|
||||
-- , ("Currentstatus", getSensor _proxStatus tm w)
|
||||
-- , ("Paststatus", getSensor _sensToggle tm w)
|
||||
-- ]
|
||||
|
||||
--getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
|
||||
--getSensor f tm w =
|
||||
-- maybe
|
||||
-- []
|
||||
-- (makeTermPara . map toLower . show . f)
|
||||
-- (w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
|
||||
|
||||
|
||||
--sensorCommand :: TerminalCommand
|
||||
--sensorCommand =
|
||||
-- TerminalCommand
|
||||
-- { _tcString = "SENSOR"
|
||||
-- , _tcAlias = ["SEN"]
|
||||
-- , _tcHelp = "Access information concerning the connected sensor."
|
||||
-- , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
|
||||
-- }
|
||||
|
||||
disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm =
|
||||
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
|
||||
. exitTerminalSubInv
|
||||
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ []
|
||||
)
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
Just _ ->
|
||||
w & hud . hudElement . subInventory
|
||||
.~ NoSubInventory --MouseInvNothing
|
||||
_ -> w
|
||||
.~ ( makeColorTermPara
|
||||
commandColor
|
||||
(unwords xs)
|
||||
<> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s]
|
||||
)
|
||||
|
||||
--damageCodeCommand :: TerminalCommand
|
||||
--damageCodeCommand =
|
||||
@@ -306,47 +176,20 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
simpleTermMessage :: [String] -> Terminal
|
||||
simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs
|
||||
|
||||
--commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
|
||||
--commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
|
||||
-- (str, args) <- safeUncons $ words s
|
||||
-- command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
|
||||
-- case doTerminalCommandEffect (_tcEffect command) tm w of
|
||||
-- NoArguments tls -> Just tls
|
||||
-- OneArgument argtype m ->
|
||||
-- let setpartial
|
||||
-- | null (_tmPartialCommand tm) =
|
||||
-- TLine 0 [] (TmTmSetPartialCommand (Just command)) :
|
||||
-- makeTermPara ("Expects " ++ argtype ++ " as an argument")
|
||||
-- | otherwise =
|
||||
-- TLine 0 [] (TmTmSetPartialCommand Nothing) :
|
||||
-- makeTermPara "No argument input, cancelling"
|
||||
-- in Just $
|
||||
-- fromMaybe setpartial $
|
||||
-- safeHead args >>= (m M.!?)
|
||||
-- where
|
||||
-- errline = makeColorTermLine red
|
||||
|
||||
terminalReturnEffect :: Int -> World -> World
|
||||
terminalReturnEffect tmid w = fromMaybe w $ do
|
||||
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||
s <- tm ^? tmStatus . tiText
|
||||
return $
|
||||
runTerminalInput s tm $
|
||||
w
|
||||
& cWorld . lWorld . terminals . ix tmid . tmDisplayedLines
|
||||
.:~ (getPromptTM ++ s, termTextColor)
|
||||
|
||||
runTerminalInput :: String -> Terminal -> World -> World
|
||||
runTerminalInput s tm w =
|
||||
w & cWorld . lWorld . terminals . ix (_tmID tm)
|
||||
%~ ( (tmFutureLines ++.~ ss <> [TLine 1 [] (TmTmSetStatus $ TerminalTextInput "")])
|
||||
. (tmCommandHistory %~ take 10 . (s :))
|
||||
. (tmStatus .~ TerminalLineRead)
|
||||
)
|
||||
let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
|
||||
let args = words s
|
||||
x <- args ^? ix 0
|
||||
teff <- PTE.lookup x (getCommands tm)
|
||||
let y = fromMaybe "" (args ^? ix 1)
|
||||
PTE.lookup y teff
|
||||
return $ w
|
||||
& totm . tmDisplayedLines .:~ (getPromptTM ++ s, termTextColor)
|
||||
& totm . tmFutureLines .~ ss <> tlSetStatus (TerminalTextInput "")
|
||||
& totm . tmCommandHistory %~ take 10 . (s :)
|
||||
& totm . tmStatus .~ TerminalLineRead
|
||||
where
|
||||
ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
|
||||
let args = words s
|
||||
x <- args ^? ix 0
|
||||
teff <- PTE.lookup x (getCommands tm)
|
||||
let y = fromMaybe "" (args ^? ix 1)
|
||||
PTE.lookup y teff
|
||||
totm = cWorld . lWorld . terminals . ix tmid
|
||||
|
||||
@@ -10,6 +10,7 @@ import Control.Lens
|
||||
termScreenColor :: Terminal -> Maybe Color
|
||||
termScreenColor tm = case tm ^. tmStatus of
|
||||
TerminalOff -> Nothing
|
||||
TerminalDeactivated -> Nothing
|
||||
TerminalTextInput _ -> Just green
|
||||
TerminalPressTo{} -> Just green
|
||||
TerminalLineRead -> Just white
|
||||
|
||||
@@ -28,8 +28,7 @@ import qualified IntMapHelp as IM
|
||||
import qualified Data.Map.Strict as M
|
||||
|
||||
testStringInit :: Universe -> [String]
|
||||
testStringInit u = [show $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHP
|
||||
, show $ u ^? uvWorld . timeFlow . respawnDelay]
|
||||
testStringInit u = map show $ u ^.. uvWorld . cWorld . lWorld . terminals . each . tmStatus
|
||||
-- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
|
||||
-- where
|
||||
-- g db = (pz,z,norm v)
|
||||
|
||||
+2
-5
@@ -397,11 +397,8 @@ updateMouseContextGame cfig u = case u ^. uvWorld . input . mouseContext of
|
||||
tm <- w ^? cWorld . lWorld . terminals . ix tmid
|
||||
return $
|
||||
if isOverTerminalScreen cfig mpos
|
||||
then fromMaybe NoMouseContext $ do
|
||||
let s = tm ^. tmStatus . tiText
|
||||
guard $ not (null s) -- && _tmStatus tm == TerminalTextInput
|
||||
return $ OverTerminalReturn tmid
|
||||
else OverTerminalEscape
|
||||
then OverTerminal tmid (tm ^. tmStatus)
|
||||
else OutsideTerminal
|
||||
|
||||
getMenuMouseContext :: ScreenLayer -> Universe -> MouseContext
|
||||
getMenuMouseContext screen u = case screen ^. scOptions of
|
||||
|
||||
@@ -218,9 +218,9 @@ updateMouseClickInGame cfig w = case w ^. input . mouseContext of
|
||||
&& isGroupSelectableSection (fst x) ->
|
||||
w & input . mouseContext .~ OverInvDragSelect x (Just $ snd x)
|
||||
OverInvSelect x -> startDrag x cfig w
|
||||
OverTerminalReturn tmid -> terminalReturnEffect tmid w
|
||||
OverTerminalContinue tmid -> undefined
|
||||
OverTerminalEscape -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
OverTerminal tmid (TerminalTextInput {}) -> terminalReturnEffect tmid w
|
||||
OverTerminal tmid (TerminalPressTo{}) -> continueTerminal tmid w
|
||||
OutsideTerminal -> w & hud . hudElement . subInventory .~ NoSubInventory
|
||||
OverCombSelect x ->
|
||||
w & hud . hudElement . subInventory . ciSelection ?~ f x
|
||||
& worldEventFlags . at CombineInventoryChange ?~ ()
|
||||
@@ -385,14 +385,20 @@ updateKeysInTerminal :: Int -> Universe -> Universe
|
||||
updateKeysInTerminal tmid u = fromMaybe u $ do
|
||||
tm <- u ^? uvWorld . cWorld . lWorld . terminals . ix tmid
|
||||
return $ case tm ^. tmStatus of
|
||||
TerminalDeactivated -> u & uvWorld . hud . hudElement . subInventory .~ NoSubInventory
|
||||
TerminalTextInput{} -> updateKeysTextInputTerminal tmid u
|
||||
TerminalPressTo{} -> updateKeyContinueTerminal tmid u
|
||||
_ -> u
|
||||
|
||||
updateKeyContinueTerminal :: Int -> Universe -> Universe
|
||||
updateKeyContinueTerminal tmid u
|
||||
| any (==0) $ u ^. uvWorld . input . pressedKeys =
|
||||
u & uvWorld . cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
|
||||
u & uvWorld %~ continueTerminal tmid
|
||||
| otherwise = u
|
||||
|
||||
continueTerminal :: Int -> World -> World
|
||||
continueTerminal tmid = cWorld . lWorld . terminals . ix tmid . tmStatus .~ TerminalLineRead
|
||||
|
||||
updateKeysTextInputTerminal :: Int -> Universe -> Universe
|
||||
updateKeysTextInputTerminal tmid u =
|
||||
u
|
||||
@@ -546,7 +552,7 @@ getCloseObj w = getSelectedCloseObj w <|> firstcitem <|> firstcbut
|
||||
tryCombine :: (Int, Int) -> World -> World
|
||||
tryCombine (i, j) w = fromMaybe w $ do
|
||||
sss <- w ^? hud . hudElement . subInventory . ciSections
|
||||
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload
|
||||
CombinableItem is it <- sss ^? ix i . ssItems . ix j . siPayload . _Just
|
||||
p <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
|
||||
return $
|
||||
snd (createItemYou it (foldr (destroyInvItem 0) w (sort is)))
|
||||
|
||||
@@ -63,11 +63,11 @@ mouseClickOptionsList u = fromMaybe u $ do
|
||||
case u ^. uvWorld . input . mouseButtons of
|
||||
mbs | mbs ^. at ButtonLeft == Just 0 -> do
|
||||
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
|
||||
f <- sl ^? ix i . siPayload . _1
|
||||
f <- sl ^? ix i . siPayload . _Just . _1
|
||||
return $ f u & uvSoundQueue .:~ click1S
|
||||
mbs | mbs ^. at ButtonRight == Just 0 -> do
|
||||
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
|
||||
f <- sl ^? ix i . siPayload . _2
|
||||
f <- sl ^? ix i . siPayload . _Just . _2
|
||||
return $ f u & uvSoundQueue .:~ click1S
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
+39
-13
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Dodge.WorldEffect (
|
||||
doWdWd,
|
||||
accessTerminal,
|
||||
@@ -6,6 +7,7 @@ module Dodge.WorldEffect (
|
||||
lineOutputTerminal,
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe
|
||||
@@ -51,12 +53,13 @@ doWdWd we = case we of
|
||||
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
|
||||
return $ heldEffectMuzzles loc cr w
|
||||
|
||||
accessTerminal :: Maybe Int -> World -> World
|
||||
accessTerminal mtmid w = fromMaybe w $ do
|
||||
tmid <- mtmid
|
||||
accessTerminal :: Int -> World -> World
|
||||
accessTerminal tid w = fromMaybe w $ do
|
||||
tm <- w ^? cWorld . lWorld . terminals . ix tid
|
||||
guard (tm ^. tmStatus /= TerminalDeactivated)
|
||||
return $
|
||||
w & hud . hudElement . subInventory .~ DisplayTerminal tmid
|
||||
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
|
||||
w & hud . hudElement . subInventory .~ DisplayTerminal tid
|
||||
& cWorld . lWorld . terminals . ix tid %~ tryToBoot
|
||||
where
|
||||
tryToBoot tm = case _tmStatus tm of
|
||||
TerminalTextInput{} -> tm
|
||||
@@ -66,6 +69,7 @@ accessTerminal mtmid w = fromMaybe w $ do
|
||||
tm
|
||||
& tmFutureLines .~ _tmBootLines tm
|
||||
& tmStatus .~ TerminalLineRead
|
||||
TerminalDeactivated -> error "managed to boot a deactivated terminal"
|
||||
|
||||
torqueCr :: Float -> Int -> World -> World
|
||||
torqueCr x cid w
|
||||
@@ -84,7 +88,8 @@ lineOutputTerminal tls =
|
||||
}
|
||||
|
||||
doDeathTriggers :: Terminal -> World -> World
|
||||
doDeathTriggers tm = cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs
|
||||
doDeathTriggers tm = (cWorld . lWorld . triggers %~ flip (foldl' $ flip doDeathToggle) xs)
|
||||
. (cWorld . lWorld . terminals . ix (tm ^. tmID) . tmStatus .~ TerminalDeactivated)
|
||||
where
|
||||
xs = M.elems $ _tmToggles tm
|
||||
|
||||
@@ -98,17 +103,18 @@ doTmWdWd tmwdwd = case tmwdwd of
|
||||
return $ cWorld . lWorld . terminals . ix tid . tmDisplayedLines .~ []
|
||||
TmGetDamageCoding st -> \tm w -> fromMaybe w $ do
|
||||
tid <- tm ^? tmID
|
||||
return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines
|
||||
.~ decodeSensorType st w
|
||||
return $
|
||||
w & cWorld . lWorld . terminals . ix tid . tmFutureLines
|
||||
.~ decodeSensorType st w
|
||||
TmGetSensor s -> \tm w -> fromMaybe w $ do
|
||||
tid <- tm ^? tmID
|
||||
return $ w & cWorld . lWorld . terminals . ix tid . tmFutureLines .~ getSensorInfo w tm s
|
||||
TmTmSetStatus x -> \tm -> fromMaybe id $ do
|
||||
tid <- tm ^? tmID
|
||||
return $ cWorld . lWorld . terminals . ix tid . tmStatus .~ x
|
||||
-- TmDisplayCommands -> \tm -> fromMaybe id $ do
|
||||
-- tid <- tm ^? tmID
|
||||
-- return $ cWorld . lWorld . terminals . ix tid %~ tabComplete ""
|
||||
-- TmDisplayCommands -> \tm -> fromMaybe id $ do
|
||||
-- tid <- tm ^? tmID
|
||||
-- return $ cWorld . lWorld . terminals . ix tid %~ tabComplete ""
|
||||
--return $ cWorld . lWorld . terminals . ix tid . tmFutureLines .~
|
||||
-- makeColorTermPara commandColor
|
||||
-- (unwords (map fst (PTE.toList $ getCommands tm)))
|
||||
@@ -116,18 +122,38 @@ doTmWdWd tmwdwd = case tmwdwd of
|
||||
-- tid <- tm ^? tmID
|
||||
-- return $ cWorld . lWorld . terminals . ix tid . tmPartialCommand .~ x
|
||||
TmWdId -> const id
|
||||
TmWdWdDisconnectTerminal -> disconnectTerminal
|
||||
TmWdWdPowerDownTerminal -> powerDownTerminal
|
||||
TmWdWdDeactivateTerminal -> deactivateTerminal
|
||||
TmWdWdTermSound sid -> \tm w ->
|
||||
let tpos = fromMaybe 0 $ w ^? cWorld . lWorld . buttons . ix (_tmButtonID tm) . btPos
|
||||
in soundStart TerminalSound tpos sid Nothing w
|
||||
TmWdWdDoDeathTriggers -> doDeathTriggers
|
||||
TmWdWdfromWdWd f -> \_ -> doWdWd f
|
||||
|
||||
powerDownTerminal :: Terminal -> World -> World
|
||||
powerDownTerminal tm =
|
||||
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
|
||||
. (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
|
||||
. exitTerminalSubInv
|
||||
|
||||
deactivateTerminal :: Terminal -> World -> World
|
||||
deactivateTerminal tm =
|
||||
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalDeactivated)
|
||||
. (cWorld . lWorld . terminals . ix (_tmID tm) . tmDisplayedLines .~ [])
|
||||
. exitTerminalSubInv
|
||||
|
||||
exitTerminalSubInv :: World -> World
|
||||
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
|
||||
Just _ ->
|
||||
w & hud . hudElement . subInventory
|
||||
.~ NoSubInventory --MouseInvNothing
|
||||
_ -> w
|
||||
|
||||
decodeSensorType :: SensorType -> World -> [TerminalLine]
|
||||
decodeSensorType st w = fromMaybe [] $ do
|
||||
x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
|
||||
return [makeTermLine $ show x]
|
||||
|
||||
|
||||
-- ugly, when changing check sensorCommand
|
||||
getSensorInfo :: World -> Terminal -> String -> [TerminalLine]
|
||||
getSensorInfo w tm = \case
|
||||
|
||||
Reference in New Issue
Block a user