From 9c460277114cb0181485b487ea5dffb816755550 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 21 Mar 2022 19:20:58 +0000 Subject: [PATCH] Attach terminal to analyser (these should rather be combined) --- src/Dodge/Data.hs | 5 +- src/Dodge/Floor.hs | 2 +- src/Dodge/Inventory.hs | 4 +- src/Dodge/Placement/Instance/Analyser.hs | 61 ++++++++++++++++-------- src/Dodge/Placement/Instance/Terminal.hs | 15 ++++-- src/Dodge/Placement/Shift.hs | 6 ++- src/Dodge/Render/HUD.hs | 5 +- src/Dodge/Room/Corridor.hs | 2 +- src/Dodge/Room/LasTurret.hs | 24 ++++++++-- src/Dodge/Room/Pillar.hs | 6 +-- src/Dodge/Room/Room.hs | 9 ++-- 11 files changed, 92 insertions(+), 47 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index f5e8b04cf..da5ef14cd 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -326,15 +326,14 @@ data Button = Button , _btTerminalParams :: TerminalParams } data TerminalParams = NoTerminalParams | TerminalParams - { _termDisplayedLines :: [(String,Color)] + { _termDisplayedLines :: [World -> (String,Color)] , _termFutureLines :: [TerminalLine] , _termMaxLines :: Int } data TerminalLine = TerminalLineDisplay {_tlPause :: Int - ,_tlString :: String - ,_tlColor :: Color + ,_tlString :: World -> (String, Color) } | TerminalLineEffect {_tlPause :: Int diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index 625895b93..c6504e736 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -37,7 +37,7 @@ initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithDoors $ treeFromTrunk [[AnoApplyInt 0 startRoom] , [AnoApplyInt 100 healthTest] - , [SpecificRoom $ (return . UseAll) <$> tanksRoom [] []] + , [SpecificRoom $ return . UseAll <$> tanksRoom [] []] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 2e1d55e26..eb265cac8 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -136,9 +136,9 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams . Nothing -> w Just tl | _tlPause tl > 0 -> w & hud . hudElement . subInventory . termParams . termFutureLines . ix 0 . tlPause -~ 1 - Just (TerminalLineDisplay _ s c) -> w + Just (TerminalLineDisplay _ f) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail - & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ (s,c) + & hud . hudElement . subInventory . termParams . termDisplayedLines .:~ f Just (TerminalLineEffect _ eff) -> w & hud . hudElement . subInventory . termParams . termFutureLines %~ tail & eff (_subInventory . _hudElement $ _hud w) diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index 111886135..3fd0929b1 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -1,20 +1,21 @@ module Dodge.Placement.Instance.Analyser where import Dodge.LevelGen.Data -import Dodge.PlacementSpot +--import Dodge.PlacementSpot import Dodge.Data import Dodge.Base.You import Dodge.Default -import Dodge.Tree -import Dodge.RoomLink -import Dodge.Room.Door -import Dodge.Room.Corridor -import Dodge.Room.Link -import Dodge.Room.Ngon +--import Dodge.Tree +--import Dodge.RoomLink +--import Dodge.Room.Door +--import Dodge.Room.Corridor +--import Dodge.Room.Link +--import Dodge.Room.Ngon --import Dodge.Room.Procedural -import Dodge.Room.Foreground +--import Dodge.Room.Foreground --import Dodge.Room.RoadBlock import Dodge.Placement.Instance -import Dodge.Default.Room +import Dodge.Placement.Shift +--import Dodge.Default.Room --import Dodge.Item.Weapon.BulletGuns --import Dodge.Item.Weapon.Utility --import Dodge.LevelGen.Data @@ -25,25 +26,45 @@ import Color import Shape import ShapePicture import LensHelp -import Dodge.RandomHelp +--import Dodge.RandomHelp -import qualified Data.Set as S +--import qualified Data.Set as S import Data.Maybe -import Data.Tree -import Control.Monad.State -import System.Random +--import Data.Tree +--import Control.Monad.State +--import System.Random -analyser :: PlacementSpot - -> PlacementSpot +analyser + :: [String] -- | initial text + -> String -- | succeed text + -> String -- | fail text + -> [String] -- | after text -> (Machine -> World -> World) + -> PlacementSpot + -> PlacementSpot -> Placement -analyser pslight psmc upf = extTrigLitPos pslight $ \tp -> - Just $ spNoID psmc - $ PutMachine aquamarine (reverse $ square 10) defaultMachine - { _mcDraw = const $ noPic $ colorSH aquamarine (upperPrismPoly 25 (square 10)) +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 (_mcSensorToggle mc)) . upf mc } + ) $ \anmc -> Just + $ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc) + $ putTerminal $ const $ TerminalParams + { _termDisplayedLines = [] + , _termFutureLines = map simpleline starts + ++ [testline' (fromJust $ _plMID anmc)] + ++ map simpleline afters + , _termMaxLines = 7 + } + where + simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)} + testline' mcid = TerminalLineDisplay 0 (testline mcid) + testline mcid w = case w ^? machines . ix mcid . mcSensorToggle of + Just True -> (sucs,green) + _ -> (fails,red) testYourHealth :: Int -> Machine -> World -> World testYourHealth hp mc w diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index fdf7223d8..347c4f150 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -15,6 +15,7 @@ import Geometry import ShapePicture import LensHelp import Shape +import Sound.Data import Data.Maybe @@ -65,7 +66,7 @@ simpleTermMessage ss = const $ TerminalParams } where topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] - totermline s = TerminalLineDisplay 0 s white + 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 @@ -73,13 +74,17 @@ simpleTermMessage ss = const $ TerminalParams genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams) genTermMessage f = \gp -> TerminalParams {_termDisplayedLines = [] - ,_termFutureLines = TerminalLineEffect 0 termsound + ,_termFutureLines = termSoundLine computerBeepingS : map totermline (topflush (f gp) ++ f gp) ,_termMaxLines = 7 } where topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]] - totermline s = TerminalLineDisplay 0 s white - termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w' + totermline s = TerminalLineDisplay 0 (const (s,white)) + +termSoundLine :: SoundID -> TerminalLine +termSoundLine sid = TerminalLineEffect 0 termsound + where + termsound subinv w = soundStart TerminalSound tpos sid Nothing w where - tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos + tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos diff --git a/src/Dodge/Placement/Shift.hs b/src/Dodge/Placement/Shift.hs index 098884bf8..17bc9f629 100644 --- a/src/Dodge/Placement/Shift.hs +++ b/src/Dodge/Placement/Shift.hs @@ -1,15 +1,19 @@ module Dodge.Placement.Shift ( shiftPlacement , shiftPSBy + , shiftRelativeToPS ) where import Dodge.LevelGen.Data import Dodge.ShiftPoint +import LensHelp + import Geometry -import Control.Lens shiftPSBy :: (Point2,Float) -> PlacementSpot -> PlacementSpot shiftPSBy (pos,rot) ps = ps & psPos %~ shiftPointBy (pos,rot) & psRot +~ rot +shiftRelativeToPS :: Point2 -> PlacementSpot -> PlacementSpot +shiftRelativeToPS p ps = ps & psPos .+.+~ rotateV (_psRot ps) p shiftPlacement :: (Point2,Float) -> Placement -> Placement shiftPlacement shift plmnt = case plmnt of -- slightly messy NoShiftCont, necessary to stop interference with ps0jPushPS diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 33a05861c..9f2972ef9 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -84,7 +84,10 @@ subInventoryDisplay subinv cfig w = case subinv of ] DisplayTerminal {_termParams = tp} -> pictures [ invHead cfig "TERMINAL" - , renderListAt subInvX 60 cfig . reverse $ take (_termMaxLines tp) (_termDisplayedLines tp) + , renderListAt subInvX 60 cfig + . reverse + . take (_termMaxLines tp) + $ _termDisplayedLines tp <&> ($ w) ] CombineInventory mi -> pictures [ invHead cfig "COMBINE" diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 6d3ee49f6..a37fc8a2e 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -21,7 +21,7 @@ corridor = defaultRoom , _rmLinks = lnks' , _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks , _rmPmnts = [ spanLightI (V2 0 39.5) (V2 40 39.5) ] - , _rmBound = [ rectNSWE 50 30 0 40 ] + , _rmBound = [ rectNSWE 50 30 (-5) 45 ] , _rmFloor = Tiled [makeTileFromPoly poly 2] , _rmRandPSs = [psRandRanges (10,30) (30,60) (0,2*pi)] , _rmName = "Corridor" diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index 04fe2ae48..b926d2fd2 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -14,7 +14,7 @@ import Dodge.Room.Foreground import Dodge.Placement.Instance import Dodge.Placement.Instance.Analyser import Dodge.Default.Room ---import Dodge.Item.Weapon.BulletGuns +import Dodge.Item.Consumable --import Dodge.Item.Weapon.Utility --import Dodge.LevelGen.Data --import Geometry.Data @@ -71,7 +71,19 @@ lightSensByDoor outplid rm = rm sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) healthAnalyserByDoor :: Int -> Room -> Room -healthAnalyserByDoor outplid rm = rm +healthAnalyserByDoor = analyserByDoor + [ replicate 20 '-' + , "HEALTH INTEGRITY CHECK" + , replicate 20 '-' + ] + "PASSED" + "REQUIRES HEALTH AT LEAST 1100" + (replicate 3 "") + (testYourHealth 1100) + +analyserByDoor :: [String] -> String -> String -> [String] + -> (Machine -> World -> World) -> Int -> Room -> Room +analyserByDoor sa sb sc sd mcf outplid rm = rm & rmPmnts .++~ [ psPt atFstLnkOut $ PutShape $ colorSH yellow $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80) @@ -80,10 +92,10 @@ healthAnalyserByDoor outplid rm = rm ] & rmOutPmnt .~ [OutPlacement - (analyser + (analyser sa sb sc sd + mcf (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) (atFstLnkOutShiftBy sensorshift) - (testYourHealth 1100) ) outplid] where @@ -94,7 +106,9 @@ healthTest :: RandomGen g => Int -> State g (SubCompTree Room) healthTest n = do cenroom <- shuffleLinks $ healthAnalyserByDoor n $ roomNgon 8 200 let doorroom = triggerDoorRoom n - return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door) + return $ treeFromPost [PassDown door + ,PassDown $ corridor & rmPmnts .:~ spNoID (PS 20 0) (PutFlIt (medkit 100)) + ,PassDown cenroom,PassDown doorroom] (UseAll door) lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room) lasSensorTurretTest n = do diff --git a/src/Dodge/Room/Pillar.hs b/src/Dodge/Room/Pillar.hs index 640c0532b..136b71f6e 100644 --- a/src/Dodge/Room/Pillar.hs +++ b/src/Dodge/Room/Pillar.hs @@ -48,9 +48,9 @@ roomPillars pillarsize w h wn hn = do -- : sps (PS (V2 220 (h-20)) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90)) -- : sps (PS (V2 120 20) 0) (PutLS $ lsColPos 0.75 (V3 0 0 90)) replicate npillars (blockPillar (0.5*pilw) (0.5*pilh) & plSpot .~ rprBool - (\rp _ -> and [RoomPosOffPath `S.member` _rpType rp - , _rpPlacementUse rp == 0 - , _rpLinkStatus rp == NotLink ] ) + (\rp _ -> RoomPosOffPath `S.member` _rpType rp + && _rpPlacementUse rp == 0 + && _rpLinkStatus rp == NotLink ) ) addGirderLights $ rm & rmPmnts .~ plmnts diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 48dff94cf..7c57ad6f4 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -254,11 +254,10 @@ weaponBetweenPillars = do , any ((<100) . dist (_rpPos rp)) (usedRoomInLinkPoss r) ] ncrits <- state $ randomR (1,3) - critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> and - [ RoomPosOnPath `S.member` _rpType rp - , _rpPlacementUse rp == 0 - , all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r) - ] + critPlacementSpots <- replicateM ncrits $ randDirPS $ rprBool $ \rp r -> + RoomPosOnPath `S.member` _rpType rp + && _rpPlacementUse rp == 0 + && all ((>100) . dist (_rpPos rp)) (usedRoomLinkPoss r) theRoom <- roomPillars 30 w h wn hn <&> rmPmnts .++~ sps wpPos (RandPS randFirstWeapon) : map (`sps` randC1) critPlacementSpots return $ singleUseAll theRoom