From b54864bbdabdc876bc0eab1e49a19c034c70a68d Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 31 May 2022 13:30:27 +0100 Subject: [PATCH] Work on more complicated terminals --- src/Dodge/Data.hs | 6 ++ src/Dodge/Event.hs | 10 ++++ src/Dodge/Floor.hs | 2 + src/Dodge/Inventory.hs | 4 ++ src/Dodge/Machine.hs | 3 +- src/Dodge/Placement/Instance/Analyser.hs | 51 ++++------------ src/Dodge/Placement/Instance/Terminal.hs | 51 ++++++++++------ src/Dodge/PlacementSpot.hs | 10 ++++ src/Dodge/Render/HUD.hs | 4 ++ src/Dodge/Room/Door.hs | 1 + src/Dodge/Room/SensorDoor.hs | 1 - src/Dodge/Room/Warning.hs | 74 ++++++++++++++++++++++++ src/Geometry/Polygon.hs | 6 +- 13 files changed, 159 insertions(+), 64 deletions(-) create mode 100644 src/Dodge/Room/Warning.hs diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index bdec05b0a..0313b9eb2 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -385,12 +385,18 @@ data TerminalParams = NoTerminalParams | TerminalParams , _termFutureLines :: [TerminalLine] , _termMaxLines :: Int , _termTitle :: String + , _termSel :: Maybe Int + , _termOptions :: [(String, World -> World)] } data TerminalLine = TerminalLineDisplay {_tlPause :: Int ,_tlString :: World -> (String, Color) } + | TerminalLineChoice + {_tlPause :: Int + ,_tlOptions :: [(String,World -> World)] + } | TerminalLineEffect {_tlPause :: Int ,_tlEffect :: SubInventory -> World -> World diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 0702e0d8a..08c223fc3 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -92,6 +92,13 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of (DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) (_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w) + ( DisplayInventory (DisplayTerminal tp _) , ButtonLeft) + -> Just $ fromMaybe w + $ do -- ugly + i <- _termSel tp + f <- _termOptions tp !? i + return $ w & uvWorld %~ snd f + & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory) $ do -- ugly @@ -140,6 +147,9 @@ wheelEvent y w = case _hudElement $ _hud w of | otherwise -> w & moveTweakSel yi DisplayInventory (CombineInventory _) -> w & hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) + DisplayInventory (DisplayTerminal tp _) -> w + & hud . hudElement . subInventory . termParams . termSel . _Just + %~ ((`mod` length (_termOptions tp)) . subtract yi) _ -> w where numcombs = length $ combineItemListYou w diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index e6f822920..e7f123786 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -16,6 +16,7 @@ import Dodge.PlacementSpot import Dodge.Annotation --import Dodge.Placement.Instance.Sensor import Dodge.Creature +import Dodge.Room.Warning --import Dodge.LevelGen.Data --import Dodge.LevelGen.Switch --import Dodge.Item.Weapon.Launcher @@ -39,6 +40,7 @@ import System.Random initialAnoTree :: Tree [Annotation] initialAnoTree = padSucWithDoors $ treeFromPost [[AnoApplyInt 0 startRoom] + , [SpecificRoom $ warningRooms 7] , [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400 & rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit) , spNoID anyUnusedSpot (PutCrit armourChaseCrit) diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 11f167054..f13ff3ca5 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -164,6 +164,10 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . Just (TerminalLineEffect _ eff) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail & eff (_subInventory . _hudElement $ _hud w) + Just (TerminalLineChoice _ ops) -> w + & hud . hudElement . subInventory . termParams . termFutureLines %~ tail + & hud . hudElement . subInventory . termParams . termOptions .~ ops + & hud . hudElement . subInventory . termParams . termSel ?~ 0 -- this looks ugly... updateCloseObjects :: World -> World diff --git a/src/Dodge/Machine.hs b/src/Dodge/Machine.hs index dfdf51f6d..66b545650 100644 --- a/src/Dodge/Machine.hs +++ b/src/Dodge/Machine.hs @@ -35,8 +35,7 @@ machineUpdateDeathEff f mc machineAddSound :: SoundID -> (Machine -> World -> World) -> Machine -> World -> World machineAddSound sid f mc w - | d < 200 - = soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w + | d < 200 = soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w | otherwise = f mc w where d = dist (_crPos $ you w) (_mcPos mc) diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 50ea962c0..539ab6fb3 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -1,9 +1,13 @@ -module Dodge.Placement.Instance.Analyser where +module Dodge.Placement.Instance.Analyser + ( analyser' + , testYouHave + , testYourHealth + ) where import Dodge.LevelGen.Data --import Dodge.PlacementSpot import Dodge.Data import Dodge.Base.You -import Dodge.Default +--import Dodge.Default --import Dodge.Tree --import Dodge.RoomLink --import Dodge.Room.Door @@ -14,7 +18,7 @@ import Dodge.Default --import Dodge.Room.Foreground --import Dodge.Room.RoadBlock import Dodge.Placement.Instance -import Dodge.Placement.Shift +--import Dodge.Placement.Shift import Dodge.SoundLogic --import Dodge.Default.Room --import Dodge.Item.Weapon.BulletGuns @@ -24,8 +28,8 @@ import Dodge.SoundLogic import Geometry --import Padding import Color -import Shape -import ShapePicture +--import Shape +--import ShapePicture import LensHelp --import Dodge.RandomHelp @@ -67,6 +71,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t ++ map simpleline afters , _termMaxLines = 7 , _termTitle = "ANALYSER" + , _termSel = Nothing + , _termOptions = [] } ) (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) @@ -79,41 +85,6 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t _ -> (fails,red) updatebuttonname = plType . putButton . btText .~ "ANALYSER" -analyser - :: [String] -- | initial text - -> String -- | succeed text - -> String -- | fail text - -> [String] -- | after text - -> (Machine -> World -> World) - -> PlacementSpot - -> PlacementSpot - -> Placement -analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp -> - Just $ psPtCont psmc - (PutMachine aquamarine (reverse $ square 10) defaultMachine - { _mcDraw = const . noPic . colorSH aquamarine . upperPrismPoly 25 $ square 10 - , _mcUpdate = \mc -> (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) - . upf mc - , _mcSensor = SensorCloseToggle NotClose False - } - ) $ \anmc -> Just - $ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc) - $ updatebuttontext $ putTerminal $ const $ TerminalParams - { _termDisplayedLines = [] - , _termFutureLines = map simpleline starts - ++ [testline' (fromJust $ _plMID anmc)] - ++ map simpleline afters - , _termMaxLines = 7 - , _termTitle = "ANALYSER" - } - where - simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)} - testline' mcid = TerminalLineDisplay 0 (testline mcid) - testline mcid w = case w ^? machines . ix mcid . mcSensor . sensToggle of - Just True -> (sucs,green) - _ -> (fails,red) - updatebuttontext = plType . putButton . btText .~ "ANALYSER" - analyserTest :: (World -> Bool) -> Machine -> World -> World analyserTest t mc w = case (_sensCloseToggle sens diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 0ad55aa69..57d76a3f8 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -27,7 +27,7 @@ putTerminal' -> Placement putTerminal' col mcf = ps0PushPS (PutButton thebutton) $ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine - { _mcDraw = noPic . colorSH col . terminalShape + { _mcDraw = noPic . terminalShape col , _mcHP = 100 , _mcUpdate = mcf (fromJust $ _plMID pl) , _mcSensor = SensorCloseToggle NotClose False @@ -42,13 +42,13 @@ putTerminal' col mcf = ps0PushPS (PutButton thebutton) , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff - , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" + , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing [] } putTerminal :: (GenParams -> TerminalParams) -> Placement putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine - { _mcDraw = noPic . colorSH terminalColor . terminalShape + { _mcDraw = noPic . terminalShape terminalColor , _mcHP = 100 , _mcUpdate = machineAddSound fridgeHumS $ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing) @@ -68,14 +68,24 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton) , _btID = 0 , _btText = "TERMINAL" , _btState = BtOff - , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" + , _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing [] } terminalColor :: Color terminalColor = dark magenta -terminalShape :: Machine -> Shape -terminalShape _ = upperPrismPoly 15 $ square 10 +terminalShape :: Color -> Machine -> Shape +--terminalShape _ = upperPrismPoly 15 $ square 10 +terminalShape col _ = colorSH col (prismPoly + [V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10] + [V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0] + ) + <> colorSH black (prismPoly + [V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10] + [V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9] + --[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10] + --[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9] + ) displayTerminalMessage :: Int -> World -> World displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal @@ -84,18 +94,21 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display } simpleTermMessage :: [String] -> (GenParams -> TerminalParams) -simpleTermMessage ss = const $ TerminalParams - {_termDisplayedLines = [] - ,_termFutureLines = TerminalLineEffect 0 termsound - : map totermline (topFlushStrings ss ++ ss) - ,_termMaxLines = 7 - ,_termTitle = "TERMINAL" - } - where - totermline s = TerminalLineDisplay 0 (const (s,white)) - termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' - where - tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos +simpleTermMessage = genTermMessage . const +--simpleTermMessage ss = const $ TerminalParams +-- {_termDisplayedLines = [] +-- ,_termFutureLines = TerminalLineEffect 0 termsound +-- : map totermline (topFlushStrings ss ++ ss) +-- ,_termMaxLines = 7 +-- ,_termTitle = "TERMINAL" +-- ,_termSel = Nothing +-- ,_termMaxSel = Nothing +-- } +-- where +-- totermline s = TerminalLineDisplay 0 (const (s,white)) +-- termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' +-- where +-- tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos topFlushStrings :: [String] -> [String] topFlushStrings = topFlush . maximum . map length @@ -110,6 +123,8 @@ genTermMessage f = \gp -> TerminalParams : map totermline (topFlushStrings (f gp) ++ f gp) ,_termMaxLines = 7 ,_termTitle = "TERMINAL" + ,_termSel = Nothing + ,_termOptions = [] } where totermline s = TerminalLineDisplay 0 (const (s,white)) diff --git a/src/Dodge/PlacementSpot.hs b/src/Dodge/PlacementSpot.hs index 6266deb12..15d2c3e18 100644 --- a/src/Dodge/PlacementSpot.hs +++ b/src/Dodge/PlacementSpot.hs @@ -21,6 +21,7 @@ module Dodge.PlacementSpot , twoRoomPoss , isUnusedLnkType , rprBoolShift + , rprShift , rprBool , shiftInBy , resetPLUse @@ -71,6 +72,15 @@ resetPLUse (PSPos f g fallback) = PSPos f' g fallback f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement" +rprShift + :: (RoomPos -> Room -> Maybe (Point2,Float)) + -> PlacementSpot +rprShift t = PSPos f (const id) Nothing + where + f rp r = case t rp r of + Just (p,a) -> Just (PS p a, rp & rpPlacementUse +~ 1) + Nothing -> Nothing + rprBoolShift :: (RoomPos -> Room -> Bool) -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 30018919e..0d009553a 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -84,9 +84,13 @@ subInventoryDisplay subinv cfig w = case subinv of DisplayTerminal {_termParams = tp} -> pictures [ invHead cfig (_termTitle tp) , renderListAt subInvX 60 cfig + . (++ (map (\(str,_) -> (str,white)) (_termOptions tp))) . reverse . take (_termMaxLines tp) $ _termDisplayedLines tp <&> ($ w) + , fromMaybe mempty $ do + cursori <- _termSel tp <&> (+ _termMaxLines tp) + return $ listCursorNSW subInvX 60 cfig cursori white 15 1 ] CombineInventory mi -> pictures [ invHead cfig "COMBINE" diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 0c417d19f..451f71539 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -34,6 +34,7 @@ triggerDoorRoom inplid = defaultRoom , _rmLinks = init lnks++ [last lnks] , _rmPath = [(V2 20 35,V2 20 5)] , _rmInPmnt = [InPlacement f inplid] + , _rmName = "triggerDoorRoom" -- door extends into side walls (for shadows as rendered 12/03/21) -- note no bounds } diff --git a/src/Dodge/Room/SensorDoor.hs b/src/Dodge/Room/SensorDoor.hs index ec6052134..222a780ba 100644 --- a/src/Dodge/Room/SensorDoor.hs +++ b/src/Dodge/Room/SensorDoor.hs @@ -47,7 +47,6 @@ sensorRoomRunPast dt n = do t <- sensorRoom dt n return (applyToSubforest [0] (++ [treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink - & rmName .~ "test" ] (UseLabel 0 corridor)] ) t ,TreeSubLabelling "sensorRoomRunPast" Nothing) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs new file mode 100644 index 000000000..dac6989d9 --- /dev/null +++ b/src/Dodge/Room/Warning.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE TupleSections #-} +module Dodge.Room.Warning where +import Dodge.LevelGen.Data +import Dodge.PlacementSpot +import Dodge.Placement.Instance.Terminal +import Dodge.Data +import Dodge.Tree +--import Dodge.RoomLink +import Dodge.Room.Door +import Dodge.Room.Ngon +import Dodge.Room.Procedural +--import Dodge.Room.Corridor +import Dodge.Room.Link +--import Dodge.Room.Procedural +--import Dodge.Room.Foreground +--import Dodge.Room.RoadBlock +import Dodge.Placement.Instance +--import Dodge.Default.Room +--import Dodge.Item.Weapon.BulletGuns +--import Dodge.Item.Weapon.Utility +--import Dodge.LevelGen.Data +--import Geometry.Data +import Geometry +--import Padding +--import Color +--import Shape +--import Lorem +import LensHelp +import Dodge.RandomHelp + +--import qualified Data.Set as S +import Data.Maybe +--import Data.Char +--import Data.Tree +import Control.Monad.State +import System.Random + + +warningRooms :: RandomGen g => Int -> State g (LabSubCompTree Room) +warningRooms n = do + rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200] + cenroom <- shuffleLinks $ addWarningTerminal n rm + let doorroom = triggerDoorRoom n + return ( treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door) + , TreeSubLabelling "warningRooms" Nothing) + +addWarningTerminal :: Int -> Room -> Room +addWarningTerminal outplid = (rmName .++~ "warningTerm-") + -- & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid] + . (rmOutPmnt .~ [OutPlacement outplace outplid]) + where + outplace = extTrigLitPos + (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) + (\trid -> Just $ set plSpot (rprShift fps) $ putTerminal $ termMessages trid) + --termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)) + fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of + Just 0 -> + let rppos = _rpPos rp + rpdir = _rpDir rp + inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5)) + rtpos = inpos +.+ rotateV rpdir (V2 30 0) + ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0) + in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm) + -- the above test may not work properly if the room polys are + -- complicated, it should really use created walls... + then Just (rtpos, rpdir) + else Just (ltpos, rpdir) + _ -> Nothing + termMessages trid = (genTermMessage $ const ["A","TEST"]) + <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)]) + ops trid = [ ("OPEN", triggers . ix (fromJust $ _plMID trid) .~ const True) + , ("LEAVE", id) + ] + diff --git a/src/Geometry/Polygon.hs b/src/Geometry/Polygon.hs index bd663ef3a..e255448f0 100644 --- a/src/Geometry/Polygon.hs +++ b/src/Geometry/Polygon.hs @@ -8,16 +8,16 @@ import Data.Maybe import Data.List import qualified Control.Foldl as L --- | Draw a clockwise rectangle based on maximal N E S W values. +-- | Draw an anticlockwise rectangle based on maximal N E S W values. rectNESW :: Float -> Float -> Float -> Float -> [Point2] rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a] -- | Draw a clockwise rectangle based on maximal N S E W values. rectNSEW :: Float -> Float -> Float -> Float -> [Point2] rectNSEW !n !s !e !w = rectNESW n e s w --- | Draw a clockwise rectangle based on maximal N S W E values. +-- | Draw an anticlockwise rectangle based on maximal N S W E values. rectNSWE :: Float -> Float -> Float -> Float -> [Point2] rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n] --- | Draw a clockwise rectangle around the origin with given height and width +-- | Draw an anticlockwise rectangle around the origin with given height and width rectWH :: Float -> Float -> [Point2] rectWH w h = rectNSWE h (-h) (-w) w