Add analysing machine

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
+    | isNothing (readMaybe n :: Maybe Int) = id
-    | otherwise = (uvWorld . creatures . ix 0 . crInvCapacity .~ read n)
+    | 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 
-        _ -> if length command_options == 1 then ">" ++ key ++ " " ++ head command_options ++ " " else if null command_options then s else ">" ++ key ++ " " ++ longestCommonPrefix command_options
+            then ">" ++ head command_options ++ " " 
-
+            else ">" ++ 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 ">" ++ 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'

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]

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
 

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

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

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
+    return $ take n $ zip (xs ++ xs) (ys ++ ys)
-        (take n $ xs ++ xs)
-        (take n $ ys ++ ys)
 
 intsToPos :: Room -> (Int,Int) -> Point2
 intsToPos rm (x,y) = V2

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