Work on debugging

src/Data/Preload/Render.hs

@@ -35,10 +35,8 @@ data RenderData = RenderData
     , _fboBloom :: (FBO, TO)
     , _fboPos :: (FBO, TO)
     , _fboLighting :: (FBO, TO)
---    , _fboShadow :: (FBO, (TO, TO))
     , _rboBaseBloom :: GLuint -- RenderbufferObject id
     , _matUBO :: GLuint -- BufferObject id
---    , _orthonormalMatUBO :: GLuint -- BufferObject id
     , _lightsUBO :: GLuint -- BufferObject id
     , _vboWindows :: VBO
     , _vboShapes :: VBO

src/Dodge/Creature/Action.hs

@@ -92,8 +92,8 @@ performTurnToA cr p
     dirv = p -.- cpos
     jit = _mvTurnJit $ _crMvType cr
 
-{- | Performing an action means that a creature has some impulses for a frame, and
+{- | Performing an action on a frame creates an OutAction:
- updates or deletes the action itself.
+  adds impulses and updates or deletes the action itself.
 -}
 performAction :: Creature -> World -> Action -> OutAction
 performAction cr w ac = case ac of

src/Dodge/Creature/SetTarget.hs

@@ -3,6 +3,7 @@ module Dodge.Creature.SetTarget where
 
 import Control.Lens
 import Dodge.Data.World
+--import MaybeHelp
 
 -- | Assumes that you are id 0: if creature is cognizant of you, sets you as target
 targetYouWhenCognizant ::
@@ -11,5 +12,5 @@ targetYouWhenCognizant ::
     Creature
 targetYouWhenCognizant w cr = case cr ^? crPerception . cpAwareness . ix 0 of
     --Just (Cognizant _) -> cr & crIntention . targetCr ?~ _creatures (_cWorld w) IM.! 0
-    Just (Cognizant _) -> cr & crIntention . targetCr ?~ (w ^?! cWorld . lWorld . creatures . ix 0)
+    Just (Cognizant _) -> cr & crIntention . targetCr .~ Just (w ^?! cWorld . lWorld . creatures . ix 0)
     _ -> cr & crIntention . targetCr .~ Nothing

src/Dodge/Creature/Test.hs

@@ -24,6 +24,7 @@ module Dodge.Creature.Test (
     crSafeDistFromTarg,
 ) where
 
+--import MaybeHelp
 import Control.Lens
 import Data.List (find)
 import Data.Maybe

src/Dodge/Data/ActionPlan.hs

@@ -16,10 +16,10 @@ import Sound.Data
 data ActionPlan
     = Inanimate
     | ActionPlan
-        { _apImpulse :: [Impulse]
+        { _apImpulse :: [Impulse] -- done per frame
-        , _apAction :: [Action]
+        , _apAction :: [Action] -- updated per frame, likely persist across frames
-        , _apStrategy :: Strategy
+        , _apStrategy :: Strategy -- current strategy
-        , _apGoal :: [Goal]
+        , _apGoal :: [Goal] -- particular ordered goals
         }
     --deriving (Eq, Ord, Show, Read) --Generic, Flat)
     deriving (Eq, Ord, Show) --Generic, Flat)

src/Dodge/Data/Creature.hs

@@ -32,6 +32,7 @@ import Dodge.Data.Item
 import Dodge.Data.Material
 import Geometry.Data
 import qualified IntMapHelp as IM
+--import MaybeHelp
 
 data Creature = Creature
     { _crPos :: Point2

src/Dodge/Data/Input.hs

@@ -25,6 +25,7 @@ data Input = Input
     , _smoothScrollAmount :: Int
     , _clickPos :: M.Map MouseButton Point2 -- updates on initial mouse button press
     , _heldPos :: M.Map MouseButton Point2 -- updates while mouse button is held, lags one frame
+    , _clickWorldPos :: M.Map MouseButton Point2 -- updates on initial mouse button press
     , _textInput :: [Either TermSignal Char]
     , _scrollTestFloat :: Float
     , _scrollTestInt :: Int

src/Dodge/Data/Universe.hs

@@ -45,21 +45,15 @@ data Universe = Universe
 
 data DebugItem = DebugItem
     { _debugPic :: Picture
-    , _debugInfo :: [DebugMessage]
+    , _debugMessage :: [String]
+    , _debugInfo :: DebugInfo
     }
 
-data DebugMessage
+data DebugInfo
-    = DebugSimpleMessage
+    = NoDebugInfo
-        { _debugMessage :: [String]
+    | DebugV3 { _debugV3 :: V3 Float}
-        }
+    | DebugV2 { _debugV2 :: V2 Float}
-    | DebugWorldPosMessage
+    | DebugMInt { _debugMInt :: Maybe Int}
-        { _debugWorldPos :: V3 Float
-        , _debugMessage :: [String]
-        }
-    | DebugScreenPosMessage
-        { _debugScreenPos :: V2 Float
-        , _debugMessage :: [String]
-        }
 
 data SideEffect
     = NewSideEffect

src/Dodge/Debug.hs

@@ -7,7 +7,7 @@ import qualified Data.Set as S
 
 debugEvents :: Universe -> Universe
 debugEvents u = case dbools ^. at Enable_debug of
-    Nothing -> u 
+    Nothing -> u
     Just () -> S.foldr debugEvent u dbools
   where
     dbools = u ^. uvConfig . debug_booleans
@@ -20,5 +20,6 @@ debugEvent db u = case db of
 collisionDebugItem :: Universe -> DebugItem
 collisionDebugItem u = DebugItem
     { _debugPic = drawCollisionTest $ u ^. uvWorld
-    , _debugInfo = []
+    , _debugMessage = ["Collision test:","asdf"]
+    , _debugInfo = NoDebugInfo
     }

src/Dodge/Debug/Picture.hs

@@ -102,8 +102,9 @@ intersectLinefromScreen cfig w a b =
 
 drawCollisionTest :: World -> Picture
 drawCollisionTest w = fromMaybe mempty $ do
-    a <- w ^. input . clickPos . at ButtonLeft
+--    let f = fmap (screenToWorldPos (w ^. wCam))
-    b <- w ^. input . clickPos . at ButtonRight
+    a <- w ^. input . clickWorldPos . at ButtonLeft
+    b <- w ^. input . clickWorldPos . at ButtonRight
     return $
         setLayer DebugLayer (color orange $ line [a, b])
             <> foldMap (drawCross . fst) (crHit a b w)

src/Dodge/Default/Creature.hs

@@ -7,6 +7,7 @@ import Dodge.Data.FloatFunction
 import Geometry.Data
 import qualified IntMapHelp as IM
 import Picture
+--import MaybeHelp
 
 defaultCreature :: Creature
 defaultCreature =

src/Dodge/Default/World.hs

@@ -14,6 +14,7 @@ defaultInput :: Input
 defaultInput =
     Input
         { _clickPos = mempty
+        , _clickWorldPos = mempty
         , _heldPos = mempty
         , _textInput = mempty
         , _pressedKeys = mempty

src/Dodge/Event/Input.hs

@@ -1,5 +1,4 @@
 {- | Capture input events, store them in structures for later use.
- Should not update the world other than this.
 -}
 module Dodge.Event.Input (
     handleKeyboardEvent,

src/Dodge/Render/ShapePicture.hs

@@ -2,6 +2,7 @@ module Dodge.Render.ShapePicture (
     worldSPic,
 ) where
 
+import Dodge.Render.List
 import Control.Lens
 import Control.Monad (guard)
 import Data.Foldable
@@ -139,6 +140,9 @@ extraPics cfig u =
         <> concatMapPic ppDraw (_pressPlates lw)
         <> viewClipBounds cfig w
         <> debugDraw cfig w
+        <> foldMap _debugPic (_uvDebug u)
+        <> setLayer FixedCoordLayer
+            (listPicturesAt (1.3 * halfWidth cfig) 0 cfig (map text (foldMap _debugMessage (_uvDebug u))))
   where
     w = u ^. uvWorld
     lw = w ^. cWorld . lWorld

src/Dodge/Save.hs

@@ -45,7 +45,7 @@ writeSaveSlot ss u = do
 readSaveSlot :: SaveSlot -> IO (Universe -> Maybe Universe)
 readSaveSlot ss = do
     fExists <- doesFileExist $ saveSlotPath ss
-    when (not fExists) $ error "Tried to read non-existant save file"
+    unless fExists $ error "Tried to read non-existant save file"
     mcw <- decodeFileStrict $ saveSlotPath ss
     flip (maybe (error "Tried to read incorrectly encoded save file")) mcw $ \cw ->
         return $ \uv -> Just 

src/Dodge/Update.hs

@@ -83,10 +83,16 @@ updateUniverse u =
 updateUniverseFirst :: Universe -> Universe
 updateUniverseFirst u =
     u
+        & uvWorld . input . clickWorldPos %~ M.union (setClickWorldPos u)
         & uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
         & over (uvWorld . input) updateScrollTestValue
         & over (uvWorld . cWorld . cClock) (+ 1)
 
+setClickWorldPos :: Universe -> M.Map MouseButton Point2
+setClickWorldPos u = fmap 
+    (const (screenToWorldPos (u ^. uvWorld . wCam) (u ^. uvWorld . input . mousePos)))
+    (M.filter (== 1) $ u ^. uvWorld . input . mouseButtons)
+
 updateWorldEventFlags :: Universe -> Universe
 updateWorldEventFlags u =
     (uvWorld . worldEventFlags .~ mempty)

src/MaybeHelp.hs

@@ -19,6 +19,8 @@ data Maybe' a = Just' {__Just' :: a} | Nothing'
 --
 --instance FromJSON a => FromJSON (Maybe' a)
 
+--maybe' :: b -> (a -> b) -> Maybe' a -> b
+
 fromJust' :: Maybe' a -> a
 fromJust' mx = case mx of
     Just' x -> x