Refector

src/Dodge/Creature.hs

@@ -3,6 +3,9 @@ module Dodge.Creature
     , module Dodge.Creature.Inanimate
     )
   where
+import Dodge.Creature.Stance.Data
+import Dodge.Creature.State.Data
+import Dodge.Creature.Impulse.Data
 import Dodge.Data
 import Dodge.AIs
 import Dodge.Default

src/Dodge/Creature.hs.orig

@@ -227,15 +227,15 @@ goalPict cr = let r = _crRad cr in case _crState cr of
 --            | crDam > _crHP cr -> color white $ circleSolid r
             | otherwise        -> case head gls of
                         [] -> sizeColEnemy r white
-                        (MoveToFor p i:_) -> dGoals $ sizeColEnemy r green
-                        (WaitFor x:_) -> dGoals $ sizeColEnemy r yellow
-                        (FireAt p:_) -> dGoals $ sizeColEnemy r red
-                        (Reload:_) -> dGoals $ sizeColEnemy r orange
-                        (PathTo p:_) -> dGoals $ sizeColEnemy r cyan
-                        (SubPathTo p i _:_) -> dGoals $ sizeColEnemy r blue
-                        (Search i:_) -> dGoals $ sizeColEnemy r black
-                        _ -> dGoals $ sizeColEnemy r magenta
-                    where dGoals p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
+                        (MoveToFor p i:_) -> dImpulses $ sizeColEnemy r green
+                        (WaitFor x:_) -> dImpulses $ sizeColEnemy r yellow
+                        (FireAt p:_) -> dImpulses $ sizeColEnemy r red
+                        (Reload:_) -> dImpulses $ sizeColEnemy r orange
+                        (PathTo p:_) -> dImpulses $ sizeColEnemy r cyan
+                        (SubPathTo p i _:_) -> dImpulses $ sizeColEnemy r blue
+                        (Search i:_) -> dImpulses $ sizeColEnemy r black
+                        _ -> dImpulses $ sizeColEnemy r magenta
+                    where dImpulses p = pictures [p, rotate (0 - _crDir cr) $ scale 0.1 0.1 $ color white $ text $ show gls]
     _                  -> sizeColEnemy r (light $ dim green)
 
 startCr :: Creature

src/Dodge/Creature/AI.hs

@@ -0,0 +1,11 @@
+module Dodge.Creature.AI
+    where
+import Dodge.Data
+
+import Control.Lens
+import System.Random
+
+insectAI 
+    :: ( World -> StdGen -> Creature -> (World -> World, StdGen, Creature) )
+    -> World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
+insectAI = undefined

src/Dodge/Creature/AI/Data.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.AI.Data
+    where
+import Dodge.Creature.State.Data
+import Dodge.Creature.Impulse.Data
+
+import Control.Lens
+data Intelligence
+    = Zombie { _crImpulse :: Impulse }
+    | Inanimate
+

src/Dodge/Creature/Action.hs

@@ -9,8 +9,10 @@ module Dodge.Creature.Action
     where
 import Dodge.Creature.Action.UseItem
 import Dodge.Creature.Action.Movement
+import Dodge.Creature.Stance.Data
+import Dodge.Creature.State.Data
 import Dodge.WorldEvent.Shockwave
-import Dodge.Data
+import Dodge.Data hiding (carriage)
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.WorldEvent
@@ -176,6 +178,16 @@ crTurnTo
 crTurnTo p cr = set crDir dirToTarget cr
     where dirToTarget = argV (p -.- _crPos cr)
 
+crRandomTurn
+    :: RandomGen g
+    => Float    -- ^ Max possible angle, supposed to be positive
+    -> Creature
+    -> g
+    -> (Creature, g)
+crRandomTurn a cr g = 
+    let (r, g') = randomR (negate a, a) g
+    in (cr & crDir +~ r, g')
+
 crTurnTowardSpeed 
     :: Float    -- ^ Turn speed
     -> Point2   -- ^ Target position

src/Dodge/Creature/Impulse/Data.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Impulse.Data
+    where
+import Dodge.Creature.Stance.Data
+import Geometry.Data
+
+import Control.Lens
+data Impulse 
+    = MoveTo Point2
+    | MoveToFor Point2 Int
+    | MoveFire Point2 Point2
+    | PathTo Point2
+    | PathAlong [Point2]
+    | SubPathTo Point2 Int Point2
+    | Wait
+    | WaitFor Int
+    | WaitForID Int Int
+    | FireAt Point2
+    | FireAtID Int Point2
+    | Fire
+    | Reload
+    | IncreaseAlert Int
+    | Guard Point2 Point2
+    | Search Int
+    | SearchNear Point2
+    | AimAt Point2 Int
+    | InitGuard
+    | Init
+    | MeleeAttack Int
+    | InitTrackYou
+    | TrackYou
+    | Track Int
+    | TrackFor Int Int
+    | TurnByFor Float Int
+    | TurnTo Point2
+    | TurnToward Point2
+    | TurnTowardAngle Float
+    | StrafeLeftAround Int Point2
+    | StrafeRightAround Int Point2
+    | StrafeLeftFor Int
+    | StrafeRightFor Int
+    | StrafeLeftForSpeed Int Float
+    | StrafeRightForSpeed Int Float
+    | StrafeLeftFire
+    | StrafeRightFire
+    | MoveForwardFor Int
+    | MoveForwardFire
+    | MoveBackwardFor Int
+    | MoveByFor Point2 Int
+    | MoveBackwardFire
+    | ImpulseID Int Impulse
+    | AtRange Float
+    | AtRanges Float Float
+    | RepeatAction Int Impulse
+    | MakeJudgement
+    | SetPosture Posture
+  deriving (Eq,Show)

src/Dodge/Creature/Inanimate.hs

@@ -4,6 +4,9 @@ Inanimate objects such as lamps, barrels, etc
 module Dodge.Creature.Inanimate
   where
 import Dodge.Data
+import Dodge.Creature.Stance.Data
+import Dodge.Creature.State.Data
+import Dodge.Creature.Impulse.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Dodge.Default

src/Dodge/Creature/Picture.hs

@@ -6,6 +6,7 @@ module Dodge.Creature.Picture
     , circLine
     ) where
 import Dodge.Data
+import Dodge.Creature.State.Data
 import Dodge.Picture.Layer
 import Picture
 import Geometry

src/Dodge/Creature/Stance/Data.hs

@@ -0,0 +1,25 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StrictData #-}
+module Dodge.Creature.Stance.Data
+  where
+import Geometry.Data
+
+import Control.Lens
+data Stance = Stance 
+    {_carriage :: Carriage
+    ,_posture  :: Posture
+    }
+  deriving (Eq,Show)
+data Carriage 
+    = Walking { _stepCycle :: Int, _stepToAdd :: Int }
+    | Standing
+    | Floating
+    | Flying
+    | Boosting Point2
+  deriving (Eq,Show)
+data Posture = Aiming | AtEase
+  deriving (Eq,Show)
+
+makeLenses ''Stance
+makeLenses ''Carriage
+makeLenses ''Posture

src/Dodge/Creature/State.hs

@@ -1,5 +1,8 @@
 module Dodge.Creature.State where
 import Dodge.Data
+import Dodge.Creature.State.Data
+import Dodge.Creature.Stance.Data
+import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.RandomHelp

src/Dodge/Creature/State/Data.hs

@@ -4,11 +4,13 @@ module Dodge.Creature.State.Data
   where
 import Geometry
 import Dodge.Data.DamageType
+import Dodge.Creature.Impulse.Data
+import Dodge.Creature.Stance.Data
 
 import Control.Lens
 
 data CreatureState = CrSt 
-    { _goals    :: [[Goal]]
+    { _goals    :: [[Impulse]]
     , _stance  :: Stance
     , _faction :: Faction
     , _crDamage  :: [DamageType]
@@ -27,72 +29,7 @@ data CrSpState
     = Barrel { _piercedPoints :: [Point2]}
     | GenCr
   deriving (Eq,Show,Ord)
-data Goal 
-    = MoveTo Point2
-    | MoveToFor Point2 Int
-    | MoveFire Point2 Point2
-    | PathTo Point2
-    | PathAlong [Point2]
-    | SubPathTo Point2 Int Point2
-    | Wait
-    | WaitFor Int
-    | WaitForID Int Int
-    | FireAt Point2
-    | FireAtID Int Point2
-    | Fire
-    | Reload
-    | IncreaseAlert Int
-    | Guard Point2 Point2
-    | Search Int
-    | SearchNear Point2
-    | AimAt Point2 Int
-    | InitGuard
-    | Init
-    | MeleeAttack Int
-    | InitTrackYou
-    | TrackYou
-    | Track Int
-    | TrackFor Int Int
-    | TurnByFor Float Int
-    | TurnTo Point2
-    | TurnToward Point2
-    | TurnTowardAngle Float
-    | StrafeLeftAround Int Point2
-    | StrafeRightAround Int Point2
-    | StrafeLeftFor Int
-    | StrafeRightFor Int
-    | StrafeLeftForSpeed Int Float
-    | StrafeRightForSpeed Int Float
-    | StrafeLeftFire
-    | StrafeRightFire
-    | MoveForwardFor Int
-    | MoveForwardFire
-    | MoveBackwardFor Int
-    | MoveByFor Point2 Int
-    | MoveBackwardFire
-    | GoalID Int Goal
-    | AtRange Float
-    | AtRanges Float Float
-    | RepeatAction Int Goal
-    | MakeJudgement
-    | SetPosture Posture
-  deriving (Eq,Show)
-data Stance = Stance 
-    {_carriage :: Carriage
-    ,_posture  :: Posture
-    }
-  deriving (Eq,Show)
-data Carriage 
-    = Walking { _stepCycle :: Int, _stepToAdd :: Int }
-    | Standing
-    | Floating
-    | Flying
-    | Boosting Point2
-  deriving (Eq,Show)
-data Posture = Aiming | AtEase
-  deriving (Eq,Show)
-data Mind = ZombieMind | HumanMind
-    deriving (Eq,Show)
+
 data Faction 
     = GenericFaction Int
     | ZombieFaction
@@ -104,6 +41,4 @@ data Faction
 
 makeLenses ''CreatureState
 makeLenses ''CrSpState
-makeLenses ''Goal
-makeLenses ''Carriage
-makeLenses ''Posture
+makeLenses ''Impulse

src/Dodge/Creature/YourControl.hs

@@ -4,6 +4,8 @@ import Dodge.Data
 import Dodge.Base
 import Dodge.Creature.Action
 import Dodge.Creature.State
+import Dodge.Creature.State.Data
+import Dodge.Creature.Stance.Data
 import Dodge.Update.UsingInput
 import Dodge.Config.KeyConfig
 import Dodge.Item.Attachment.Data

src/Dodge/Data.hs

@@ -10,16 +10,14 @@ module Dodge.Data
     ( module Dodge.Data
     , module Dodge.Data.DamageType
     , module Dodge.Data.SoundOrigin
-    , module Dodge.Creature.Data
-    , module Dodge.Creature.State.Data
     , Point2 (..)
     , Sound (..)
     , soundTime
-    )
-  where
+    ) where
 import Dodge.Picture.Layer.Data
 import Dodge.Creature.Data
 import Dodge.Creature.State.Data
+import Dodge.Creature.Stance.Data
 import Dodge.Data.Menu
 import Dodge.Data.SoundOrigin
 import Dodge.Data.DamageType
@@ -46,7 +44,6 @@ import SDL (Scancode, MouseButton)
 import qualified SDL.Mixer as Mix
 import Graphics.Rendering.OpenGL (PrimitiveMode (..),GLfloat,Program,VertexArrayObject,BufferObject)
 import Codec.Picture (Image,PixelRGBA8)
-
 data World = World 
     { _keys                 :: !(S.Set Scancode)
     , _mouseButtons         :: !(S.Set MouseButton)
@@ -103,14 +100,11 @@ data World = World
     , _sideEffects          :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
     , _doneSideEffects      :: [PreloadData SoundOrigin -> IO (PreloadData SoundOrigin)]
     } 
-
 data Corpse = Corpse
     { _cpPos :: Point2
     , _cpPict :: Picture
     , _cpRes :: Creature
     }
-
-
 data Cloud = Cloud
     { _clID :: Int
     , _clPos :: Point2
@@ -120,7 +114,6 @@ data Cloud = Cloud
     , _clTimer :: Int
     , _clEffect :: Cloud -> World -> World
     }
-
 data LightSource = LS  
     { _lsID         :: !Int
     , _lsPos        :: !Point2
@@ -128,14 +121,12 @@ data LightSource = LS
     , _lsRad        :: !Float
     , _lsIntensity  :: !Float
     }
-
 data TempLightSource = TLS 
     { _tlsPos :: !Point2
     , _tlsRad :: !Float
     , _tlsIntensity :: !Float
     , _tlsUpdate :: World -> TempLightSource -> (World, Maybe TempLightSource)
     }
-
 data Creature = Creature
     { _crPos        :: Point2
     , _crOldPos     :: Point2
@@ -158,12 +149,10 @@ data Creature = Creature
     , _crCorpse     :: Picture
     , _crApplyDamage :: [DamageType] -> Creature -> (World -> World,Creature)
     }
-
 data WorldState 
     = DoorNumOpen Int 
     | CrNumAlive Int
   deriving (Eq,Ord)
-
 data Button = Button 
     { _btPict :: Picture
     , _btPos :: Point2
@@ -173,10 +162,8 @@ data Button = Button
     , _btText :: String
     , _btState :: ButtonState
     }
-
 data ButtonState = BtOn | BtOff | BtNoLabel
   deriving (Eq, Show)
-
 data PressPlate = PressPlate 
     { _ppPict :: Picture
     , _ppPos :: Point2
@@ -185,13 +172,10 @@ data PressPlate = PressPlate
     , _ppID :: Int
     , _ppText :: String
     }
-
 data FloorItem = FlIt { _flIt :: Item , _flItPos :: Point2 , _flItRot :: Float, _flItID :: Int}
-
 data ItemPos 
     =  InInv   { _itCrId :: Int , _itInvId :: Int }
     | OnFloor  { _itFlID :: Int }
-
 data Item 
     = Weapon
         { _itName :: String
@@ -287,7 +271,6 @@ data Item
         , _itScrollDown :: Int -> World -> World
         }
      | NoItem
-
 data ItEffect = NoItEffect
     | ItInvEffect 
         {_itInvEffect       :: Creature -> Int -> World -> World
@@ -306,15 +289,12 @@ data ItZoom = ItZoom
     ,_itZoomMin    :: Float
     ,_itZoomFac    :: Float 
     }
-
 data IntID a = IntID Int a
-
 data HammerPosition 
     = HammerDown
     | HammerReleased
     | HammerUp
     | NoHammer
-
 data ItemIdentity 
     = Pistol
     | SpreadGun
@@ -346,11 +326,8 @@ data ItemIdentity
     | LightningGun
     | PoisonSprayer
     deriving (Eq,Show,Ord,Enum)
-
-{-
-Objects without ids.
-Update themselves, perhaps with side effects.
- -}
+{- Objects without ids.
+Update themselves, perhaps with side effects.  -}
 data Particle
     = Particle
         { _ptDraw :: Particle -> Picture
@@ -389,10 +366,8 @@ data Particle
         , _btMaxTime'   :: Int
         , _btTimer'     :: Int
         }
-
 type HitEffect = Particle -> [(Point2, (Either3 Creature Wall ForceField))] -> World 
                     -> (World,Maybe Particle)
-
 data Projectile 
     = Projectile    
         { _pjPos :: Point2
@@ -411,9 +386,7 @@ data Projectile
         , _pjUpdate :: World -> World
         , _pjPayload :: Point2-> World -> World
         }
-
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
-
 data Wall 
     = Wall 
         { _wlLine :: (Point2,Point2) 
@@ -454,7 +427,6 @@ data Wall
         , _blDegrades :: [Int]
         , _blShadows :: [Int]
         }
-
 data ForceField = FF 
     { _ffLine :: [Point2] , _ffID :: Int 
     , _ffColor :: Color
@@ -468,7 +440,6 @@ makeLenses ''Cloud
 makeLenses ''Creature
 makeLenses ''LightSource
 makeLenses ''TempLightSource
-makeLenses ''Stance
 makeLenses ''Item
 makeLenses ''ItemPos
 makeLenses ''ItEffect

src/Dodge/Data.hs.orig

@@ -144,7 +144,7 @@ data Creature = Creature
     }
 
 data CreatureState = CrSt 
-    { _goals    :: [[Goal]]
+    { _goals    :: [[Impulse]]
     , _stance  :: Stance
     , _faction :: Faction
     , _crDamage  :: [DamageType]
@@ -157,7 +157,7 @@ data CrSpState
     = Barrel { _piercedPoints :: [Point2]}
     | GenCr
   deriving (Eq,Show,Ord)
-data Goal 
+data Impulse 
     = MoveTo Point2
     | MoveToFor Point2 Int
     | MoveFire Point2 Point2
@@ -200,10 +200,10 @@ data Goal
     | MoveBackwardFor Int
     | MoveByFor Point2 Int
     | MoveBackwardFire
-    | GoalID Int Goal
+    | ImpulseID Int Impulse
     | AtRange Float
     | AtRanges Float Float
-    | RepeatAction Int Goal
+    | RepeatAction Int Impulse
     | MakeJudgement
     | SetPosture Posture
   deriving (Eq,Show)
@@ -652,7 +652,7 @@ makeLenses ''Cloud
 makeLenses ''Creature
 makeLenses ''CreatureState
 makeLenses ''CrSpState
-makeLenses ''Goal
+makeLenses ''Impulse
 makeLenses ''LightSource
 makeLenses ''TempLightSource
 makeLenses ''Stance

src/Dodge/Default.hs

@@ -8,6 +8,8 @@ This module contains prototypical data structures.
 module Dodge.Default where
 import Dodge.Item.Weapon.ExtraEffect
 import Dodge.Data
+import Dodge.Creature.Stance.Data
+import Dodge.Creature.State.Data
 import Dodge.Data.Menu
 import Dodge.SoundLogic
 import Dodge.Base

src/Dodge/Floor.hs

@@ -7,6 +7,7 @@ import Geometry
 import Picture
 import Dodge.Data
 import Dodge.Room
+import Dodge.Creature.State.Data
 import Dodge.Room.Procedural
 import Dodge.Room.RoadBlock
 import Dodge.Room.Data

src/Dodge/Item/Weapon/Bullet.hs

@@ -9,6 +9,7 @@ import Dodge.WorldEvent
 import Dodge.SoundLogic
 import Dodge.RandomHelp
 import Dodge.WorldEvent.Shockwave
+import Dodge.Creature.State.Data
 import Dodge.Creature.Property
 import Geometry
 import Picture

src/Dodge/Item/Weapon/Laser.hs

@@ -11,6 +11,7 @@ import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
 import Dodge.WorldEvent.Flash
+import Dodge.Creature.State.Data
 import Geometry
 import Picture
 

src/Dodge/LevelGen/AutoDoor.hs

@@ -5,6 +5,7 @@ Creation of doors that open when creatures approach them.
 module Dodge.LevelGen.AutoDoor
     where
 import Dodge.Data
+import Dodge.Creature.State.Data
 import Dodge.Base
 import Dodge.SoundLogic
 import Dodge.Creature.Property

src/Dodge/Path.hs

@@ -147,14 +147,14 @@ makePathBetweenPs' a b w =  fmap (mapMaybe (lab g)) $ makePathBetween' a b w
     where g  = _pathGraph w
 
 
-pointTowardsGoal :: Point2 -> Point2 -> World -> Maybe Point2
-pointTowardsGoal a b w = join $ fmap (listToMaybe . filter (flip (isWalkable a) w))
+pointTowardsImpulse :: Point2 -> Point2 -> World -> Maybe Point2
+pointTowardsImpulse a b w = join $ fmap (listToMaybe . filter (flip (isWalkable a) w))
 --                              $ pathBetween a b w
                                 $ makePathBetweenPs a b w
 --
     
-pointTowardsGoal' :: Point2 -> Point2 -> World -> Either String Point2
-pointTowardsGoal' a b w = join $ fmap (maybeToEither "NOSEEPATH" . listToMaybe . filter (flip (isWalkable a) w))
+pointTowardsImpulse' :: Point2 -> Point2 -> World -> Either String Point2
+pointTowardsImpulse' a b w = join $ fmap (maybeToEither "NOSEEPATH" . listToMaybe . filter (flip (isWalkable a) w))
                                $ makePathBetweenPs' b a w
 
 maybeToEither :: a -> Maybe b -> Either a b

src/Dodge/Room/Boss.hs

@@ -11,6 +11,7 @@ import Dodge.Room.Link
 import Dodge.Room.Corridor
 import Dodge.LevelGen.Data
 import Dodge.Creature
+import Dodge.Creature.State.Data
 import Dodge.RandomHelp
 import Dodge.Layout.Tree.Polymorphic
 import Geometry

src/Dodge/Room/NoNeedWeapon.hs

@@ -4,6 +4,7 @@ module Dodge.Room.NoNeedWeapon
     ) where
 import Dodge.Data
 import Dodge.Creature
+import Dodge.Creature.State.Data
 import Dodge.Creature.Inanimate
 import Dodge.Room.Data
 import Dodge.Room.Procedural

src/Dodge/WallCreatureCollisions.hs

@@ -1,6 +1,7 @@
 module Dodge.WallCreatureCollisions where
 -- imports {{{
 import Dodge.Data
+import Dodge.Creature.State.Data
 import Dodge.Base
 import Geometry
 

src/Dodge/WorldEvent.hs

@@ -21,7 +21,7 @@ import Dodge.WorldEvent.Explosion
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.WorldEvent.Shockwave
 import Dodge.LightSources
-
+import Dodge.Creature.State.Data
 import Dodge.Data
 import Dodge.Base
 import Dodge.SoundLogic

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,6 +1,7 @@
 module Dodge.WorldEvent.HitEffect
     where
 import Dodge.Data
+import Dodge.Creature.State.Data
 
 import Geometry
 

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,6 +4,7 @@ module Dodge.WorldEvent.Shockwave
     )
   where
 import Dodge.Data
+import Dodge.Creature.State.Data
 import Dodge.Base
 import Dodge.Picture.Layer
 import Geometry

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -4,6 +4,7 @@ Creation of particles in the world.
 module Dodge.WorldEvent.SpawnParticle
   where
 import Dodge.Data
+import Dodge.Creature.State.Data
 import Dodge.Base
 import Dodge.Picture
 import Dodge.Picture.Layer