diff --git a/src/Data/Preload/Render.hs b/src/Data/Preload/Render.hs index 08eb228d3..a60e75310 100644 --- a/src/Data/Preload/Render.hs +++ b/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 diff --git a/src/Dodge/Creature/Action.hs b/src/Dodge/Creature/Action.hs index c146daa06..234d2d7df 100644 --- a/src/Dodge/Creature/Action.hs +++ b/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 - updates or deletes the action itself. +{- | Performing an action on a frame creates an OutAction: + adds impulses and updates or deletes the action itself. -} performAction :: Creature -> World -> Action -> OutAction performAction cr w ac = case ac of diff --git a/src/Dodge/Creature/SetTarget.hs b/src/Dodge/Creature/SetTarget.hs index 354acf5d7..b74ccd1fa 100644 --- a/src/Dodge/Creature/SetTarget.hs +++ b/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 diff --git a/src/Dodge/Creature/Test.hs b/src/Dodge/Creature/Test.hs index 72df48211..6e7535ad6 100644 --- a/src/Dodge/Creature/Test.hs +++ b/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 diff --git a/src/Dodge/Data/ActionPlan.hs b/src/Dodge/Data/ActionPlan.hs index 18e658fe7..eaca43d38 100644 --- a/src/Dodge/Data/ActionPlan.hs +++ b/src/Dodge/Data/ActionPlan.hs @@ -16,10 +16,10 @@ import Sound.Data data ActionPlan = Inanimate | ActionPlan - { _apImpulse :: [Impulse] - , _apAction :: [Action] - , _apStrategy :: Strategy - , _apGoal :: [Goal] + { _apImpulse :: [Impulse] -- done per frame + , _apAction :: [Action] -- updated per frame, likely persist across frames + , _apStrategy :: Strategy -- current strategy + , _apGoal :: [Goal] -- particular ordered goals } --deriving (Eq, Ord, Show, Read) --Generic, Flat) deriving (Eq, Ord, Show) --Generic, Flat) diff --git a/src/Dodge/Data/Creature.hs b/src/Dodge/Data/Creature.hs index 6923c8a63..c7d52e221 100644 --- a/src/Dodge/Data/Creature.hs +++ b/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 diff --git a/src/Dodge/Data/Input.hs b/src/Dodge/Data/Input.hs index 11ebeda5e..a98a9e813 100644 --- a/src/Dodge/Data/Input.hs +++ b/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 diff --git a/src/Dodge/Data/Universe.hs b/src/Dodge/Data/Universe.hs index d36f0663b..78b29dffc 100644 --- a/src/Dodge/Data/Universe.hs +++ b/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 - = DebugSimpleMessage - { _debugMessage :: [String] - } - | DebugWorldPosMessage - { _debugWorldPos :: V3 Float - , _debugMessage :: [String] - } - | DebugScreenPosMessage - { _debugScreenPos :: V2 Float - , _debugMessage :: [String] - } +data DebugInfo + = NoDebugInfo + | DebugV3 { _debugV3 :: V3 Float} + | DebugV2 { _debugV2 :: V2 Float} + | DebugMInt { _debugMInt :: Maybe Int} data SideEffect = NewSideEffect diff --git a/src/Dodge/Debug.hs b/src/Dodge/Debug.hs index a719ee1cb..bde880cf9 100644 --- a/src/Dodge/Debug.hs +++ b/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 } diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index 148630628..9b50ccc7a 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/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 - b <- w ^. input . clickPos . at ButtonRight +-- let f = fmap (screenToWorldPos (w ^. wCam)) + 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) diff --git a/src/Dodge/Default/Creature.hs b/src/Dodge/Default/Creature.hs index 3899b0696..438f4cd1d 100644 --- a/src/Dodge/Default/Creature.hs +++ b/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 = diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index cac4daac4..f1b053de7 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -14,6 +14,7 @@ defaultInput :: Input defaultInput = Input { _clickPos = mempty + , _clickWorldPos = mempty , _heldPos = mempty , _textInput = mempty , _pressedKeys = mempty diff --git a/src/Dodge/Event/Input.hs b/src/Dodge/Event/Input.hs index 1991609ae..331c34135 100644 --- a/src/Dodge/Event/Input.hs +++ b/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, diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 63754aecc..6ef6b8f1d 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/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 diff --git a/src/Dodge/Save.hs b/src/Dodge/Save.hs index 84b39d022..9351ffce9 100644 --- a/src/Dodge/Save.hs +++ b/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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index d312ec8ed..dec7a1adb 100644 --- a/src/Dodge/Update.hs +++ b/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) diff --git a/src/MaybeHelp.hs b/src/MaybeHelp.hs index af1b313c5..4fac0dbf5 100644 --- a/src/MaybeHelp.hs +++ b/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