From 51cc04799d79b9710d4070e3a670bd6a444b9495 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 21 Mar 2022 09:14:32 +0000 Subject: [PATCH] Add analysing machine --- src/Dodge/Debug/Terminal.hs | 25 +++++++---- src/Dodge/Floor.hs | 3 +- src/Dodge/LevelGen.hs | 2 +- src/Dodge/Placement/Instance/Analyser.hs | 54 ++++++++++++++++++++++++ src/Dodge/Room/LasTurret.hs | 27 ++++++++++++ src/Dodge/Room/Modify/Girder.hs | 4 +- src/Dodge/Tree/Shift.hs | 2 +- 7 files changed, 102 insertions(+), 15 deletions(-) create mode 100644 src/Dodge/Placement/Instance/Analyser.hs diff --git a/src/Dodge/Debug/Terminal.hs b/src/Dodge/Debug/Terminal.hs index c7d18cf33..ebff2c8bd 100644 --- a/src/Dodge/Debug/Terminal.hs +++ b/src/Dodge/Debug/Terminal.hs @@ -10,7 +10,7 @@ import Control.Monad import Control.Lens import Text.Read (readMaybe) import Data.List --(isPrefixOf, isInfixOf, intercalate) -import Data.Maybe (fromJust) +import Data.Maybe import LensHelp --import qualified Debug.Trace --import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram) @@ -28,11 +28,11 @@ applyTerminalString "LOADTEST" = (uvWorld . creatures . ix 0 . crInv .~ testInve applyTerminalString "LM" = applyTerminalString "LOADME" applyTerminalString "LT" = applyTerminalString "LOADTEST" applyTerminalString ('s': 'e': 't': '_': 'h': 'p': ' ': hp) - | (readMaybe hp :: Maybe Int) == Nothing = id + | isNothing (readMaybe hp :: Maybe Int) = id | otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp applyTerminalString ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n) - | (readMaybe n :: Maybe Int) == Nothing = id - | otherwise = (uvWorld . creatures . ix 0 . crInvCapacity .~ read n) + | isNothing (readMaybe n :: Maybe Int) = id + | otherwise = uvWorld . creatures . ix 0 . crInvCapacity .~ read n applyTerminalString ('s': 'e': 't': ' ': var) | var /= [] = applySetTerminalString var | otherwise = id @@ -61,7 +61,7 @@ applySetTerminalString var = case key' of where (key, val) = getSplitString var val' = readMaybe val :: Maybe Float - key' = if val' == Nothing then "" else key + key' = if isNothing val' then "" else key autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe) autoCompleteTerminal s _ = return . @@ -73,10 +73,17 @@ autoCompleteTerminal s _ = return . _ -> filter (isInfixOf val) (validTerminalCommands key) -- basic autocomplete if single option available (or as far as possible) input_str = case (key, val) of - (_, "") -> if length command_options == 1 then ">" ++ head command_options ++ " " else ">" ++ longestCommonPrefix command_options - _ -> if length command_options == 1 then ">" ++ key ++ " " ++ head command_options ++ " " else if null command_options then s else ">" ++ key ++ " " ++ longestCommonPrefix command_options - - command_options' = if length command_options > 0 && head command_options == key then validTerminalCommands key else command_options + (_, "") -> if length command_options == 1 + then ">" ++ head command_options ++ " " + else ">" ++ longestCommonPrefix command_options + _ -> if length command_options == 1 + then ">" ++ key ++ " " ++ head command_options ++ " " + else if null command_options + then s + else ">" ++ key ++ " " ++ longestCommonPrefix command_options + command_options' = if not (null command_options) && head command_options == key + then validTerminalCommands key + else command_options --val' = Debug.Trace.trace key tail val valid_commands = "Options: " ++ intercalate ", " command_options' diff --git a/src/Dodge/Floor.hs b/src/Dodge/Floor.hs index abfd17747..625895b93 100644 --- a/src/Dodge/Floor.hs +++ b/src/Dodge/Floor.hs @@ -36,7 +36,8 @@ import System.Random initialAnoTree :: RandomGen g => Tree [Annotation g] initialAnoTree = padSucWithDoors $ treeFromTrunk [[AnoApplyInt 0 startRoom] - , [SpecificRoom $ fmap (return . UseAll) $ tanksRoom [] []] + , [AnoApplyInt 100 healthTest] + , [SpecificRoom $ (return . UseAll) <$> tanksRoom [] []] , [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms] , [SpecificRoom randomChallenges] , [AnoApplyInt 1 lasSensorTurretTest] diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index ceee9a2d3..d98ed887b 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -21,7 +21,7 @@ import qualified Data.IntMap.Strict as IM generateWorldFromSeed :: Int -> IO World generateWorldFromSeed i = do (roomList,bounds) <- layoutLevelFromSeed 0 i - return $ saveLevelStartSlot $ (_gWorld $ generateLevelFromRoomList roomList + return $ saveLevelStartSlot $ _gWorld (generateLevelFromRoomList roomList initialWorld{_randGen=mkStdGen i}) & roomClipping .~ bounds diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs new file mode 100644 index 000000000..111886135 --- /dev/null +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -0,0 +1,54 @@ +module Dodge.Placement.Instance.Analyser where +import Dodge.LevelGen.Data +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.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 ShapePicture +import LensHelp +import Dodge.RandomHelp + +import qualified Data.Set as S +import Data.Maybe +import Data.Tree +import Control.Monad.State +import System.Random + +analyser :: PlacementSpot + -> PlacementSpot + -> (Machine -> World -> World) + -> 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)) + , _mcUpdate = \mc -> (triggers . ix (fromJust $ _plMID tp) .~ const (_mcSensorToggle mc)) + . upf mc + } + +testYourHealth :: Int -> Machine -> World -> World +testYourHealth hp mc w + | _crHP ycr >= hp && dist (_crPos ycr) (_mcPos mc) < 40 + = w & machines . ix (_mcID mc) . mcSensorToggle .~ True + | otherwise = w + where + ycr = you w diff --git a/src/Dodge/Room/LasTurret.hs b/src/Dodge/Room/LasTurret.hs index f7979747c..04fe2ae48 100644 --- a/src/Dodge/Room/LasTurret.hs +++ b/src/Dodge/Room/LasTurret.hs @@ -12,6 +12,7 @@ import Dodge.Room.Ngon import Dodge.Room.Foreground --import Dodge.Room.RoadBlock import Dodge.Placement.Instance +import Dodge.Placement.Instance.Analyser import Dodge.Default.Room --import Dodge.Item.Weapon.BulletGuns --import Dodge.Item.Weapon.Utility @@ -69,6 +70,32 @@ lightSensByDoor outplid rm = rm covershape = rectNSEW 10 (-10) 20 (-20) sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) +healthAnalyserByDoor :: Int -> Room -> Room +healthAnalyserByDoor outplid rm = rm + & rmPmnts .++~ + [ psPt atFstLnkOut $ PutShape $ colorSH yellow + $ barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80) + , heightWallPS (atNthLnkOutShiftInward 1 100) 30 covershape + , heightWallPS (atFstLnkOutShiftInward 100) 30 covershape + ] + & rmOutPmnt .~ + [OutPlacement + (analyser + (atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))) + (atFstLnkOutShiftBy sensorshift) + (testYourHealth 1100) + ) + outplid] + where + covershape = rectNSEW 10 (-10) 20 (-20) + sensorshift (p,a) = (p +.+ rotateV a (V2 60 (-20)), a) + +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) + lasSensorTurretTest :: RandomGen g => Int -> State g (SubCompTree Room) lasSensorTurretTest n = do cenroom <- shuffleLinks $ lightSensInsideDoor n cenLasTur diff --git a/src/Dodge/Room/Modify/Girder.hs b/src/Dodge/Room/Modify/Girder.hs index c1a98da31..d611df854 100644 --- a/src/Dodge/Room/Modify/Girder.hs +++ b/src/Dodge/Room/Modify/Girder.hs @@ -81,9 +81,7 @@ randomLightPositions rm = do xs <- shuffle [0.._numLinkEW rmtype] ys <- shuffle [0.._numLinkNS rmtype] let n = max (length xs) (length ys) - return $ zip - (take n $ xs ++ xs) - (take n $ ys ++ ys) + return $ take n $ zip (xs ++ xs) (ys ++ ys) intsToPos :: Room -> (Int,Int) -> Point2 intsToPos rm (x,y) = V2 diff --git a/src/Dodge/Tree/Shift.hs b/src/Dodge/Tree/Shift.hs index c2327924b..cabc611d6 100644 --- a/src/Dodge/Tree/Shift.hs +++ b/src/Dodge/Tree/Shift.hs @@ -35,7 +35,7 @@ makeLenses ''PosRooms positionRoomsFromTree :: Tree RoomInt -> IO (Maybe PosRooms) positionRoomsFromTree (Node (r,i) ts) = printColumnTitles - >> fmap (fmap (prRooms %~ (map $ first createUnusedLinkPos))) + >> fmap (fmap (prRooms %~ map (first createUnusedLinkPos))) (posRms (PosRooms (map pointsToPoly $ _rmBound r') []) (r',i) (zipCount ts) Empty) where r' = r & rmMID ?~ 0