141 lines
5.7 KiB
Haskell
141 lines
5.7 KiB
Haskell
{-# OPTIONS_GHC -Wno-unused-imports #-}
|
|
|
|
module Dodge.TestString where
|
|
|
|
import Dodge.Creature.Radius
|
|
import AesonHelp
|
|
import qualified Control.Foldl as L
|
|
import Control.Lens
|
|
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
|
|
import qualified Data.IntSet as IS
|
|
|
|
tocrs :: (IM.IntMap Creature
|
|
-> Const (Endo [String]) (IM.IntMap Creature))
|
|
-> Universe -> Const (Endo [String]) Universe
|
|
tocrs = uvWorld . cWorld . lWorld . creatures
|
|
|
|
isBee :: Creature -> Bool
|
|
isBee cr = case cr ^. crType of
|
|
BeeCrit{} -> True
|
|
_ -> False
|
|
|
|
testStringInit :: Universe -> [String]
|
|
testStringInit u = u ^.. tocrs . each . filtered isBee . crActionPlan . apStrategy . to show
|
|
-- u ^.. tocrs . ix 1 . crPos . _xy . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . slimeCompression . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . slimeCompression . to norm . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . to crRad . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . slimeRad . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . slimeRadWobble . to show
|
|
-- <> u ^.. tocrs . ix 1 . crType . slimeIsCompressing . to show
|
|
-- <> u ^.. tocrs . ix 1 . crDir . to show
|
|
-- <> u ^.. tocrs . ix 1 . crDamage . 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
|
|
-- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crPerception . cpAwareness . to show
|
|
-- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . targetCr . to show
|
|
-- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . mvToPoint . to show
|
|
-- <> u ^.. uvWorld . cWorld . lWorld . creatures . ix 1 . crIntention . viewPoint . to show
|
|
-- fmap show (u ^.. uvWorld . cWorld . lWorld . creatures . ix 0 . crWallTouch . each)
|
|
-- (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crStance . carriage)
|
|
-- (fmap show $ u ^.. uvWorld . cWorld . lWorld . creatures . each . crStance . carriage . strideAmount)
|
|
-- a <> fromMaybe [] (do
|
|
-- a w1 <- u ^? uvWorld . cWorld . lWorld . walls . ix 18
|
|
-- a w2 <- u ^? uvWorld . cWorld . lWorld . walls . ix 61
|
|
-- a let
|
|
-- a f = uncurry (-) . (^. wlLine)
|
|
-- a g = argV . f
|
|
-- a h = normalizeV . uncurry (-) . (^. wlLine)
|
|
-- a a = angleVV (f w1) (f w2)
|
|
-- a return [show $ wlWlCrush w1 w2, show a , show (f w1), show (f w2)
|
|
-- a , show $ g w1
|
|
-- a , show $ g w2
|
|
-- a , show $ h w1
|
|
-- a , show $ h w2
|
|
-- a , show (norm (h w1 + h w2))
|
|
-- 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
|
|
-- (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)))
|
|
-- $ u ^. uvWorld . cWorld . incGraph]
|
|
-- 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
|
|
]
|
|
|
|
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 SelNothing = "SelNothing"
|
|
showManObj SortCloseItem = "SortCloseItem"
|
|
showManObj (SelCloseItem x) = "CloseItem " ++ show x
|
|
showManObj SortCloseButton = "SortCloseButton"
|
|
showManObj (SelCloseButton x) = "CloseButton " ++ show x
|
|
|
|
showTimeFlow :: TimeFlowStatus -> String
|
|
showTimeFlow tfs = case tfs of
|
|
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"
|