Creature springs checks for heights

src/Dodge/TestString.hs

@@ -1,50 +1,58 @@
 {-# OPTIONS_GHC -Wno-unused-imports #-}
+
 module Dodge.TestString where
 
-import Dodge.Creature.Picture
-import Dodge.WallCreatureCollisions
-import Data.List ((\\))
-import ShortShow
-import Geometry
-import qualified SDL
-import Linear
-import Dodge.ListDisplayParams
-import Dodge.SelectionSections
-import qualified Control.Foldl as L
-import Dodge.DoubleTree
-import Dodge.Data.DoubleTree
-import Dodge.Item.Grammar
-import Dodge.Item.Display
 import AesonHelp
-import Dodge.SmoothScroll
-import HelpNum
-import Dodge.Base.Coordinate
-import Geometry.Vector
-import Data.Maybe
-import Dodge.Render.Lights
-import Data.Aeson (ToJSON)
-import Data.ByteString.Lazy.Char8 (unpack)
-import qualified Data.Aeson.Encode.Pretty as AEP
+import qualified Control.Foldl as L
 import Control.Lens
-import Dodge.Data.Universe
-import qualified IntMapHelp as IM
-import qualified Data.Map.Strict as M
-import NewInt
+import Data.Aeson (ToJSON)
+import qualified Data.Aeson.Encode.Pretty as AEP
+import Data.ByteString.Lazy.Char8 (unpack)
 import Data.Foldable
+import Data.List ((\\))
+import qualified Data.Map.Strict as M
+import Data.Maybe
 import Data.Monoid
+import Dodge.Base.Coordinate
+import Dodge.Creature.Picture
+import Dodge.Data.DoubleTree
+import Dodge.Data.Universe
+import Dodge.DoubleTree
+import Dodge.Item.Display
+import Dodge.Item.Grammar
+import Dodge.ListDisplayParams
+import Dodge.Render.Lights
+import Dodge.SelectionSections
+import Dodge.SmoothScroll
+import Dodge.WallCreatureCollisions
+import Geometry
+import Geometry.Vector
+import HelpNum
+import qualified IntMapHelp as IM
+import Linear
+import NewInt
 import RandomHelp
+import qualified SDL
+import ShortShow
+
+tocrs ::
+    ( IM.IntMap Creature ->
+      Const (Endo [String]) (IM.IntMap Creature)
+    ) ->
+    Universe ->
+    Const (Endo [String]) Universe
+tocrs = uvWorld . cWorld . lWorld . creatures
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $ op' - oop, show d]
-    <> u ^.. tocr . crStance . carriage . to show
-    <> u ^.. tocr . crMvDir  . to show
-  where
-    tocr = uvWorld . cWorld . lWorld . creatures . ix 0
-    f = fromMaybe 0
-    p = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
-    op' = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos
-    oop = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos
-    d = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crDir
+testStringInit u = u ^.. tocrs . each . crStance . carriage . to show
+
+--  where
+--    tocr = uvWorld . cWorld . lWorld . creatures . ix 0
+--    f = fromMaybe 0
+--    p = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crPos
+--    op' = f $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldPos
+--    oop = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crOldOldPos
+--    d = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crDir
 --    u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apStrategy . to show
 --    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crActionPlan . apAction . to show
 --    <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crPerception . cpAttention . to show
@@ -58,7 +66,7 @@ testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $
 -- a    <> fromMaybe [] (do
 -- a    w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18
 -- a    w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61
--- a    let 
+-- a    let
 -- a        f = uncurry (-) . (^. wlLine)
 -- a        g = argV . f
 -- a        h = normalizeV . uncurry (-) . (^. wlLine)
@@ -72,29 +80,37 @@ testStringInit u = [show p, show op', show oop, show (op' - oop), show . norm $
 -- a        ]
 -- a    )
 --    <> (fmap show $ u ^.. uvWorld . cWorld . lWorld . machines . each . mcMaterial)
---testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
---testStringInit u =  map show
+-- testStringInit u = map show (u ^.. uvWorld . cWorld . lWorld . machines . traverse . mcDir)
+-- testStringInit u =  map show
 --    (u ^.. uvWorld . cWorld . lWorld . machines . traverse .mcType . _McDistributer)
 --    <>
 --    map f (u ^.. uvWorld . cWorld . lWorld . machines . traverse)
 --  where
 --    f mc = show (mc ^. mcID) <> shortShow (mc ^. mcType)
---    [show $ foldMap (foldMap (Sum . length . (^. seObstacles))) 
+--    [show $ foldMap (foldMap (Sum . length . (^. seObstacles)))
 --    $ u ^. uvWorld . cWorld . incGraph]
-    -- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor
---testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines
+-- foldMap prettyShort $ u ^? uvWorld . cWorld . lWorld . machines . ix 0 . mcType . _McProxSensor
+-- testStringInit u = foldMap prettyShort $ u ^.. uvWorld . cWorld . lWorld . machines
 
 --    showh _ = ""
 --    shortShow
 
 topTestPart :: Universe -> [String]
-topTestPart u = [maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
+topTestPart u =
+    [ maybe "" showManObj $ u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crManipulation . manObject
     ]
 
 showManObj :: ManipulatedObject -> String
 showManObj SortInventory = "SortInventory"
-showManObj (SelectedItem x y as z) = "SelItem: "++ show x++ " Root: "++show y++" Attached: "++show z
-    ++ " AimStance: " ++ show as
+showManObj (SelectedItem x y as z) =
+    "SelItem: "
+        ++ show x
+        ++ " Root: "
+        ++ show y
+        ++ " Attached: "
+        ++ show z
+        ++ " AimStance: "
+        ++ show as
 showManObj SelNothing = "SelNothing"
 showManObj SortCloseItem = "SortCloseItem"
 showManObj (SelCloseItem x) = "CloseItem " ++ show x
@@ -103,10 +119,10 @@ showManObj (SelCloseButton x) = "CloseButton " ++ show x
 
 showTimeFlow :: TimeFlowStatus -> String
 showTimeFlow tfs = case tfs of
-    RespawnDelay i -> "Respawndelay"++show i
+    RespawnDelay i -> "Respawndelay" ++ show i
     NormalTimeFlow -> "NormalTimeFlow"
-    ItemScrollTimeFlow {_reverseAmount = ra } -> "ItemScrollTimeFlow" ++ show ra
-    CameraScrollTimeFlow {_reverseAmount = ra } -> "CameraScrollTimeFlow" ++ show ra
-    RewindLeftClick {_reverseAmount = ra } -> "RewindLeftClick" ++ show ra
-    PausedTimeFlow {_timeFlowCharge = ra } -> "PausedTimeFlow" ++ show ra
-    PauseTimeMessage {} -> "PausedTimeMessage"
+    ItemScrollTimeFlow{_reverseAmount = ra} -> "ItemScrollTimeFlow" ++ show ra
+    CameraScrollTimeFlow{_reverseAmount = ra} -> "CameraScrollTimeFlow" ++ show ra
+    RewindLeftClick{_reverseAmount = ra} -> "RewindLeftClick" ++ show ra
+    PausedTimeFlow{_timeFlowCharge = ra} -> "PausedTimeFlow" ++ show ra
+    PauseTimeMessage{} -> "PausedTimeMessage"